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