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