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