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