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