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