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