FS/FS/part_event.pm

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