FS/FS/part_event.pm

   1 package FS::part_event;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use Carp qw(confess);
   6 use FS::Record qw( dbh qsearch qsearchs );
   7 use FS::option_Common;
   8 use FS::m2name_Common;
   9 use FS::Conf;
  10 use FS::part_event_option;
  11 use FS::part_event_condition;
  12 use FS::cust_event;
  13 use FS::agent;
  14
  15 @ISA = qw( FS::m2name_Common FS::option_Common ); # FS::Record );
  16 $DEBUG = 0;
  17
  18 =head1 NAME
  19
  20 FS::part_event - Object methods for part_event records
  21
  22 =head1 SYNOPSIS
  23
  24   use FS::part_event;
  25
  26   $record = new FS::part_event \%hash;
  27   $record = new FS::part_event { 'column' => 'value' };
  28
  29   $error = $record->insert( { 'option' => 'value' } );
  30   $error = $record->insert( \%options );
  31
  32   $error = $new_record->replace($old_record);
  33
  34   $error = $record->delete;
  35
  36   $error = $record->check;
  37
  38   $error = $record->do_event( $direct_object );
  39
  40 =head1 DESCRIPTION
  41
  42 An FS::part_event object represents an event definition - a billing, collection
  43 or other callback which is triggered when certain customer, invoice, package or
  44 other conditions are met.  FS::part_event inherits from FS::Record.  The
  45 following fields are currently supported:
  46
  47 =over 4
  48
  49 =item eventpart - primary key
  50
  51 =item agentnum - Optional agentnum (see L<FS::agent>)
  52
  53 =item event - event name
  54
  55 =item eventtable - table name against which this event is triggered: one of "cust_main", "cust_bill", "cust_statement", "cust_pkg", "svc_acct".
  56
  57 =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.
  58
  59 =item weight - ordering for events
  60
  61 =item action - event action (like part_bill_event.plan - eventcode plan)
  62
  63 =item disabled - Disabled flag, empty or `Y'
  64
  65 =back
  66
  67 =head1 METHODS
  68
  69 =over 4
  70
  71 =item new HASHREF
  72
  73 Creates a new invoice event definition.  To add the invoice event definition to
  74 the database, see L<"insert">.
  75
  76 Note that this stores the hash reference, not a distinct copy of the hash it
  77 points to.  You can ask the object for a copy with the I<hash> method.
  78
  79 =cut
  80
  81 # the new method can be inherited from FS::Record, if a table method is defined
  82
  83 sub table { 'part_event'; }
  84
  85 =item insert [ HASHREF ]
  86
  87 Adds this record to the database.  If there is an error, returns the error,
  88 otherwise returns false.
  89
  90 If a list or hash reference of options is supplied, part_export_option records
  91 are created (see L<FS::part_event_option>).
  92
  93 =cut
  94
  95 # the insert method can be inherited from FS::Record
  96
  97 =item delete
  98
  99 Delete this record from the database.
 100
 101 =cut
 102
 103 # the delete method can be inherited from FS::Record
 104
 105 =item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ]
 106
 107 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 108 returns the error, otherwise returns false.
 109
 110 If a list or hash reference of options is supplied, part_event_option
 111 records are created or modified (see L<FS::part_event_option>).
 112
 113 =cut
 114
 115 # the replace method can be inherited from FS::Record
 116
 117 =item check
 118
 119 Checks all fields to make sure this is a valid invoice event definition.  If
 120 there is an error, returns the error, otherwise returns false.  Called by the
 121 insert and replace methods.
 122
 123 =cut
 124
 125 # the check method should currently be supplied - FS::Record contains some
 126 # data checking routines
 127
 128 sub check {
 129   my $self = shift;
 130
 131   $self->weight(0) unless $self->weight;
 132
 133   my $error =
 134        $self->ut_numbern('eventpart')
 135     || $self->ut_text('event')
 136     || $self->ut_enum('eventtable', [ $self->eventtables ] )
 137     || $self->ut_enum('check_freq', [ '1d', '1m' ])
 138     || $self->ut_number('weight')
 139     || $self->ut_alpha('action')
 140     || $self->ut_enum('disabled', [ '', 'Y' ] )
 141     || $self->ut_agentnum_acl('agentnum', 'Edit global billing events')
 142   ;
 143   return $error if $error;
 144
 145   #XXX check action to make sure a module exists?
 146   # well it'll die in _rebless...
 147
 148   $self->SUPER::check;
 149 }
 150
 151 =item _rebless
 152
 153 Reblesses the object into the FS::part_event::Action::ACTION class, where
 154 ACTION is the object's I<action> field.
 155
 156 =cut
 157
 158 sub _rebless {
 159   my $self = shift;
 160   my $action = $self->action or return $self;
 161   #my $class = ref($self). "::$action";
 162   my $class = "FS::part_event::Action::$action";
 163   eval "use $class";
 164   die $@ if $@;
 165   bless($self, $class); # unless $@;
 166   $self;
 167 }
 168
 169 =item part_event_condition
 170
 171 Returns the conditions associated with this event, as FS::part_event_condition
 172 objects (see L<FS::part_event_condition>)
 173
 174 =cut
 175
 176 sub part_event_condition {
 177   my $self = shift;
 178   qsearch( 'part_event_condition', { 'eventpart' => $self->eventpart } );
 179 }
 180
 181 =item new_cust_event OBJECT, [ OPTION => VALUE ]
 182
 183 Creates a new customer event (see L<FS::cust_event>) for the provided object.
 184
 185 The only option allowed is 'time', to set the "current" time for the event.
 186
 187 =cut
 188
 189 sub new_cust_event {
 190   my( $self, $object, %opt ) = @_;
 191
 192   confess "**** $object is not a ". $self->eventtable
 193     if ref($object) ne "FS::". $self->eventtable;
 194
 195   my $pkey = $object->primary_key;
 196
 197   new FS::cust_event {
 198     'eventpart' => $self->eventpart,
 199     'tablenum'  => $object->$pkey(),
 200     #'_date'     => time, #i think we always want the real "now" here.
 201     '_date'     => ($opt{'time'} || time),
 202     'status'    => 'new',
 203   };
 204 }
 205
 206 #surely this doesn't work
 207 sub reasontext { confess "part_event->reasontext deprecated"; }
 208 #=item reasontext
 209 #
 210 #Returns the text of any reason associated with this event.
 211 #
 212 #=cut
 213 #
 214 #sub reasontext {
 215 #  my $self = shift;
 216 #  my $r = qsearchs('reason', { 'reasonnum' => $self->reason });
 217 #  if ($r){
 218 #    $r->reason;
 219 #  }else{
 220 #    '';
 221 #  }
 222 #}
 223
 224 =item agent
 225
 226 Returns the associated agent for this event, if any, as an FS::agent object.
 227
 228 =cut
 229
 230 sub agent {
 231   my $self = shift;
 232   qsearchs('agent', { 'agentnum' => $self->agentnum } );
 233 }
 234
 235 =item templatename
 236
 237 Returns the alternate invoice template name, if any, or false if there is
 238 no alternate template for this event.
 239
 240 =cut
 241
 242 sub templatename {
 243
 244   my $self = shift;
 245   if (    $self->action   =~ /^cust_bill_send_(alternate|agent)$/
 246           && (    $self->option('agent_templatename')
 247                || $self->option('templatename')       )
 248      )
 249   {
 250        $self->option('agent_templatename')
 251     || $self->option('templatename');
 252
 253   } else {
 254     '';
 255   }
 256 }
 257
 258 =item initialize PARAMS
 259
 260 Identify all objects eligible for this event and create L<FS::cust_event>
 261 records for each of them, as of the present time, with status "initial".  When
 262 combined with conditions that prevent an event from running more than once
 263 (at all or within some period), this will exclude any objects that met the
 264 conditions before the event was created.
 265
 266 If an L<FS::part_event> object needs to be initialized, it should be created
 267 in a disabled state to avoid running the event prematurely for any existing
 268 objects.  C<initialize> will enable it once all the cust_event records
 269 have been created.
 270
 271 This may take some time, so it should be run from the job queue.
 272
 273 =cut
 274
 275 sub initialize {
 276   my $self = shift;
 277   my $time = time; # $opt{'time'}?
 278
 279   my $oldAutoCommit = $FS::UID::AutoCommit;
 280   local $FS::UID::AutoCommit = 0;
 281   my $dbh = dbh;
 282
 283   my $eventpart = $self->eventpart;
 284   $eventpart =~ /^\d+$/ or die "bad eventpart $eventpart";
 285   my $eventtable = $self->eventtable;
 286
 287   # find all objects that meet the conditions for this part_event
 288   my $linkage = '';
 289   # this is the 'object' side of the FROM clause
 290   if ( $eventtable ne 'cust_main' ) {
 291     $linkage = ($self->eventtables_cust_join->{$eventtable} || '') .
 292         ' LEFT JOIN cust_main USING (custnum) '
 293   }
 294
 295   # this is the 'event' side
 296   my $join  = FS::part_event_condition->join_conditions_sql( $eventtable );
 297   my $where = FS::part_event_condition->where_conditions_sql( $eventtable,
 298     'time' => $time
 299   );
 300   $join = $linkage .
 301       " INNER JOIN part_event ON ( part_event.eventpart = $eventpart ) $join";
 302
 303   $where .= ' AND cust_main.agentnum = '.$self->agentnum
 304     if $self->agentnum;
 305   # don't enforce check_freq since this is a special, out-of-order check,
 306   # and don't enforce disabled because we want to do this with the part_event
 307   # disabled.
 308   my @objects = qsearch({
 309       table     => $eventtable,
 310       hashref   => {},
 311       addl_from => $join,
 312       extra_sql => "WHERE $where",
 313       debug     => 1,
 314   });
 315   warn "initialize: ".(scalar @objects) ." $eventtable objects found\n"
 316     if $DEBUG;
 317   my $error = '';
 318   foreach my $object ( @objects ) {
 319     # test conditions
 320     my $cust_event = $self->new_cust_event($object, 'time' => $time);
 321     next unless $cust_event->test_conditions;
 322
 323     $cust_event->status('initial');
 324     $error = $cust_event->insert;
 325     last if $error;
 326   }
 327   if ( !$error and $self->disabled ) {
 328     $self->disabled('');
 329     $error = $self->replace;
 330   }
 331   if ( $error ) {
 332     $dbh->rollback;
 333     return $error;
 334   }
 335   $dbh->commit if $oldAutoCommit;
 336   return;
 337 }
 338
 339 =cut
 340
 341
 342 =back
 343
 344 =head1 CLASS METHODS
 345
 346 =over 4
 347
 348 =item eventtable_labels
 349
 350 Returns a hash reference of labels for eventtable values,
 351 i.e. 'cust_main'=>'Customer'
 352
 353 =cut
 354
 355 sub eventtable_labels {
 356   #my $class = shift;
 357
 358   tie my %hash, 'Tie::IxHash',
 359     'cust_pkg'       => 'Package',
 360     'cust_bill'      => 'Invoice',
 361     'cust_main'      => 'Customer',
 362     'cust_pay_batch' => 'Batch payment',
 363     'cust_statement' => 'Statement',  #too general a name here? "Invoice group"?
 364     'svc_acct'       => 'Login service',
 365   ;
 366
 367   \%hash
 368 }
 369
 370 =item eventtable_pkey_sql
 371
 372 Returns a hash reference of full SQL primary key names for eventtable values,
 373 i.e. 'cust_main'=>'cust_main.custnum'
 374
 375 =cut
 376
 377 sub eventtable_pkey_sql {
 378   my $class = shift;
 379
 380   my $hashref = $class->eventtable_pkey;
 381
 382   my %hash = map { $_ => "$_.". $hashref->{$_} } keys %$hashref;
 383
 384   \%hash;
 385 }
 386
 387 =item eventtable_pkey
 388
 389 Returns a hash reference of full SQL primary key names for eventtable values,
 390 i.e. 'cust_main'=>'custnum'
 391
 392 =cut
 393
 394 sub eventtable_pkey {
 395   #my $class = shift;
 396
 397   {
 398     'cust_main'      => 'custnum',
 399     'cust_bill'      => 'invnum',
 400     'cust_pkg'       => 'pkgnum',
 401     'cust_pay_batch' => 'paybatchnum',
 402     'cust_statement' => 'statementnum',
 403     'svc_acct'       => 'svcnum',
 404   };
 405 }
 406
 407 =item eventtables
 408
 409 Returns a list of eventtable values (default ordering; suited for display).
 410
 411 =cut
 412
 413 sub eventtables {
 414   my $class = shift;
 415   my $eventtables = $class->eventtable_labels;
 416   keys %$eventtables;
 417 }
 418
 419 =item eventtables_runorder
 420
 421 Returns a list of eventtable values (run order).
 422
 423 =cut
 424
 425 sub eventtables_runorder {
 426   shift->eventtables; #same for now
 427 }
 428
 429 =item eventtables_cust_join
 430
 431 Returns a hash reference of SQL expressions to join each eventtable to
 432 a table with a 'custnum' field.
 433
 434 =cut
 435
 436 sub eventtables_cust_join {
 437   my %hash = (
 438     'svc_acct' => 'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum)',
 439   );
 440   \%hash;
 441 }
 442
 443 =item eventtables_custnum
 444
 445 Returns a hash reference of SQL expressions for the 'custnum' field when
 446 I<eventtables_cust_join> is in effect.  The default is "$eventtable.custnum".
 447
 448 =cut
 449
 450 sub eventtables_custnum {
 451   my %hash = (
 452     map({ $_, "$_.custnum" } shift->eventtables),
 453     'svc_acct' => 'cust_pkg.custnum'
 454   );
 455   \%hash;
 456 }
 457
 458
 459 =item check_freq_labels
 460
 461 Returns a hash reference of labels for check_freq values,
 462 i.e. '1d'=>'daily'
 463
 464 =cut
 465
 466 sub check_freq_labels {
 467   #my $class = shift;
 468
 469   #Tie::IxHash??
 470   {
 471     '1d' => 'daily',
 472     '1m' => 'monthly',
 473   };
 474 }
 475
 476 =item actions [ EVENTTABLE ]
 477
 478 Return information about the available actions.  If an eventtable is specified,
 479 only return information about actions available for that eventtable.
 480
 481 Information is returned as key-value pairs.  Keys are event names.  Values are
 482 hashrefs with the following keys:
 483
 484 =over 4
 485
 486 =item description
 487
 488 =item eventtable_hashref
 489
 490 =item option_fields
 491
 492 =item default_weight
 493
 494 =item deprecated
 495
 496 =back
 497
 498 =head1 ADDING NEW EVENTTABLES
 499
 500 To add an eventtable, you must:
 501
 502 =over 4
 503
 504 =item Add the table to "eventtable_labels" (with a label) and to
 505 "eventtable_pkey" (with its primary key).
 506
 507 =item If the table doesn't have a "custnum" field of its own (such
 508 as a svc_x table), add a suitable join expression to
 509 eventtables_cust_join and an expression for the final custnum field
 510 to eventtables_custnum.
 511
 512 =item Create a method named FS::cust_main->$eventtable(): a wrapper
 513 around qsearch() to return all records in the new table belonging to
 514 the cust_main object.  This method must accept 'addl_from' and
 515 'extra_sql' arguments in the way qsearch() does.  For svc_ tables,
 516 wrap the svc_x() method.
 517
 518 =item Add it to FS::cust_event->join_sql and search_sql_where so that
 519 search/cust_event.html will find it.
 520
 521 =item Create a UI link/form to search for events linked to objects
 522 in the new eventtable, using search/cust_event.html.  Place this
 523 somewhere appropriate to the eventtable.
 524
 525 =back
 526
 527 See L<FS::part_event::Action> for more information.
 528
 529 =cut
 530
 531 #false laziness w/part_event_condition.pm
 532 #some false laziness w/part_export & part_pkg
 533 my %actions;
 534 foreach my $INC ( @INC ) {
 535   foreach my $file ( glob("$INC/FS/part_event/Action/*.pm") ) {
 536     warn "attempting to load Action from $file\n" if $DEBUG;
 537     $file =~ /\/(\w+)\.pm$/ or do {
 538       warn "unrecognized file in $INC/FS/part_event/Action/: $file\n";
 539       next;
 540     };
 541     my $mod = $1;
 542     eval "use FS::part_event::Action::$mod;";
 543     if ( $@ ) {
 544       die "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 545       #warn "error using FS::part_event::Action::$mod (skipping): $@\n" if $@;
 546       #next;
 547     }
 548     $actions{$mod} = {
 549       ( map { $_ => "FS::part_event::Action::$mod"->$_() }
 550             qw( description eventtable_hashref default_weight deprecated )
 551             #option_fields_hashref
 552       ),
 553       'option_fields' => [ "FS::part_event::Action::$mod"->option_fields() ],
 554     };
 555   }
 556 }
 557
 558 sub actions {
 559   my( $class, $eventtable ) = @_;
 560   (
 561     map  { $_ => $actions{$_} }
 562     sort { $actions{$a}->{'default_weight'}<=>$actions{$b}->{'default_weight'} }
 563     $class->all_actions( $eventtable )
 564   );
 565
 566 }
 567
 568 =item all_actions [ EVENTTABLE ]
 569
 570 Returns a list of just the action names
 571
 572 =cut
 573
 574 sub all_actions {
 575   my ( $class, $eventtable ) = @_;
 576
 577   grep { !$eventtable || $actions{$_}->{'eventtable_hashref'}{$eventtable} }
 578        keys %actions
 579 }
 580
 581 =item process_initialize 'eventpart' => EVENTPART
 582
 583 Job queue wrapper for "initialize".  EVENTPART identifies the
 584 L<FS::part_event> object to initialize.
 585
 586 =cut
 587
 588 sub process_initialize {
 589   my %opt = @_;
 590   my $part_event =
 591       qsearchs('part_event', { eventpart => $opt{'eventpart'}})
 592         or die "eventpart '$opt{eventpart}' not found!\n";
 593   $part_event->initialize;
 594 }
 595
 596 =back
 597
 598 =head1 SEE ALSO
 599
 600 L<FS::part_event_option>, L<FS::part_event_condition>, L<FS::cust_main>,
 601 L<FS::cust_pkg>, L<FS::svc_acct>, L<FS::cust_bill>, L<FS::cust_bill_event>,
 602 L<FS::Record>,
 603 schema.html from the base documentation.
 604
 605 =cut
 606
 607 1;
 608