RT#41866: Punctuation prevented package from billing [v3 reconcile]
[freeside.git] / FS / FS / cust_event.pm
1 package FS::cust_event;
2
3 use strict;
4 use base qw( FS::cust_main_Mixin FS::Record );
5 use vars qw( @ISA $DEBUG $me );
6 use Carp qw( croak confess );
7 use FS::Record qw( qsearch qsearchs dbdef );
8 use FS::part_event;
9 #for cust_X
10 use FS::cust_main;
11 use FS::cust_pkg;
12 use FS::cust_bill;
13 use FS::cust_pay;
14 use FS::svc_acct;
15
16 $DEBUG = 0;
17 $me = '[FS::cust_event]';
18
19 =head1 NAME
20
21 FS::cust_event - Object methods for cust_event records
22
23 =head1 SYNOPSIS
24
25   use FS::cust_event;
26
27   $record = new FS::cust_event \%hash;
28   $record = new FS::cust_event { 'column' => 'value' };
29
30   $error = $record->insert;
31
32   $error = $new_record->replace($old_record);
33
34   $error = $record->delete;
35
36   $error = $record->check;
37
38 =head1 DESCRIPTION
39
40 An FS::cust_event object represents an completed event.  FS::cust_event
41 inherits from FS::Record.  The following fields are currently supported:
42
43 =over 4
44
45 =item eventnum - primary key
46
47 =item eventpart - event definition (see L<FS::part_event>)
48
49 =item tablenum - customer, package or invoice, depending on the value of part_event.eventtable (see L<FS::cust_main>, L<FS::cust_pkg>, and L<FS::cust_bill>)
50
51 =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
52 L<Time::Local> and L<Date::Parse> for conversion functions.
53
54 =item status - event status: B<new>, B<locked>, B<done> or B<failed>.  Note: B<done> indicates the event is complete and should not be retried (statustext may still be set to an optional message), while B<failed> indicates the event failed and should be retried.
55
56 =item statustext - additional status detail (i.e. error or progress message)
57
58 =item no_action - 'Y' if the event action wasn't performed. Some actions
59 contain an internal check to see if the action is going to be impossible (for
60 example, emailing a notice to a customer who has no email address), and if so,
61 won't attempt the action. It shouldn't be reported as a failure because
62 there's no need to retry it. However, the action should set no_action = 'Y'
63 so that there's a record.
64
65 =back
66
67 =head1 METHODS
68
69 =over 4
70
71 =item new HASHREF
72
73 Creates a new completed invoice event.  To add the compelted invoice event 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 { 'cust_event'; }
84
85 sub cust_linked { $_[0]->cust_main_custnum; } 
86 sub cust_unlinked_msg {
87   my $self = shift;
88   "WARNING: can't find cust_main.custnum ". $self->custnum;
89   #' (cust_bill.invnum '. $self->invnum. ')';
90 }
91 sub custnum {
92   my $self = shift;
93   $self->cust_main_custnum(@_) || $self->SUPER::custnum(@_);
94 }
95
96 =item insert
97
98 Adds this record to the database.  If there is an error, returns the error,
99 otherwise returns false.
100
101 =cut
102
103 # the insert method can be inherited from FS::Record
104
105 =item delete
106
107 Delete this record from the database.
108
109 =cut
110
111 # the delete method can be inherited from FS::Record
112
113 =item replace OLD_RECORD
114
115 Replaces the OLD_RECORD with this one in the database.  If there is an error,
116 returns the error, otherwise returns false.
117
118 =cut
119
120 # the replace method can be inherited from FS::Record
121
122 =item check
123
124 Checks all fields to make sure this is a valid completed invoice event.  If
125 there is an error, returns the error, otherwise returns false.  Called by the
126 insert and replace methods.
127
128 =cut
129
130 # the check method should currently be supplied - FS::Record contains some
131 # data checking routines
132
133 sub check {
134   my $self = shift;
135
136   my $error = $self->ut_numbern('eventnum')
137     || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart')
138   ;
139   return $error if $error;
140
141   my $eventtable = $self->part_event->eventtable;
142   my $dbdef_eventtable = dbdef->table( $eventtable );
143
144   $error = 
145        $self->ut_foreign_key( 'tablenum',
146                               $eventtable,
147                               $dbdef_eventtable->primary_key
148                             )
149     || $self->ut_number('_date')
150     || $self->ut_enum('status', [qw( new locked done failed initial)])
151     || $self->ut_anything('statustext')
152     || $self->ut_flag('no_action')
153   ;
154   return $error if $error;
155
156   $self->SUPER::check;
157 }
158
159 =item part_event
160
161 Returns the event definition (see L<FS::part_event>) for this completed event.
162
163 =cut
164
165 sub part_event {
166   my $self = shift;
167   qsearchs( 'part_event', { 'eventpart' => $self->eventpart } );
168 }
169
170 =item cust_X
171
172 Returns the customer, package, invoice or batched payment (see
173 L<FS::cust_main>, L<FS::cust_pkg>, L<FS::cust_bill> or L<FS::cust_pay_batch>)
174 for this completed invoice event.
175
176 =cut
177
178 sub cust_bill {
179   croak "FS::cust_event::cust_bill called";
180 }
181
182 sub cust_X {
183   my $self = shift;
184   my $eventtable = $self->part_event->eventtable;
185   my $dbdef_table = dbdef->table( $eventtable );
186   my $primary_key = $dbdef_table->primary_key;
187   qsearchs( $eventtable, { $primary_key => $self->tablenum } );
188 }
189
190 =item test_conditions [ OPTION => VALUE ... ]
191
192 Tests conditions for this event, returns true if all conditions are satisfied,
193 false otherwise.
194
195 =cut
196
197 sub test_conditions {
198   my( $self, %opt ) = @_;
199   my $part_event = $self->part_event;
200   my $object = $self->cust_X;
201   my @conditions = $part_event->part_event_condition;
202   $opt{'cust_event'} = $self;
203   $opt{'time'} = $self->_date
204       or die "test_conditions called without cust_event._date\n";
205     # this MUST be set, or all hell breaks loose in event conditions.
206     # it MUST be in the same time as in the cust_event object, or
207     # future time-dependent events will trigger incorrectly.
208
209   #no unsatisfied conditions
210   #! grep ! $_->condition( $object, %opt ), @conditions;
211   my @unsatisfied = grep ! $_->condition( $object, %opt ), @conditions;
212
213   if ( $opt{'stats_hashref'} ) {
214     foreach my $unsat (@unsatisfied) {
215       $opt{'stats_hashref'}->{$unsat->conditionname}++;
216     }
217   } 
218
219   ! @unsatisfied;
220 }
221
222 =item do_event
223
224 Runs the event action.
225
226 =cut
227
228 sub do_event {
229   my $self = shift;
230   my %opt = @_; # currently only 'time'
231   my $time = $opt{'time'} || time;
232
233   my $part_event = $self->part_event;
234
235   my $object = $self->cust_X;
236   my $obj_pkey = $object->primary_key;
237   my $for = "for ". $object->table. " ". $object->$obj_pkey();
238   warn "running cust_event ". $self->eventnum.
239        " (". $part_event->action. ") $for\n"
240     if $DEBUG;
241
242   my $error;
243   {
244     local $SIG{__DIE__}; # don't want Mason __DIE__ handler active
245     $error = eval { $part_event->do_action($object, $self); };
246   }
247
248   my $status = '';
249   my $statustext = '';
250   if ( $@ ) {
251     $status = 'failed';
252     #$statustext = $@;
253     $statustext = "Error running ". $part_event->action. " action: $@";
254   } elsif ( $error ) {
255     $status = 'done';
256     $statustext = $error;
257   } else {
258     $status = 'done';
259   }
260
261   #replace or add myself
262   $self->_date($time);
263   $self->status($status);
264   $self->statustext($statustext);
265
266   $error = $self->eventnum ? $self->replace : $self->insert;
267   if ( $error ) {
268     #this is why we need that locked state...
269     my $e = 'WARNING: Event run but database not updated - '.
270             'error replacing or inserting cust_event '. $self->eventnum.
271             " $for: $error\n";
272     warn $e;
273     return $e;
274   }
275
276   '';
277
278 }
279
280 =item retry
281
282 Changes the status of this event from B<done> to B<failed>, allowing it to be
283 retried.
284
285 =cut
286
287 sub retry {
288   my $self = shift;
289   return '' unless $self->status eq 'done';
290   my $old = ref($self)->new( { $self->hash } );
291   $self->status('failed');
292   $self->replace($old);
293 }
294
295 #=item retryable
296 #
297 #Changes the statustext of this event to B<retriable>, rendering it 
298 #retriable (should retry be called).
299 #
300 #=cut
301
302 sub retriable {
303   confess "cust_event->retriable called";
304   my $self = shift;
305   return '' unless $self->status eq 'done';
306   my $old = ref($self)->new( { $self->hash } );
307   $self->statustext('retriable');
308   $self->replace($old);
309 }
310
311 =item join_sql
312
313 =cut
314
315 sub join_sql {
316   #my $class = shift;
317
318   "
319        JOIN part_event USING ( eventpart )
320   LEFT JOIN cust_bill ON ( eventtable = 'cust_bill' AND tablenum = invnum  )
321   LEFT JOIN cust_pkg  ON ( eventtable = 'cust_pkg'  AND tablenum = pkgnum  )
322   LEFT JOIN cust_pay  ON ( eventtable = 'cust_pay'  AND tablenum = paynum  )
323   LEFT JOIN cust_svc  ON ( eventtable = 'svc_acct'  AND tablenum = svcnum  )
324   LEFT JOIN cust_pkg AS cust_pkg_for_svc ON ( cust_svc.pkgnum = cust_pkg_for_svc.pkgnum )
325   LEFT JOIN cust_main ON (
326        ( eventtable = 'cust_main' AND tablenum = cust_main.custnum )
327     OR ( eventtable = 'cust_bill' AND cust_bill.custnum = cust_main.custnum )
328     OR ( eventtable = 'cust_pkg'  AND cust_pkg.custnum  = cust_main.custnum )
329     OR ( eventtable = 'cust_pay'  AND cust_pay.custnum  = cust_main.custnum )
330     OR ( eventtable = 'svc_acct'  AND cust_pkg_for_svc.custnum  = cust_main.custnum )
331   )
332   ";
333
334 }
335
336 =item search_sql_where HASHREF
337
338 Class method which returns an SQL WHERE fragment to search for parameters
339 specified in HASHREF.  Valid parameters are
340
341 =over 4
342
343 =item agentnum
344
345 =item custnum
346
347 =item invnum
348
349 =item pkgnum
350
351 =item svcnum
352
353 =item failed
354
355 =item beginning
356
357 =item ending
358
359 =item payby
360
361 =item 
362
363 =back
364
365 =cut
366
367 #Note: validates all passed-in data; i.e. safe to use with unchecked CGI params.
368 #sub 
369
370 sub search_sql_where {
371   my($class, $param) = @_;
372   if ( $DEBUG ) {
373     warn "$me search_sql_where called with params: \n".
374          join("\n", map { "  $_: ". $param->{$_} } keys %$param ). "\n";
375   }
376
377   my @search = $class->cust_search_sql($param);
378
379   #eventpart
380   my @eventpart = ref($param->{'eventpart'})
381                     ? @{ $param->{'eventpart'} }
382                     : split(',', $param->{'eventpart'});
383   @eventpart = grep /^(\d+)$/, @eventpart;
384   if ( @eventpart ) {
385     push @search, 'eventpart IN ('. join(',', @eventpart). ')';
386   }
387
388   if ( $param->{'beginning'} =~ /^(\d+)$/ ) {
389     push @search, "cust_event._date >= $1";
390   }
391   if ( $param->{'ending'} =~ /^(\d+)$/ ) {
392     push @search, "cust_event._date <= $1";
393   }
394
395   #if ( $param->{'failed'} ) {
396   #  push @search, "statustext != ''",
397   #                "statustext IS NOT NULL",
398   #                "statustext != 'N/A'";
399   #}
400   # huh?
401
402   if ( $param->{'event_status'} ) {
403
404     my @status;
405     my ($done_Y, $done_N);
406     foreach (@{ $param->{'event_status'} }) {
407       if ($_ eq 'done_Y') {
408         $done_Y = 1;
409       } elsif ( $_ eq 'done_N' ) {
410         $done_N = 1;
411       } else {
412         push @status, $_;
413       }
414     }
415     if ( $done_Y or $done_N ) {
416       push @status, 'done';
417     }
418     if ( @status ) {
419       push @search, "cust_event.status IN(" .
420                     join(',', map "'$_'", @status) .
421                     ')';
422     }
423
424     if ( $done_Y and not $done_N ) {
425       push @search, "cust_event.no_action IS NULL";
426     } elsif ( $done_N and not $done_Y ) {
427       push @search, "cust_event.no_action = 'Y'";
428     } # else they're both true, so don't add a constraint, or both false,
429       # and it doesn't matter.
430
431   } # event_status
432
433   # always hide initialization
434   push @search, 'cust_event.status != \'initial\'';
435
436   if ( $param->{'custnum'} =~ /^(\d+)$/ ) {
437     push @search, "cust_main.custnum = '$1'";
438   }
439
440   if ( $param->{'invnum'} =~ /^(\d+)$/ ) {
441     push @search, "part_event.eventtable = 'cust_bill'",
442                   "tablenum = '$1'";
443   }
444
445   if ( $param->{'pkgnum'} =~ /^(\d+)$/ ) {
446     push @search, "part_event.eventtable = 'cust_pkg'",
447                   "tablenum = '$1'";
448   }
449
450   if ( $param->{'paynum'} =~ /^(\d+)$/ ) {
451     push @search, "part_event.eventtable = 'cust_pay'",
452                   "tablenum = '$1'";
453   }
454
455   if ( $param->{'svcnum'} =~ /^(\d+)$/ ) {
456     push @search, "part_event.eventtable = 'svc_acct'",
457                   "tablenum = '$1'";
458   }
459
460   my $where = 'WHERE '. join(' AND ', @search );
461
462   join(' AND ', @search );
463
464 }
465
466 =back
467
468 =head1 SUBROUTINES
469
470 =over 4
471
472 =item reprint
473
474 =cut
475
476 sub process_reprint {
477   process_re_X('print', @_);
478 }
479
480 =item reemail
481
482 =cut
483
484 sub process_reemail {
485   process_re_X('email', @_);
486 }
487
488 =item refax
489
490 =cut
491
492 sub process_refax {
493   process_re_X('fax', @_);
494 }
495
496 use Storable qw(thaw);
497 use Data::Dumper;
498 use MIME::Base64;
499 sub process_re_X {
500   my( $method, $job ) = ( shift, shift );
501
502   my $param = thaw(decode_base64(shift));
503   warn Dumper($param) if $DEBUG;
504
505   re_X(
506     $method,
507     $param,
508     $job,
509   );
510
511 }
512
513 sub re_X {
514   my($method, $param, $job) = @_;
515
516   my $search_sql = FS::cust_event->search_sql_where($param);
517
518   #maybe not...?  we do want the "re-" action to match the search more closely
519   #            # yuck!  hardcoded *AND* sequential scans!
520   #my $where = " WHERE action LIKE 'cust_bill_send%' ".
521   #           ( $search_sql ? " AND $search_sql" : "" );
522
523   my $where = ( $search_sql ? " WHERE $search_sql" : "" );
524
525   my @cust_event = qsearch({
526     'table'     => 'cust_event',
527     'addl_from' => FS::cust_event->join_sql(),
528     'hashref'   => {},
529     'extra_sql' => $where,
530   });
531
532   warn "$me re_X found ". scalar(@cust_event). " events\n"
533     if $DEBUG;
534
535   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
536   foreach my $cust_event ( @cust_event ) {
537
538     my $cust_X = $cust_event->cust_X; # cust_bill
539     next unless $cust_X->can($method);
540
541     my $part_event = $cust_event->part_event;
542     my $template = $part_event->templatename
543                    || $cust_X->agent_template;
544     my $modenum = $part_event->option('modenum') || '';
545     my $invoice_from = $part_event->option('agent_invoice_from') || '';
546     $cust_X->set('mode' => $modenum);
547     $cust_X->$method( { template => $template,
548                         modenum  => $modenum,
549                         from     => $invoice_from,
550                     } );
551
552     if ( $job ) { #progressbar foo
553       $num++;
554       if ( time - $min_sec > $last ) {
555         my $error = $job->update_statustext(
556           int( 100 * $num / scalar(@cust_event) )
557         );
558         die $error if $error;
559         $last = time;
560       }
561     }
562
563   }
564
565   #this doesn't work, but it would be nice
566   #if ( $job ) { #progressbar foo
567   #  my $error = $job->update_statustext(
568   #    scalar(@cust_event). " invoices re-${method}ed"
569   #  );
570   #  die $error if $error;
571   #}
572
573 }
574
575 =back
576
577 =head1 SEE ALSO
578
579 L<FS::part_event>, L<FS::cust_bill>, L<FS::Record>, schema.html from the
580 base documentation.
581
582 =cut
583
584 1;
585