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 use FS::agent;
  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 =cut
 173
 174 sub part_event_condition {
 175   my $self = shift;
 176   qsearch( 'part_event_condition', { 'eventpart' => $self->eventpart } );
 177 }
 178
 179 =item new_cust_event OBJECT, [ OPTION => VALUE ]
 180
 181 Creates a new customer event (see L<FS::cust_event>) for the provided object.
 182
 183 The only option allowed is 'time', to set the "current" time for the event.
 184
 185 =cut
 186
 187 sub new_cust_event {
 188   my( $self, $object, %opt ) = @_;
 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     '_date'     => ($opt{'time'} || time),
 200     'status'    => 'new',
 201   };
 202 }
 203
 204 #surely this doesn't work
 205 sub reasontext { confess "part_event->reasontext deprecated"; }
 206 #=item reasontext
 207 #
 208 #Returns the text of any reason associated with this event.
 209 #
 210 #=cut
 211 #
 212 #sub reasontext {
 213 #  my $self = shift;
 214 #  my $r = qsearchs('reason', { 'reasonnum' => $self->reason });
 215 #  if ($r){
 216 #    $r->reason;
 217 #  }else{
 218 #    '';
 219 #  }
 220 #}
 221
 222 =item agent
 223
 224 Returns the associated agent for this event, if any, as an FS::agent object.
 225
 226 =cut
 227
 228 sub agent {
 229   my $self = shift;
 230   qsearchs('agent', { 'agentnum' => $self->agentnum } );
 231 }
 232
 233 =item templatename
 234
 235 Returns the alternate invoice template name, if any, or false if there is
 236 no alternate template for this event.
 237
 238 =cut
 239
 240 sub templatename {
 241
 242   my $self = shift;
 243   if (    $self->action   =~ /^cust_bill_send_(alternate|agent)$/
 244           && (    $self->option('agent_templatename')
 245                || $self->option('templatename')       )
 246      )
 247   {
 248        $self->option('agent_templatename')
 249     || $self->option('templatename');
 250
 251   } else {
 252     '';
 253   }
 254 }
 255
 256 =item targets OPTIONS
 257
 258 Returns all objects (of type C<FS::eventtable>, for this object's
 259 C<eventtable>) eligible for processing under this event, as of right now.
 260 The L<FS::cust_event> object used to test event conditions will be
 261 included in each object as the 'cust_event' pseudo-field.
 262
 263 This is not used in normal event processing (which is done on a
 264 per-customer basis to control timing of pre- and post-billing events)
 265 but can be useful when configuring events.
 266
 267 =cut
 268
 269 sub targets {
 270   my $self = shift;
 271   my %opt = @_;
 272   my $time = $opt{'time'} || time;
 273
 274   my $eventpart = $self->eventpart;
 275   $eventpart =~ /^\d+$/ or die "bad eventpart $eventpart";
 276   my $eventtable = $self->eventtable;
 277
 278   # find all objects that meet the conditions for this part_event
 279   my $linkage = '';
 280   # this is the 'object' side of the FROM clause
 281   if ( $eventtable ne 'cust_main' ) {
 282     $linkage =
 283         ($self->eventtables_cust_join->{$eventtable} || '') .
 284         ' LEFT JOIN cust_main USING (custnum) ';
 285   }
 286
 287   # this is the 'event' side
 288   my $join = FS::part_event_condition->join_conditions_sql( $eventtable,
 289     'time' => $time
 290   );
 291   my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 292     'time' => $time
 293   );
 294   $join = $linkage .
 295       " INNER JOIN part_event ON ( part_event.eventpart = $eventpart ) $join";
 296
 297   $where .= ' AND cust_main.agentnum = '.$self->agentnum
 298     if $self->agentnum;
 299   # don't enforce check_freq since this is a special, out-of-order check
 300   # and don't enforce disabled because we want to be able to see targets
 301   # for a disabled event
 302
 303   my @objects = qsearch({
 304       table     => $eventtable,
 305       hashref   => {},
 306       addl_from => $join,
 307       extra_sql => "WHERE $where",
 308   });
 309   my @tested_objects;
 310   foreach my $object ( @objects ) {
 311     my $cust_event = $self->new_cust_event($object, 'time' => $time);
 312     next unless $cust_event->test_conditions;
 313
 314     $object->set('cust_event', $cust_event);
 315     push @tested_objects, $object;
 316   }
 317   @tested_objects;
 318 }
 319
 320 =item initialize PARAMS
 321
 322 Identify all objects eligible for this event and create L<FS::cust_event>
 323 records for each of them, as of the present time, with status "initial".  When
 324 combined with conditions that prevent an event from running more than once
 325 (at all or within some period), this will exclude any objects that met the
 326 conditions before the event was created.
 327
 328 If an L<FS::part_event> object needs to be initialized, it should be created
 329 in a disabled state to avoid running the event prematurely for any existing
 330 objects.  C<initialize> will enable it once all the cust_event records
 331 have been created.
 332
 333 This may take some time, so it should be run from the job queue.
 334
 335 =cut
 336
 337 sub initialize {
 338   my $self = shift;
 339   my $error;
 340
 341   my $oldAutoCommit = $FS::UID::AutoCommit;
 342   local $FS::UID::AutoCommit = 0;
 343   my $dbh = dbh;
 344
 345   my @objects = $self->targets;
 346   foreach my $object ( @objects ) {
 347     my $cust_event = $object->get('cust_event');
 348     $cust_event->status('initial');
 349     $error = $cust_event->insert;
 350     last if $error;
 351   }
 352   if ( !$error and $self->disabled ) {
 353     $self->disabled('');
 354     $error = $self->replace;
 355   }
 356   if ( $error ) {
 357     $dbh->rollback;
 358     return $error;
 359   }
 360   $dbh->commit if $oldAutoCommit;
 361   return;
 362 }
 363
 364 =cut
 365
 366
 367 =back
 368
 369 =head1 CLASS METHODS
 370
 371 =over 4
 372
 373 =item eventtable_labels
 374
 375 Returns a hash reference of labels for eventtable values,
 376 i.e. 'cust_main'=>'Customer'
 377
 378 =cut
 379
 380 sub eventtable_labels {
 381   #my $class = shift;
 382
 383   tie my %hash, 'Tie::IxHash',
 384     'cust_pkg'       => 'Package',
 385     'cust_bill'      => 'Invoice',
 386     'cust_main'      => 'Customer',
 387     'cust_pay_batch' => 'Batch payment',
 388     'cust_statement' => 'Statement',  #too general a name here? "Invoice group"?
 389     'svc_acct'       => 'Login service',
 390   ;
 391
 392   \%hash
 393 }
 394
 395 =item eventtable_pkey_sql
 396
 397 Returns a hash reference of full SQL primary key names for eventtable values,
 398 i.e. 'cust_main'=>'cust_main.custnum'
 399
 400 =cut
 401
 402 sub eventtable_pkey_sql {
 403   my $class = shift;
 404
 405   my $hashref = $class->eventtable_pkey;
 406
 407   my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
 408
 409   \%hash;
 410 }
 411
 412 =item eventtable_pkey
 413
 414 Returns a hash reference of full SQL primary key names for eventtable values,
 415 i.e. 'cust_main'=>'custnum'
 416
 417 =cut
 418
 419 sub eventtable_pkey {
 420   #my $class = shift;
 421
 422   {
 423     'cust_main'      => 'custnum',
 424     'cust_bill'      => 'invnum',
 425     'cust_pkg'       => 'pkgnum',
 426     'cust_pay_batch' => 'paybatchnum',
 427     'cust_statement' => 'statementnum',
 428     'svc_acct'       => 'svcnum',
 429   };
 430 }
 431
 432 =item eventtables
 433
 434 Returns a list of eventtable values (default ordering; suited for display).
 435
 436 =cut
 437
 438 sub eventtables {
 439   my $class = shift;
 440   my $eventtables = $class->eventtable_labels;
 441   keys %$eventtables;
 442 }
 443
 444 =item eventtables_runorder
 445
 446 Returns a list of eventtable values (run order).
 447
 448 =cut
 449
 450 sub eventtables_runorder {
 451   shift->eventtables; #same for now
 452 }
 453
 454 =item eventtables_cust_join
 455
 456 Returns a hash reference of SQL expressions to join each eventtable to
 457 a table with a 'custnum' field.
 458
 459 =cut
 460
 461 sub eventtables_cust_join {
 462   my %hash = (
 463     'svc_acct' => 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum)',
 464   );
 465   \%hash;
 466 }
 467
 468 =item eventtables_custnum
 469
 470 Returns a hash reference of SQL expressions for the 'custnum' field when
 471 I<eventtables_cust_join> is in effect.  The default is "$eventtable.custnum".
 472
 473 =cut
 474
 475 sub eventtables_custnum {
 476   my %hash = (
 477     map({ $_, "$_.custnum" } shift->eventtables),
 478     'svc_acct' => 'cust_pkg.custnum'
 479   );
 480   \%hash;
 481 }
 482
 483
 484 =item check_freq_labels
 485
 486 Returns a hash reference of labels for check_freq values,
 487 i.e. '1d'=>'daily'
 488
 489 =cut
 490
 491 sub check_freq_labels {
 492   #my $class = shift;
 493
 494   #Tie::IxHash??
 495   {
 496     '1d' => 'daily',
 497     '1m' => 'monthly',
 498   };
 499 }
 500
 501 =item actions [ EVENTTABLE ]
 502
 503 Return information about the available actions.  If an eventtable is specified,
 504 only return information about actions available for that eventtable.
 505
 506 Information is returned as key-value pairs.  Keys are event names.  Values are
 507 hashrefs with the following keys:
 508
 509 =over 4
 510
 511 =item description
 512
 513 =item eventtable_hashref
 514
 515 =item option_fields
 516
 517 =item default_weight
 518
 519 =item deprecated
 520
 521 =back
 522
 523 =head1 ADDING NEW EVENTTABLES
 524
 525 To add an eventtable, you must:
 526
 527 =over 4
 528
 529 =item Add the table to "eventtable_labels" (with a label) and to
 530 "eventtable_pkey" (with its primary key).
 531
 532 =item If the table doesn't have a "custnum" field of its own (such
 533 as a svc_x table), add a suitable join expression to
 534 eventtables_cust_join and an expression for the final custnum field
 535 to eventtables_custnum.
 536
 537 =item Create a method named FS::cust_main->$eventtable(): a wrapper
 538 around qsearch() to return all records in the new table belonging to
 539 the cust_main object.  This method must accept 'addl_from' and
 540 'extra_sql' arguments in the way qsearch() does.  For svc_ tables,
 541 wrap the svc_x() method.
 542
 543 =item Add it to FS::cust_event->join_sql and search_sql_where so that
 544 search/cust_event.html will find it.
 545
 546 =item Create a UI link/form to search for events linked to objects
 547 in the new eventtable, using search/cust_event.html.  Place this
 548 somewhere appropriate to the eventtable.
 549
 550 =back
 551
 552 See L<FS::part_event::Action> for more information.
 553
 554 =cut
 555
 556 #false laziness w/part_event_condition.pm
 557 #some false laziness w/part_export & part_pkg
 558 my %actions;
 559 foreach my $INC ( @INC ) {
 560   foreach my $file ( glob("$INC/FS/part_event/Action/*.pm") ) {
 561     warn "attempting to load Action from $file\n" if $DEBUG;
 562     $file =~ /\/(\w+)\.pm$/ or do {
 563       warn "unrecognized file in $INC/FS/part_event/Action/: $file\n";
 564       next;
 565     };
 566     my $mod = $1;
 567     eval "use FS::part_event::Action::$mod;";
 568     if ( $@ ) {
 569       die "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 570       #warn "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 571       #next;
 572     }
 573     $actions{$mod} = {
 574       ( map { $_ => "FS::part_event::Action::$mod"->$_() }
 575             qw( description eventtable_hashref default_weight deprecated )
 576             #option_fields_hashref
 577       ),
 578       'option_fields' => [ "FS::part_event::Action::$mod"->option_fields() ],
 579     };
 580   }
 581 }
 582
 583 sub actions {
 584   my( $class, $eventtable ) = @_;
 585   (
 586     map  { $_ => $actions{$_} }
 587     sort { $actions{$a}->{'default_weight'}<=>$actions{$b}->{'default_weight'} }
 588        # || $actions{$a}->{'description'} cmp $actions{$b}->{'description'} }
 589     $class->all_actions( $eventtable )
 590   );
 591
 592 }
 593
 594 =item all_actions [ EVENTTABLE ]
 595
 596 Returns a list of just the action names
 597
 598 =cut
 599
 600 sub all_actions {
 601   my ( $class, $eventtable ) = @_;
 602
 603   grep { !$eventtable || $actions{$_}->{'eventtable_hashref'}{$eventtable} }
 604        keys %actions
 605 }
 606
 607 =item process_initialize 'eventpart' => EVENTPART
 608
 609 Job queue wrapper for "initialize".  EVENTPART identifies the
 610 L<FS::part_event> object to initialize.
 611
 612 =cut
 613
 614 sub process_initialize {
 615   my %opt = @_;
 616   my $part_event =
 617       qsearchs('part_event', { eventpart => $opt{'eventpart'}})
 618         or die "eventpart '$opt{eventpart}' not found!\n";
 619   $part_event->initialize;
 620 }
 621
 622 =back
 623
 624 =head1 SEE ALSO
 625
 626 L<FS::part_event_option>, L<FS::part_event_condition>, L<FS::cust_main>,
 627 L<FS::cust_pkg>, L<FS::svc_acct>, L<FS::cust_bill>, L<FS::cust_bill_event>,
 628 L<FS::Record>,
 629 schema.html from the base documentation.
 630
 631 =cut
 632
 633 1;
 634