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