start of svc_acct events, #13202
[freeside.git] / FS / FS / part_event / Condition.pm
1 package FS::part_event::Condition;
2
3 use strict;
4 use base qw( FS::part_event_condition );
5 use Time::Local qw(timelocal_nocheck);
6 use FS::UID qw( driver_name );
7
8 =head1 NAME
9
10 FS::part_event::Condition - Base class for event conditions
11
12 =head1 SYNOPSIS
13
14 package FS::part_event::Condition::mycondition;
15
16 use base FS::part_event::Condition;
17
18 =head1 DESCRIPTION
19
20 FS::part_event::Condition is a base class for event conditions classes.
21
22 =head1 METHODS
23
24 These methods are implemented in each condition class.
25
26 =over 4
27
28 =item description
29
30 Condition classes must define a description method.  This method should return
31 a scalar description of the condition.
32
33 =item eventtable_hashref
34
35 Condition classes must define an eventtable_hashref method if they can only be
36 tested against some kinds of tables. This method should return a hash reference
37 of eventtables (values set true indicate the condition can be tested):
38
39   sub eventtable_hashref {
40     { 'cust_main'      => 1,
41       'cust_bill'      => 1,
42       'cust_pkg'       => 0,
43       'cust_pay_batch' => 0,
44       'cust_statement' => 0,
45     };
46   }
47
48 =cut
49
50 #fallback
51 sub eventtable_hashref {
52     { 'cust_main'      => 1,
53       'cust_bill'      => 1,
54       'cust_pkg'       => 1,
55       'cust_pay_batch' => 1,
56       'cust_statement' => 1,
57       'svc_acct'       => 1,
58     };
59 }
60
61 =item option_fields
62
63 Condition classes may define an option_fields method to indicate that they
64 accept one or more options.
65
66 This method should return a list of option names and option descriptions.
67 Each option description can be a scalar description, for simple options, or a
68 hashref with the following values:
69
70 =over 4
71
72 =item label - Description
73
74 =item type - Currently text, money, checkbox, checkbox-multiple, select, select-agent, select-pkg_class, select-part_referral, select-table, fixed, hidden, (others can be implemented as httemplate/elements/tr-TYPE.html mason components).  Defaults to text.
75
76 =item options - For checkbox-multiple and select, a list reference of available option values.
77
78 =item option_labels - For checkbox-multiple (and select?), a hash reference of availble option values and labels.
79
80 =item value - for checkbox, fixed, hidden (also a default for text, money, more?)
81
82 =item table - for select-table
83
84 =item name_col - for select-table
85
86 =item NOTE: See httemplate/elements/select-table.html for a full list of the optinal options for the select-table type
87
88 =back
89
90 NOTE: A database connection is B<not> yet available when this subroutine is
91 executed.
92
93 Example:
94
95   sub option_fields {
96     (
97       'field'         => 'description',
98
99       'another_field' => { 'label'=>'Amount', 'type'=>'money', },
100
101       'third_field'   => { 'label'         => 'Types',
102                            'type'          => 'checkbox-multiple',
103                            'options'       => [ 'h', 's' ],
104                            'option_labels' => { 'h' => 'Happy',
105                                                 's' => 'Sad',
106                                               },
107     );
108   }
109
110 =cut
111
112 #fallback
113 sub option_fields {
114   ();
115 }
116
117 =item condition CUSTOMER_EVENT_OBJECT
118
119 Condition classes must define a condition method.  This method is evaluated
120 to determine if the condition has been met.  The object which triggered the
121 event (an FS::cust_main, FS::cust_bill or FS::cust_pkg object) is passed as
122 the first argument.  Additional arguments are list of key-value pairs.
123
124 To retreive option values, call the option method on the desired option, i.e.:
125
126   my( $self, $cust_object, %opts ) = @_;
127   $value_of_field = $self->option('field');
128
129 Available additional arguments:
130
131   $time = $opt{'time'}; #use this instead of time or $^T
132
133   $cust_event = $opt{'cust_event'}; #to retreive the cust_event object being tested
134
135 Return a true value if the condition has been met, and a false value if it has
136 not.
137
138 =item condition_sql EVENTTABLE
139
140 Condition classes may optionally define a condition_sql method.  This B<class>
141 method should return an SQL fragment that tests for this condition.  The
142 fragment is evaluated and a true value of this expression indicates that the
143 condition has been met.  The event table (cust_main, cust_bill or cust_pkg) is
144 passed as an argument.
145
146 This method is used for optimizing event queries.  You may want to add indices
147 for any columns referenced.  It is acceptable to return an SQL fragment which
148 partially tests the condition; doing so will still reduce the number of
149 records which must be returned and tested with the B<condition> method.
150
151 =cut
152
153 # fallback.
154 sub condition_sql {
155   my( $class, $eventtable ) = @_;
156   #...
157   'true';
158 }
159
160 =item disabled
161
162 Condition classes may optionally define a disabled method.  Returning a true
163 value disbles the condition entirely.
164
165 =cut
166
167 sub disabled {
168   0;
169 }
170
171 =item implicit_flag
172
173 This is used internally by the I<once> and I<balance> conditions.  You probably
174 do B<not> want to define this method for new custom conditions, unless you're
175 sure you want B<every> new action to start with your condition.
176
177 Condition classes may define an implicit_flag method that returns true to
178 indicate that all new events should start with this condition.  (Currently,
179 condition classes which do so should be applicable to all kinds of
180 I<eventtable>s.)  The numeric value of the flag also defines the ordering of
181 implicit conditions.
182
183 =cut
184
185 #fallback
186 sub implicit_flag { 0; }
187
188 =item remove_warning
189
190 Again, used internally by the I<once> and I<balance> conditions; probably not
191 a good idea for new custom conditions.
192
193 Condition classes may define a remove_warning method containing a string
194 warning message to enable a confirmation dialog triggered when the condition
195 is removed from an event.
196
197 =cut
198
199 #fallback
200 sub remove_warning { ''; }
201
202 =item order_sql
203
204 This is used internally by the I<balance_age> and I<cust_bill_age> conditions
205 to declare ordering; probably not of general use for new custom conditions.
206
207 =item order_sql_weight
208
209 In conjunction with order_sql, this defines which order the ordering fragments
210 supplied by different B<order_sql> should be used.
211
212 =cut
213
214 sub order_sql_weight { ''; }
215
216 =back
217
218 =head1 BASE METHODS
219
220 These methods are defined in the base class for use in condition classes.
221
222 =over 4 
223
224 =item cust_main CUST_OBJECT
225
226 Return the customer object (see L<FS::cust_main>) associated with the provided
227 object (the object itself if it is already a customer object).
228
229 =cut
230
231 sub cust_main {
232   my( $self, $cust_object ) = @_;
233
234   $cust_object->isa('FS::cust_main') ? $cust_object : $cust_object->cust_main;
235
236 }
237
238 =item option_label OPTIONNAME
239
240 Returns the label for the specified option name.
241
242 =cut
243
244 sub option_label {
245   my( $self, $optionname ) = @_;
246
247   my %option_fields = $self->option_fields;
248
249   ref( $option_fields{$optionname} )
250     ? $option_fields{$optionname}->{'label'}
251     : $option_fields{$optionname}
252   or $optionname;
253 }
254
255 =back
256
257 =item option_age_from OPTION FROM_TIMESTAMP
258
259 Retreives a condition option, parses it from a frequency (such as "1d", "1w" or
260 "12m"), and subtracts that interval from the supplied timestamp.  It is
261 primarily intended for use in B<condition>.
262
263 =cut
264
265 sub option_age_from {
266   my( $self, $option, $time ) = @_;
267   my $age = $self->option($option);
268   $age = '0m' unless length($age);
269
270   my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
271
272   if ( $age =~ /^(\d+)m$/i ) {
273     $mon -= $1;
274     until ( $mon >= 0 ) { $mon += 12; $year--; }
275   } elsif ( $age =~ /^(\d+)y$/i ) {
276     $year -= $1;
277   } elsif ( $age =~ /^(\d+)w$/i ) {
278     $mday -= $1 * 7;
279   } elsif ( $age =~ /^(\d+)d$/i ) {
280     $mday -= $1;
281   } elsif ( $age =~ /^(\d+)h$/i ) {
282     $hour -= $hour;
283   } else {
284     die "unparsable age: $age";
285   }
286
287   timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
288
289 }
290
291 =item condition_sql_option OPTION
292
293 This is a class method that returns an SQL fragment for retreiving a condition
294 option.  It is primarily intended for use in B<condition_sql>.
295
296 =cut
297
298 sub condition_sql_option {
299   my( $class, $option ) = @_;
300
301   ( my $condname = $class ) =~ s/^.*:://;
302
303   "( SELECT optionvalue FROM part_event_condition_option
304       WHERE part_event_condition_option.eventconditionnum =
305             cond_$condname.eventconditionnum
306         AND part_event_condition_option.optionname = '$option'
307    )";
308 }
309
310 #c.f. part_event_condition_option.pm / part_event_condition_option_option
311 #used for part_event/Condition/payby.pm
312 sub condition_sql_option_option {
313   my( $class, $option ) = @_;
314
315   ( my $condname = $class ) =~ s/^.*:://;
316
317   my $optionnum = 
318     "( SELECT optionnum FROM part_event_condition_option
319         WHERE part_event_condition_option.eventconditionnum =
320               cond_$condname.eventconditionnum
321           AND part_event_condition_option.optionname  = '$option'
322           AND part_event_condition_option.optionvalue = 'HASH'
323      )";
324
325   "( SELECT optionname FROM part_event_condition_option_option
326        WHERE optionnum = $optionnum
327    )";
328
329 }
330
331
332 =item condition_sql_option_age_from OPTION FROM_TIMESTAMP
333
334 This is a class method that returns an SQL fragment that will retreive a
335 condition option, parse it from a frequency (such as "1d", "1w" or "12m"),
336 and subtract that interval from the supplied timestamp.  It is primarily
337 intended for use in B<condition_sql>.
338
339 =cut
340
341 sub condition_sql_option_age_from {
342   my( $class, $option, $from ) = @_;
343
344   my $value = $class->condition_sql_option($option);
345
346 #  my $str2time = str2time_sql;
347
348   if ( driver_name =~ /^Pg/i ) {
349
350     #can we do better with Pg now that we have $from?  yes we can, bob
351     "( $from - EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval ) )";
352
353   } elsif ( driver_name =~ /^mysql/i ) {
354
355     #hmm... is there a way we can save $value?  we're just an expression, hmm
356     #we might be able to do something like "AS ${option}_value" except we get
357     #used in more complicated expressions and we need some sort of unique
358     #identifer passed down too... yow
359
360     "CASE WHEN $value IS NULL OR $value = ''
361        THEN $from
362      WHEN $value LIKE '%m'
363        THEN UNIX_TIMESTAMP(
364               FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'm', '' ) MONTH
365             )
366      WHEN $value LIKE '%y'
367        THEN UNIX_TIMESTAMP(
368               FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'y', '' ) YEAR
369             )
370      WHEN $value LIKE '%w'
371        THEN UNIX_TIMESTAMP(
372               FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'w', '' ) WEEK
373             )
374      WHEN $value LIKE '%d'
375        THEN UNIX_TIMESTAMP(
376               FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'd', '' ) DAY
377             )
378      WHEN $value LIKE '%h'
379        THEN UNIX_TIMESTAMP(
380               FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'h', '' ) HOUR
381             )
382      END
383     "
384   } else {
385
386     die "FATAL: don't know how to subtract frequencies from dates for ".
387         driver_name. " databases";
388
389   }
390
391 }
392
393 =item condition_sql_option_age OPTION
394
395 This is a class method that returns an SQL fragment for retreiving a condition
396 option, and additionaly parsing it from a frequency (such as "1d", "1w" or
397 "12m") into an approximate number of seconds.
398
399 Note that since months vary in length, the results of this method should B<not>
400 be used in computations (use condition_sql_option_age_from for that).  They are
401 useful for for ordering and comparison to other ages.
402
403 This method is primarily intended for use in B<order_sql>.
404
405 =cut
406
407 sub condition_sql_option_age {
408   my( $class, $option ) = @_;
409   $class->age2seconds_sql( $class->condition_sql_option($option) );
410 }
411
412 =item age2seconds_sql
413
414 Class method returns an SQL fragment for parsing an arbitrary frequeny (such
415 as "1d", "1w", "12m", "2y" or "12h") into an approximate number of seconds.
416
417 Approximate meaning: months are considered to be 30 days, years to be
418 365.25 days.  Otherwise the numbers of seconds returned is exact.
419
420 =cut
421
422 sub age2seconds_sql {
423   my( $class, $value ) = @_;
424
425   if ( driver_name =~ /^Pg/i ) {
426
427     "EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval )";
428
429   } elsif ( driver_name =~ /^mysql/i ) {
430
431     #hmm... is there a way we can save $value?  we're just an expression, hmm
432     #we might be able to do something like "AS ${option}_age" except we get
433     #used in more complicated expressions and we need some sort of unique
434     #identifer passed down too... yow
435     # 2592000  = 30d "1 month"
436     # 31557600 = 365.25d "1 year"
437
438     "CASE WHEN $value IS NULL OR $value = ''
439        THEN 0
440      WHEN $value LIKE '%m'
441        THEN REPLACE( $value, 'm', '' ) * 2592000 
442      WHEN $value LIKE '%y'
443        THEN REPLACE( $value, 'y', '' ) * 31557600
444      WHEN $value LIKE '%w'
445        THEN REPLACE( $value, 'w', '' ) * 604800
446      WHEN $value LIKE '%d'
447        THEN REPLACE( $value, 'd', '' ) * 86400
448      WHEN $value LIKE '%h'
449        THEN REPLACE( $value, 'h', '' ) * 3600
450      END
451     "
452   } else {
453
454     die "FATAL: don't know how to approximate frequencies for ". driver_name.
455         " databases";
456
457   }
458
459 }
460
461 =item condition_sql_option_integer OPTION [ DRIVER_NAME ]
462
463 As I<condition_sql_option>, but cast the option value to an integer so that
464 comparison to other integers is type-correct.
465
466 =cut
467
468 sub condition_sql_option_integer {
469   my ($class, $option, $driver_name) = @_;
470
471   my $integer = ($driver_name =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER';
472
473   'CAST(
474          COALESCE('. $class->condition_sql_option($option).
475                 " ,'0') ".
476        " AS $integer )";
477 }
478
479 =head1 NEW CONDITION CLASSES
480
481 A module should be added in FS/FS/part_event/Condition/ which implements the
482 methods desribed above in L</METHODS>.  An example may be found in the
483 eg/part_event-Condition-template.pm file.
484
485 =cut
486
487 1;
488
489