FS/FS/part_event.pm

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