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'       => 'Payment',
 373     'cust_pay_batch' => 'Batch payment',
 374     'cust_statement' => 'Statement',  #too general a name here? "Invoice group"?
 375     'svc_acct'       => 'Login service',
 376   ;
 377
 378   \%hash
 379 }
 380
 381 =item eventtable_pkey_sql
 382
 383 Returns a hash reference of full SQL primary key names for eventtable values,
 384 i.e. 'cust_main'=>'cust_main.custnum'
 385
 386 =cut
 387
 388 sub eventtable_pkey_sql {
 389   my $class = shift;
 390
 391   my $hashref = $class->eventtable_pkey;
 392
 393   my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
 394
 395   \%hash;
 396 }
 397
 398 =item eventtable_pkey
 399
 400 Returns a hash reference of full SQL primary key names for eventtable values,
 401 i.e. 'cust_main'=>'custnum'
 402
 403 =cut
 404
 405 sub eventtable_pkey {
 406   #my $class = shift;
 407
 408   {
 409     'cust_main'      => 'custnum',
 410     'cust_bill'      => 'invnum',
 411     'cust_pkg'       => 'pkgnum',
 412     'cust_pay'       => 'paynum',
 413     'cust_pay_batch' => 'paybatchnum',
 414     'cust_statement' => 'statementnum',
 415     'svc_acct'       => 'svcnum',
 416   };
 417 }
 418
 419 =item eventtables
 420
 421 Returns a list of eventtable values (default ordering; suited for display).
 422
 423 =cut
 424
 425 sub eventtables {
 426   my $class = shift;
 427   my $eventtables = $class->eventtable_labels;
 428   keys %$eventtables;
 429 }
 430
 431 =item eventtables_runorder
 432
 433 Returns a list of eventtable values (run order).
 434
 435 =cut
 436
 437 sub eventtables_runorder {
 438   shift->eventtables; #same for now
 439 }
 440
 441 =item eventtables_cust_join
 442
 443 Returns a hash reference of SQL expressions to join each eventtable to
 444 a table with a 'custnum' field.
 445
 446 =cut
 447
 448 sub eventtables_cust_join {
 449   my %hash = (
 450     'svc_acct' => 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum)',
 451   );
 452   \%hash;
 453 }
 454
 455 =item eventtables_custnum
 456
 457 Returns a hash reference of SQL expressions for the 'custnum' field when
 458 I<eventtables_cust_join> is in effect.  The default is "$eventtable.custnum".
 459
 460 =cut
 461
 462 sub eventtables_custnum {
 463   my %hash = (
 464     map({ $_, "$_.custnum" } shift->eventtables),
 465     'svc_acct' => 'cust_pkg.custnum'
 466   );
 467   \%hash;
 468 }
 469
 470
 471 =item check_freq_labels
 472
 473 Returns a hash reference of labels for check_freq values,
 474 i.e. '1d'=>'daily'
 475
 476 =cut
 477
 478 sub check_freq_labels {
 479   #my $class = shift;
 480
 481   #Tie::IxHash??
 482   {
 483     '1d' => 'daily',
 484     '1m' => 'monthly',
 485   };
 486 }
 487
 488 =item actions [ EVENTTABLE ]
 489
 490 Return information about the available actions.  If an eventtable is specified,
 491 only return information about actions available for that eventtable.
 492
 493 Information is returned as key-value pairs.  Keys are event names.  Values are
 494 hashrefs with the following keys:
 495
 496 =over 4
 497
 498 =item description
 499
 500 =item eventtable_hashref
 501
 502 =item option_fields
 503
 504 =item default_weight
 505
 506 =item deprecated
 507
 508 =back
 509
 510 =head1 ADDING NEW EVENTTABLES
 511
 512 To add an eventtable, you must:
 513
 514 =over 4
 515
 516 =item Add the table to "eventtable_labels" (with a label) and to
 517 "eventtable_pkey" (with its primary key).
 518
 519 =item If the table doesn't have a "custnum" field of its own (such
 520 as a svc_x table), add a suitable join expression to
 521 eventtables_cust_join and an expression for the final custnum field
 522 to eventtables_custnum.
 523
 524 =item Create a method named FS::cust_main->$eventtable(): a wrapper
 525 around qsearch() to return all records in the new table belonging to
 526 the cust_main object.  This method must accept 'addl_from' and
 527 'extra_sql' arguments in the way qsearch() does.  For svc_ tables,
 528 wrap the svc_x() method.
 529
 530 =item Add it to FS::cust_event->join_sql and search_sql_where so that
 531 search/cust_event.html will find it.
 532
 533 =item Create a UI link/form to search for events linked to objects
 534 in the new eventtable, using search/cust_event.html.  Place this
 535 somewhere appropriate to the eventtable.
 536
 537 =back
 538
 539 See L<FS::part_event::Action> for more information.
 540
 541 =cut
 542
 543 #false laziness w/part_event_condition.pm
 544 #some false laziness w/part_export & part_pkg
 545 my %actions;
 546 foreach my $INC ( @INC ) {
 547   foreach my $file ( glob("$INC/FS/part_event/Action/*.pm") ) {
 548     warn "attempting to load Action from $file\n" if $DEBUG;
 549     $file =~ /\/(\w+)\.pm$/ or do {
 550       warn "unrecognized file in $INC/FS/part_event/Action/: $file\n";
 551       next;
 552     };
 553     my $mod = $1;
 554     eval "use FS::part_event::Action::$mod;";
 555     if ( $@ ) {
 556       die "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 557       #warn "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 558       #next;
 559     }
 560     $actions{$mod} = {
 561       ( map { $_ => "FS::part_event::Action::$mod"->$_() }
 562             qw( description eventtable_hashref default_weight deprecated )
 563             #option_fields_hashref
 564       ),
 565       'option_fields' => [ "FS::part_event::Action::$mod"->option_fields() ],
 566     };
 567   }
 568 }
 569
 570 sub actions {
 571   my( $class, $eventtable ) = @_;
 572   (
 573     map  { $_ => $actions{$_} }
 574     sort { $actions{$a}->{'default_weight'}<=>$actions{$b}->{'default_weight'} }
 575        # || $actions{$a}->{'description'} cmp $actions{$b}->{'description'} }
 576     $class->all_actions( $eventtable )
 577   );
 578
 579 }
 580
 581 =item all_actions [ EVENTTABLE ]
 582
 583 Returns a list of just the action names
 584
 585 =cut
 586
 587 sub all_actions {
 588   my ( $class, $eventtable ) = @_;
 589
 590   grep { !$eventtable || $actions{$_}->{'eventtable_hashref'}{$eventtable} }
 591        keys %actions
 592 }
 593
 594 =item process_initialize 'eventpart' => EVENTPART
 595
 596 Job queue wrapper for "initialize".  EVENTPART identifies the
 597 L<FS::part_event> object to initialize.
 598
 599 =cut
 600
 601 sub process_initialize {
 602   my %opt = @_;
 603   my $part_event =
 604       qsearchs('part_event', { eventpart => $opt{'eventpart'}})
 605         or die "eventpart '$opt{eventpart}' not found!\n";
 606   $part_event->initialize;
 607 }
 608
 609 sub _upgrade_data { #class method
 610   my ($class, %opts) = @_;
 611
 612   foreach my $part_event (
 613     qsearch('part_event', { 'action' => 'cust_bill_realtime_card' }),
 614     qsearch('part_event', { 'action' => 'cust_bill_realtime_check' }),
 615   ) {
 616
 617     $part_event->action('realtime_auto');
 618     my $error = $part_event->replace;
 619     die $error if $error;
 620
 621   }
 622
 623 }
 624
 625 =back
 626
 627 =head1 SEE ALSO
 628
 629 L<FS::part_event_option>, L<FS::part_event_condition>, L<FS::cust_main>,
 630 L<FS::cust_pkg>, L<FS::svc_acct>, L<FS::cust_bill>, L<FS::cust_bill_event>,
 631 L<FS::Record>,
 632 schema.html from the base documentation.
 633
 634 =cut
 635
 636 1;
 637