FS/FS/part_bill_event.pm

   1 package FS::part_bill_event;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG @EXPORT_OK );
   5 use FS::Record qw( dbh qsearch qsearchs );
   6 use FS::Conf;
   7
   8 @ISA = qw( FS::Record );
   9 @EXPORT_OK = qw( due_events );
  10 $DEBUG = 0;
  11
  12 =head1 NAME
  13
  14 FS::part_bill_event - Object methods for part_bill_event records
  15
  16 =head1 SYNOPSIS
  17
  18   use FS::part_bill_event;
  19
  20   $record = new FS::part_bill_event \%hash;
  21   $record = new FS::part_bill_event { 'column' => 'value' };
  22
  23   $error = $record->insert;
  24
  25   $error = $new_record->replace($old_record);
  26
  27   $error = $record->delete;
  28
  29   $error = $record->check;
  30
  31   $error = $record->do_event( $direct_object );
  32
  33   @events = due_events ( { 'record' => $event_triggering_record,
  34                            'payby'  => $payby,
  35                            'event_time => $_date,
  36                            'extra_sql  => $extra } );
  37
  38 =head1 DESCRIPTION
  39
  40 An FS::part_bill_event object represents an invoice event definition -
  41 a callback which is triggered when an invoice is a certain amount of time
  42 overdue.  FS::part_bill_event inherits from
  43 FS::Record.  The following fields are currently supported:
  44
  45 =over 4
  46
  47 =item eventpart - primary key
  48
  49 =item payby - CARD, DCRD, CHEK, DCHK, LECB, BILL, or COMP
  50
  51 =item event - event name
  52
  53 =item eventcode - event action
  54
  55 =item seconds - how long after the invoice date events of this type are triggered
  56
  57 =item weight - ordering for events with identical seconds
  58
  59 =item plan - eventcode plan
  60
  61 =item plandata - additional plan data
  62
  63 =item reason   - an associated reason for this event to fire
  64
  65 =item disabled - Disabled flag, empty or `Y'
  66
  67 =back
  68
  69 =head1 METHODS
  70
  71 =over 4
  72
  73 =item new HASHREF
  74
  75 Creates a new invoice event definition.  To add the invoice event definition to
  76 the database, see L<"insert">.
  77
  78 Note that this stores the hash reference, not a distinct copy of the hash it
  79 points to.  You can ask the object for a copy with the I<hash> method.
  80
  81 =cut
  82
  83 # the new method can be inherited from FS::Record, if a table method is defined
  84
  85 sub table { 'part_bill_event'; }
  86
  87 =item insert
  88
  89 Adds this record to the database.  If there is an error, returns the error,
  90 otherwise returns false.
  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
 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 =cut
 110
 111 # the replace method can be inherited from FS::Record
 112
 113 =item check
 114
 115 Checks all fields to make sure this is a valid invoice event definition.  If
 116 there is an error, returns the error, otherwise returns false.  Called by the
 117 insert and replace methods.
 118
 119 =cut
 120
 121 # the check method should currently be supplied - FS::Record contains some
 122 # data checking routines
 123
 124 sub check {
 125   my $self = shift;
 126
 127   $self->weight(0) unless $self->weight;
 128
 129   my $conf = new FS::Conf;
 130   if ( $conf->exists('safe-part_bill_event') ) {
 131     my $error = $self->ut_anything('eventcode');
 132     return $error if $error;
 133
 134     my $c = $self->eventcode;
 135
 136     #yay, these regexen will go away with the event refactor
 137
 138     $c =~ /^\s*\$cust_main\->(suspend|cancel|invoicing_list_addpost|bill|collect)\(\);\s*("";)?\s*$/
 139
 140       or $c =~ /^\s*\$cust_bill\->(comp|realtime_(card|ach|lec)|batch_card|send)\((%options)*\);\s*$/
 141
 142       or $c =~ /^\s*\$cust_bill\->send(_if_newest)?\(\'[\w\-\s]+\'\s*(,\s*(\d+|\[\s*\d+(,\s*\d+)*\s*\])\s*,\s*'[\w\@\.\-\+]*'\s*)?\);\s*$/
 143
 144 #      or $c =~ /^\s*\$cust_main\->apply_payments; \$cust_main->apply_credits; "";\s*$/
 145       or $c =~ /^\s*\$cust_main\->apply_payments_and_credits; "";\s*$/
 146
 147       or $c =~ /^\s*\$cust_main\->charge\( \s*\d*\.?\d*\s*,\s*\'[\w \!\@\#\$\%\&\(\)\-\+\;\:\"\,\.\?\/]*\'\s*\);\s*$/
 148
 149       or $c =~ /^\s*\$cust_main\->suspend_(if|unless)_pkgpart\([\d\,\s]*\);\s*$/
 150
 151       or $c =~ /^\s*\$cust_bill\->cust_suspend_if_balance_over\([\d\.\s]*\);\s*$/
 152
 153       or do {
 154         #log
 155         return "illegal eventcode: $c";
 156       };
 157
 158   }
 159
 160   my $error = $self->ut_numbern('eventpart')
 161     || $self->ut_enum('payby', [qw( CARD DCLN DCRD CHEK DCHK LECB BILL COMP )] )
 162     || $self->ut_text('event')
 163     || $self->ut_anything('eventcode')
 164     || $self->ut_number('seconds')
 165     || $self->ut_enum('disabled', [ '', 'Y' ] )
 166     || $self->ut_number('weight')
 167     || $self->ut_textn('plan')
 168     || $self->ut_anything('plandata')
 169     || $self->ut_numbern('reason')
 170   ;
 171     #|| $self->ut_snumber('seconds')
 172   return $error if $error;
 173
 174   #quelle kludge
 175   if ( $self->plandata =~ /^(agent_)?templatename\s+(.*)$/m ) {
 176     my $name= $2;
 177
 178     foreach my $file (qw( template
 179                           latex latexnotes latexreturnaddress latexfooter
 180                             latexsmallfooter
 181                           html htmlnotes htmlreturnaddress htmlfooter
 182                      ))
 183     {
 184       unless ( $conf->exists("invoice_${file}_$name") ) {
 185         $conf->set(
 186           "invoice_${file}_$name" =>
 187             join("\n", $conf->config("invoice_$file") )
 188         );
 189       }
 190     }
 191   }
 192
 193   if ($self->reason){
 194     my $reasonr = qsearchs('reason', {'reasonnum' => $self->reason});
 195     return "Unknown reason" unless $reasonr;
 196   }
 197
 198   $self->SUPER::check;
 199 }
 200
 201 =item templatename
 202
 203 Returns the alternate invoice template name, if any, or false if there is
 204 no alternate template for this invoice event.
 205
 206 =cut
 207
 208 sub templatename {
 209   my $self = shift;
 210   if (    $self->plan     =~ /^send_(alternate|agent)$/
 211        && $self->plandata =~ /^(agent_)?templatename (.*)$/m
 212      )
 213   {
 214     $2;
 215   } else {
 216     '';
 217   }
 218 }
 219
 220 =item due_events
 221
 222 Returns the list of events due, if any, or false if there is none.
 223 Requires record and payby, but event_time and extra_sql are optional.
 224
 225 =cut
 226
 227 sub due_events {
 228   my ($record, $payby, $event_time, $extra_sql) = @_;
 229   my $interval = 0;
 230   if ($record->_date){
 231     $event_time = time unless $event_time;
 232     $interval = $event_time - $record->_date;
 233   }
 234   sort {    $a->seconds   <=> $b->seconds
 235          || $a->weight    <=> $b->weight
 236          || $a->eventpart <=> $b->eventpart }
 237     grep { $_->seconds <= ( $interval )
 238            && ! qsearch( 'cust_bill_event', {
 239                            'invnum' => $record->get($record->dbdef_table->primary_key),
 240                            'eventpart' => $_->eventpart,
 241                            'status' => 'done',
 242                                                                          } )
 243          }
 244       qsearch( {
 245         'table'     => 'part_bill_event',
 246         'hashref'   => { 'payby'    => $payby,
 247                          'disabled' => '',             },
 248         'extra_sql' => $extra_sql,
 249       } );
 250
 251
 252 }
 253
 254 =item do_event
 255
 256 Performs the event and returns any errors that occur.
 257 Requires a record on which to perform the event.
 258 Should only be performed inside a transaction.
 259
 260 =cut
 261
 262 sub do_event {
 263   my ($self, $object, %options) = @_;
 264   warn " calling event (". $self->eventcode. ") for " . $object->table . " " ,
 265     $object->get($object->dbdef_table->primary_key) . "\n" if $DEBUG > 1;
 266   my $oldAutoCommit = $FS::UID::AutoCommit;
 267   local $FS::UID::AutoCommit = 0;
 268
 269   #  for "callback" -- heh
 270   my $cust_main = $object->cust_main;
 271   my $cust_bill;
 272   if ($object->table eq 'cust_bill'){
 273     $cust_bill = $object;
 274   }
 275   my $cust_pay_batch;
 276   if ($object->table eq 'cust_pay_batch'){
 277     $cust_pay_batch = $object;
 278   }
 279
 280   my $error;
 281   {
 282     local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
 283     $error = eval $self->eventcode;
 284   }
 285
 286   my $status = '';
 287   my $statustext = '';
 288   if ( $@ ) {
 289     $status = 'failed';
 290     $statustext = $@;
 291   } elsif ( $error ) {
 292     $status = 'done';
 293     $statustext = $error;
 294   } else {
 295     $status = 'done';
 296   }
 297
 298   #add cust_bill_event
 299   my $cust_bill_event = new FS::cust_bill_event {
 300 #    'invnum'     => $object->get($object->dbdef_table->primary_key),
 301     'invnum'     => $object->invnum,
 302     'eventpart'  => $self->eventpart,
 303     '_date'      => time,
 304     'status'     => $status,
 305     'statustext' => $statustext,
 306   };
 307   $error = $cust_bill_event->insert;
 308   if ( $error ) {
 309     my $e = 'WARNING: Event run but database not updated - '.
 310             'error inserting cust_bill_event, invnum #'.  $object->invnum .
 311             ', eventpart '. $self->eventpart.": $error";
 312     warn $e;
 313     return $e;
 314   }
 315   '';
 316 }
 317
 318 =item reasontext
 319
 320 Returns the text of any reason associated with this event.
 321
 322 =cut
 323
 324 sub reasontext {
 325   my $self = shift;
 326   my $r = qsearchs('reason', { 'reasonnum' => $self->reason });
 327   if ($r){
 328     $r->reason;
 329   }else{
 330     '';
 331   }
 332 }
 333
 334 =back
 335
 336 =head1 BUGS
 337
 338 The whole "eventcode" idea is bunk.  This should be refactored with subclasses
 339 like part_pkg/ and part_export/
 340
 341 =head1 SEE ALSO
 342
 343 L<FS::cust_bill>, L<FS::cust_bill_event>, L<FS::Record>, schema.html from the
 344 base documentation.
 345
 346 =cut
 347
 348 1;
 349