FS/FS/part_event.pm

   1 package FS::part_event;
   2
   3 use strict;
   4 use base qw( FS::m2name_Common FS::option_Common );
   5 use vars qw( $DEBUG );
   6 use Carp qw(confess);
   7 use FS::Record qw( dbh qsearch qsearchs );
   8 use FS::Conf;
   9 use FS::part_event_option;
  10 use FS::part_event_condition;
  11 use FS::cust_event;
  12
  13 $DEBUG = 0;
  14
  15 =head1 NAME
  16
  17 FS::part_event - Object methods for part_event records
  18
  19 =head1 SYNOPSIS
  20
  21   use FS::part_event;
  22
  23   $record = new FS::part_event \%hash;
  24   $record = new FS::part_event { 'column' => 'value' };
  25
  26   $error = $record->insert( { 'option' => 'value' } );
  27   $error = $record->insert( \%options );
  28
  29   $error = $new_record->replace($old_record);
  30
  31   $error = $record->delete;
  32
  33   $error = $record->check;
  34
  35   $error = $record->do_event( $direct_object );
  36
  37 =head1 DESCRIPTION
  38
  39 An FS::part_event object represents an event definition - a billing, collection
  40 or other callback which is triggered when certain customer, invoice, package or
  41 other conditions are met.  FS::part_event inherits from FS::Record.  The
  42 following fields are currently supported:
  43
  44 =over 4
  45
  46 =item eventpart - primary key
  47
  48 =item agentnum - Optional agentnum (see L<FS::agent>)
  49
  50 =item event - event name
  51
  52 =item eventtable - table name against which this event is triggered: one of "cust_main", "cust_bill", "cust_statement", "cust_pkg", "svc_acct".
  53
  54 =item check_freq - how often events of this type are checked; currently "1d" (daily) and "1m" (monthly) are recognized.  Note that the apprioriate freeside-daily and/or freeside-monthly cron job needs to be in place.
  55
  56 =item weight - ordering for events
  57
  58 =item action - event action (like part_bill_event.plan - eventcode plan)
  59
  60 =item disabled - Disabled flag, empty or `Y'
  61
  62 =back
  63
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =item new HASHREF
  69
  70 Creates a new invoice event definition.  To add the invoice event definition to
  71 the database, see L<"insert">.
  72
  73 Note that this stores the hash reference, not a distinct copy of the hash it
  74 points to.  You can ask the object for a copy with the I<hash> method.
  75
  76 =cut
  77
  78 # the new method can be inherited from FS::Record, if a table method is defined
  79
  80 sub table { 'part_event'; }
  81
  82 =item insert [ HASHREF ]
  83
  84 Adds this record to the database.  If there is an error, returns the error,
  85 otherwise returns false.
  86
  87 If a list or hash reference of options is supplied, part_export_option records
  88 are created (see L<FS::part_event_option>).
  89
  90 =cut
  91
  92 # the insert method can be inherited from FS::Record
  93
  94 =item delete
  95
  96 Delete this record from the database.
  97
  98 =cut
  99
 100 # the delete method can be inherited from FS::Record
 101
 102 =item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ]
 103
 104 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 105 returns the error, otherwise returns false.
 106
 107 If a list or hash reference of options is supplied, part_event_option
 108 records are created or modified (see L<FS::part_event_option>).
 109
 110 =cut
 111
 112 # the replace method can be inherited from FS::Record
 113
 114 =item check
 115
 116 Checks all fields to make sure this is a valid invoice event definition.  If
 117 there is an error, returns the error, otherwise returns false.  Called by the
 118 insert and replace methods.
 119
 120 =cut
 121
 122 # the check method should currently be supplied - FS::Record contains some
 123 # data checking routines
 124
 125 sub check {
 126   my $self = shift;
 127
 128   $self->weight(0) unless $self->weight;
 129
 130   my $error =
 131        $self->ut_numbern('eventpart')
 132     || $self->ut_text('event')
 133     || $self->ut_enum('eventtable', [ $self->eventtables ] )
 134     || $self->ut_enum('check_freq', [ '1d', '1m' ])
 135     || $self->ut_number('weight')
 136     || $self->ut_alpha('action')
 137     || $self->ut_enum('disabled', [ '', 'Y' ] )
 138     || $self->ut_agentnum_acl('agentnum', 'Edit global billing events')
 139   ;
 140   return $error if $error;
 141
 142   #XXX check action to make sure a module exists?
 143   # well it'll die in _rebless...
 144
 145   $self->SUPER::check;
 146 }
 147
 148 =item _rebless
 149
 150 Reblesses the object into the FS::part_event::Action::ACTION class, where
 151 ACTION is the object's I<action> field.
 152
 153 =cut
 154
 155 sub _rebless {
 156   my $self = shift;
 157   my $action = $self->action or return $self;
 158   #my $class = ref($self). "::$action";
 159   my $class = "FS::part_event::Action::$action";
 160   eval "use $class";
 161   die $@ if $@;
 162   bless($self, $class); # unless $@;
 163   $self;
 164 }
 165
 166 =item part_event_condition
 167
 168 Returns the conditions associated with this event, as FS::part_event_condition
 169 objects (see L<FS::part_event_condition>)
 170
 171 =item new_cust_event OBJECT, [ OPTION => VALUE ]
 172
 173 Creates a new customer event (see L<FS::cust_event>) for the provided object.
 174
 175 The only option allowed is 'time', to set the "current" time for the event.
 176
 177 =cut
 178
 179 sub new_cust_event {
 180   my( $self, $object, %opt ) = @_;
 181
 182   confess "**** $object is not a ". $self->eventtable
 183     if ref($object) ne "FS::". $self->eventtable;
 184
 185   my $pkey = $object->primary_key;
 186
 187   new FS::cust_event {
 188     'eventpart' => $self->eventpart,
 189     'tablenum'  => $object->$pkey(),
 190     #'_date'     => time, #i think we always want the real "now" here.
 191     '_date'     => ($opt{'time'} || time),
 192     'status'    => 'new',
 193   };
 194 }
 195
 196 #surely this doesn't work
 197 sub reasontext { confess "part_event->reasontext deprecated"; }
 198 #=item reasontext
 199 #
 200 #Returns the text of any reason associated with this event.
 201 #
 202 #=cut
 203 #
 204 #sub reasontext {
 205 #  my $self = shift;
 206 #  my $r = qsearchs('reason', { 'reasonnum' => $self->reason });
 207 #  if ($r){
 208 #    $r->reason;
 209 #  }else{
 210 #    '';
 211 #  }
 212 #}
 213
 214 =item agent
 215
 216 Returns the associated agent for this event, if any, as an FS::agent object.
 217
 218 =item templatename
 219
 220 Returns the alternate invoice template name, if any, or false if there is
 221 no alternate template for this event.
 222
 223 =cut
 224
 225 sub templatename {
 226
 227   my $self = shift;
 228   if (    $self->action   =~ /^cust_bill_send_(alternate|agent)$/
 229           && (    $self->option('agent_templatename')
 230                || $self->option('templatename')       )
 231      )
 232   {
 233        $self->option('agent_templatename')
 234     || $self->option('templatename');
 235
 236   } else {
 237     '';
 238   }
 239 }
 240
 241 =item targets OPTIONS
 242
 243 Returns all objects (of type C<FS::eventtable>, for this object's
 244 C<eventtable>) eligible for processing under this event, as of right now.
 245 The L<FS::cust_event> object used to test event conditions will be
 246 included in each object as the 'cust_event' pseudo-field.
 247
 248 This is not used in normal event processing (which is done on a
 249 per-customer basis to control timing of pre- and post-billing events)
 250 but can be useful when configuring events.
 251
 252 =cut
 253
 254 sub targets {
 255   my $self = shift;
 256   my %opt = @_;
 257   my $time = $opt{'time'} || time;
 258
 259   my $eventpart = $self->eventpart;
 260   $eventpart =~ /^\d+$/ or die "bad eventpart $eventpart";
 261   my $eventtable = $self->eventtable;
 262
 263   # find all objects that meet the conditions for this part_event
 264   my $linkage = '';
 265   # this is the 'object' side of the FROM clause
 266   if ( $eventtable ne 'cust_main' ) {
 267     $linkage =
 268         ($self->eventtables_cust_join->{$eventtable} || '') .
 269         ' LEFT JOIN cust_main USING (custnum) ';
 270   }
 271
 272   # this is the 'event' side
 273   my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
 274     'time' => $time
 275   );
 276   my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 277     'time' => $time
 278   );
 279   $join = $linkage .
 280       " INNER JOIN part_event ON ( part_event.eventpart = $eventpart ) $join";
 281
 282   $where .= ' AND cust_main.agentnum = '.$self->agentnum
 283     if $self->agentnum;
 284   # don't enforce check_freq since this is a special, out-of-order check
 285   # and don't enforce disabled because we want to be able to see targets
 286   # for a disabled event
 287
 288   my @objects = qsearch({
 289       table     => $eventtable,
 290       hashref   => {},
 291       addl_from => $join,
 292       extra_sql => "WHERE $where",
 293   });
 294   my @tested_objects;
 295   foreach my $object ( @objects ) {
 296     my $cust_event = $self->new_cust_event($object, 'time' => $time);
 297     next unless $cust_event->test_conditions;
 298
 299     $object->set('cust_event', $cust_event);
 300     push @tested_objects, $object;
 301   }
 302   @tested_objects;
 303 }
 304
 305 =item initialize PARAMS
 306
 307 Identify all objects eligible for this event and create L<FS::cust_event>
 308 records for each of them, as of the present time, with status "initial".  When
 309 combined with conditions that prevent an event from running more than once
 310 (at all or within some period), this will exclude any objects that met the
 311 conditions before the event was created.
 312
 313 If an L<FS::part_event> object needs to be initialized, it should be created
 314 in a disabled state to avoid running the event prematurely for any existing
 315 objects.  C<initialize> will enable it once all the cust_event records
 316 have been created.
 317
 318 This may take some time, so it should be run from the job queue.
 319
 320 =cut
 321
 322 sub initialize {
 323   my $self = shift;
 324   my $error;
 325
 326   my $oldAutoCommit = $FS::UID::AutoCommit;
 327   local $FS::UID::AutoCommit = 0;
 328   my $dbh = dbh;
 329
 330   my @objects = $self->targets;
 331   foreach my $object ( @objects ) {
 332     my $cust_event = $object->get('cust_event');
 333     $cust_event->status('initial');
 334     $error = $cust_event->insert;
 335     last if $error;
 336   }
 337   if ( !$error and $self->disabled ) {
 338     $self->disabled('');
 339     $error = $self->replace;
 340   }
 341   if ( $error ) {
 342     $dbh->rollback;
 343     return $error;
 344   }
 345   $dbh->commit if $oldAutoCommit;
 346   return;
 347 }
 348
 349 =cut
 350
 351
 352 =back
 353
 354 =head1 CLASS METHODS
 355
 356 =over 4
 357
 358 =item eventtable_labels
 359
 360 Returns a hash reference of labels for eventtable values,
 361 i.e. 'cust_main'=>'Customer'
 362
 363 =cut
 364
 365 sub eventtable_labels {
 366   #my $class = shift;
 367
 368   tie my %hash, 'Tie::IxHash',
 369     'cust_pkg'       => 'Package',
 370     'cust_bill'      => 'Invoice',
 371     'cust_main'      => 'Customer',
 372     'cust_pay_batch' => 'Batch payment',
 373     'cust_statement' => 'Statement',  #too general a name here? "Invoice group"?
 374     'svc_acct'       => 'Login service',
 375   ;
 376
 377   \%hash
 378 }
 379
 380 =item eventtable_pkey_sql
 381
 382 Returns a hash reference of full SQL primary key names for eventtable values,
 383 i.e. 'cust_main'=>'cust_main.custnum'
 384
 385 =cut
 386
 387 sub eventtable_pkey_sql {
 388   my $class = shift;
 389
 390   my $hashref = $class->eventtable_pkey;
 391
 392   my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
 393
 394   \%hash;
 395 }
 396
 397 =item eventtable_pkey
 398
 399 Returns a hash reference of full SQL primary key names for eventtable values,
 400 i.e. 'cust_main'=>'custnum'
 401
 402 =cut
 403
 404 sub eventtable_pkey {
 405   #my $class = shift;
 406
 407   {
 408     'cust_main'      => 'custnum',
 409     'cust_bill'      => 'invnum',
 410     'cust_pkg'       => 'pkgnum',
 411     'cust_pay_batch' => 'paybatchnum',
 412     'cust_statement' => 'statementnum',
 413     'svc_acct'       => 'svcnum',
 414   };
 415 }
 416
 417 =item eventtables
 418
 419 Returns a list of eventtable values (default ordering; suited for display).
 420
 421 =cut
 422
 423 sub eventtables {
 424   my $class = shift;
 425   my $eventtables = $class->eventtable_labels;
 426   keys %$eventtables;
 427 }
 428
 429 =item eventtables_runorder
 430
 431 Returns a list of eventtable values (run order).
 432
 433 =cut
 434
 435 sub eventtables_runorder {
 436   shift->eventtables; #same for now
 437 }
 438
 439 =item eventtables_cust_join
 440
 441 Returns a hash reference of SQL expressions to join each eventtable to
 442 a table with a 'custnum' field.
 443
 444 =cut
 445
 446 sub eventtables_cust_join {
 447   my %hash = (
 448     'svc_acct' => 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum)',
 449   );
 450   \%hash;
 451 }
 452
 453 =item eventtables_custnum
 454
 455 Returns a hash reference of SQL expressions for the 'custnum' field when
 456 I<eventtables_cust_join> is in effect.  The default is "$eventtable.custnum".
 457
 458 =cut
 459
 460 sub eventtables_custnum {
 461   my %hash = (
 462     map({ $_, "$_.custnum" } shift->eventtables),
 463     'svc_acct' => 'cust_pkg.custnum'
 464   );
 465   \%hash;
 466 }
 467
 468
 469 =item check_freq_labels
 470
 471 Returns a hash reference of labels for check_freq values,
 472 i.e. '1d'=>'daily'
 473
 474 =cut
 475
 476 sub check_freq_labels {
 477   #my $class = shift;
 478
 479   #Tie::IxHash??
 480   {
 481     '1d' => 'daily',
 482     '1m' => 'monthly',
 483   };
 484 }
 485
 486 =item actions [ EVENTTABLE ]
 487
 488 Return information about the available actions.  If an eventtable is specified,
 489 only return information about actions available for that eventtable.
 490
 491 Information is returned as key-value pairs.  Keys are event names.  Values are
 492 hashrefs with the following keys:
 493
 494 =over 4
 495
 496 =item description
 497
 498 =item eventtable_hashref
 499
 500 =item option_fields
 501
 502 =item default_weight
 503
 504 =item deprecated
 505
 506 =back
 507
 508 =head1 ADDING NEW EVENTTABLES
 509
 510 To add an eventtable, you must:
 511
 512 =over 4
 513
 514 =item Add the table to "eventtable_labels" (with a label) and to
 515 "eventtable_pkey" (with its primary key).
 516
 517 =item If the table doesn't have a "custnum" field of its own (such
 518 as a svc_x table), add a suitable join expression to
 519 eventtables_cust_join and an expression for the final custnum field
 520 to eventtables_custnum.
 521
 522 =item Create a method named FS::cust_main->$eventtable(): a wrapper
 523 around qsearch() to return all records in the new table belonging to
 524 the cust_main object.  This method must accept 'addl_from' and
 525 'extra_sql' arguments in the way qsearch() does.  For svc_ tables,
 526 wrap the svc_x() method.
 527
 528 =item Add it to FS::cust_event->join_sql and search_sql_where so that
 529 search/cust_event.html will find it.
 530
 531 =item Create a UI link/form to search for events linked to objects
 532 in the new eventtable, using search/cust_event.html.  Place this
 533 somewhere appropriate to the eventtable.
 534
 535 =back
 536
 537 See L<FS::part_event::Action> for more information.
 538
 539 =cut
 540
 541 #false laziness w/part_event_condition.pm
 542 #some false laziness w/part_export & part_pkg
 543 my %actions;
 544 foreach my $INC ( @INC ) {
 545   foreach my $file ( glob("$INC/FS/part_event/Action/*.pm") ) {
 546     warn "attempting to load Action from $file\n" if $DEBUG;
 547     $file =~ /\/(\w+)\.pm$/ or do {
 548       warn "unrecognized file in $INC/FS/part_event/Action/: $file\n";
 549       next;
 550     };
 551     my $mod = $1;
 552     eval "use FS::part_event::Action::$mod;";
 553     if ( $@ ) {
 554       die "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 555       #warn "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 556       #next;
 557     }
 558     $actions{$mod} = {
 559       ( map { $_ => "FS::part_event::Action::$mod"->$_() }
 560             qw( description eventtable_hashref default_weight deprecated )
 561             #option_fields_hashref
 562       ),
 563       'option_fields' => [ "FS::part_event::Action::$mod"->option_fields() ],
 564     };
 565   }
 566 }
 567
 568 sub actions {
 569   my( $class, $eventtable ) = @_;
 570   (
 571     map  { $_ => $actions{$_} }
 572     sort { $actions{$a}->{'default_weight'}<=>$actions{$b}->{'default_weight'} }
 573        # || $actions{$a}->{'description'} cmp $actions{$b}->{'description'} }
 574     $class->all_actions( $eventtable )
 575   );
 576
 577 }
 578
 579 =item all_actions [ EVENTTABLE ]
 580
 581 Returns a list of just the action names
 582
 583 =cut
 584
 585 sub all_actions {
 586   my ( $class, $eventtable ) = @_;
 587
 588   grep { !$eventtable || $actions{$_}->{'eventtable_hashref'}{$eventtable} }
 589        keys %actions
 590 }
 591
 592 =item process_initialize 'eventpart' => EVENTPART
 593
 594 Job queue wrapper for "initialize".  EVENTPART identifies the
 595 L<FS::part_event> object to initialize.
 596
 597 =cut
 598
 599 sub process_initialize {
 600   my %opt = @_;
 601   my $part_event =
 602       qsearchs('part_event', { eventpart => $opt{'eventpart'}})
 603         or die "eventpart '$opt{eventpart}' not found!\n";
 604   $part_event->initialize;
 605 }
 606
 607 =back
 608
 609 =head1 SEE ALSO
 610
 611 L<FS::part_event_option>, L<FS::part_event_condition>, L<FS::cust_main>,
 612 L<FS::cust_pkg>, L<FS::svc_acct>, L<FS::cust_bill>, L<FS::cust_bill_event>,
 613 L<FS::Record>,
 614 schema.html from the base documentation.
 615
 616 =cut
 617
 618 1;
 619