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   my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 290     'time' => $time
 291   );
 292   $join = $linkage .
 293       " INNER JOIN part_event ON ( part_event.eventpart = $eventpart ) $join";
 294
 295   $where .= ' AND cust_main.agentnum = '.$self->agentnum
 296     if $self->agentnum;
 297   # don't enforce check_freq since this is a special, out-of-order check
 298   # and don't enforce disabled because we want to be able to see targets
 299   # for a disabled event
 300
 301   my @objects = qsearch({
 302       table     => $eventtable,
 303       hashref   => {},
 304       addl_from => $join,
 305       extra_sql => "WHERE $where",
 306   });
 307   my @tested_objects;
 308   foreach my $object ( @objects ) {
 309     my $cust_event = $self->new_cust_event($object, 'time' => $time);
 310     next unless $cust_event->test_conditions;
 311
 312     $object->set('cust_event', $cust_event);
 313     push @tested_objects, $object;
 314   }
 315   @tested_objects;
 316 }
 317
 318 =item initialize PARAMS
 319
 320 Identify all objects eligible for this event and create L<FS::cust_event>
 321 records for each of them, as of the present time, with status "initial".  When
 322 combined with conditions that prevent an event from running more than once
 323 (at all or within some period), this will exclude any objects that met the
 324 conditions before the event was created.
 325
 326 If an L<FS::part_event> object needs to be initialized, it should be created
 327 in a disabled state to avoid running the event prematurely for any existing
 328 objects.  C<initialize> will enable it once all the cust_event records
 329 have been created.
 330
 331 This may take some time, so it should be run from the job queue.
 332
 333 =cut
 334
 335 sub initialize {
 336   my $self = shift;
 337   my $error;
 338
 339   my $oldAutoCommit = $FS::UID::AutoCommit;
 340   local $FS::UID::AutoCommit = 0;
 341   my $dbh = dbh;
 342
 343   my @objects = $self->targets;
 344   foreach my $object ( @objects ) {
 345     my $cust_event = $object->get('cust_event');
 346     $cust_event->status('initial');
 347     $error = $cust_event->insert;
 348     last if $error;
 349   }
 350   if ( !$error and $self->disabled ) {
 351     $self->disabled('');
 352     $error = $self->replace;
 353   }
 354   if ( $error ) {
 355     $dbh->rollback;
 356     return $error;
 357   }
 358   $dbh->commit if $oldAutoCommit;
 359   return;
 360 }
 361
 362 =cut
 363
 364
 365 =back
 366
 367 =head1 CLASS METHODS
 368
 369 =over 4
 370
 371 =item eventtable_labels
 372
 373 Returns a hash reference of labels for eventtable values,
 374 i.e. 'cust_main'=>'Customer'
 375
 376 =cut
 377
 378 sub eventtable_labels {
 379   #my $class = shift;
 380
 381   tie my %hash, 'Tie::IxHash',
 382     'cust_pkg'       => 'Package',
 383     'cust_bill'      => 'Invoice',
 384     'cust_main'      => 'Customer',
 385     'cust_pay_batch' => 'Batch payment',
 386     'cust_statement' => 'Statement',  #too general a name here? "Invoice group"?
 387     'svc_acct'       => 'Login service',
 388   ;
 389
 390   \%hash
 391 }
 392
 393 =item eventtable_pkey_sql
 394
 395 Returns a hash reference of full SQL primary key names for eventtable values,
 396 i.e. 'cust_main'=>'cust_main.custnum'
 397
 398 =cut
 399
 400 sub eventtable_pkey_sql {
 401   my $class = shift;
 402
 403   my $hashref = $class->eventtable_pkey;
 404
 405   my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
 406
 407   \%hash;
 408 }
 409
 410 =item eventtable_pkey
 411
 412 Returns a hash reference of full SQL primary key names for eventtable values,
 413 i.e. 'cust_main'=>'custnum'
 414
 415 =cut
 416
 417 sub eventtable_pkey {
 418   #my $class = shift;
 419
 420   {
 421     'cust_main'      => 'custnum',
 422     'cust_bill'      => 'invnum',
 423     'cust_pkg'       => 'pkgnum',
 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