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