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