1 package FS::part_event::Condition;
4 use base qw( FS::part_event_condition );
5 use Time::Local qw(timelocal_nocheck);
6 use FS::UID qw( driver_name );
10 FS::part_event::Condition - Base class for event conditions
14 package FS::part_event::Condition::mycondition;
16 use base FS::part_event::Condition;
20 FS::part_event::Condition is a base class for event conditions classes.
24 These methods are implemented in each condition class.
30 Condition classes must define a description method. This method should return
31 a scalar description of the condition.
33 =item eventtable_hashref
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):
39 sub eventtable_hashref {
43 'cust_pay_batch' => 0,
44 'cust_statement' => 0,
51 sub eventtable_hashref {
55 'cust_pay_batch' => 1,
56 'cust_statement' => 1,
62 Condition classes may define an option_fields method to indicate that they
63 accept one or more options.
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:
71 =item label - Description
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.
75 =item options - For checkbox-multiple and select, a list reference of available option values.
77 =item option_labels - For checkbox-multiple (and select?), a hash reference of availble option values and labels.
79 =item value - for checkbox, fixed, hidden (also a default for text, money, more?)
81 =item table - for select-table
83 =item name_col - for select-table
85 =item NOTE: See httemplate/elements/select-table.html for a full list of the optinal options for the select-table type
89 NOTE: A database connection is B<not> yet available when this subroutine is
96 'field' => 'description',
98 'another_field' => { 'label'=>'Amount', 'type'=>'money', },
100 'third_field' => { 'label' => 'Types',
101 'type' => 'checkbox-multiple',
102 'options' => [ 'h', 's' ],
103 'option_labels' => { 'h' => 'Happy',
116 =item condition CUSTOMER_EVENT_OBJECT
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.
123 To retreive option values, call the option method on the desired option, i.e.:
125 my( $self, $cust_object, %opts ) = @_;
126 $value_of_field = $self->option('field');
128 Available additional arguments:
130 $time = $opt{'time'}; #use this instead of time or $^T
132 $cust_event = $opt{'cust_event'}; #to retreive the cust_event object being tested
134 Return a true value if the condition has been met, and a false value if it has
137 =item condition_sql EVENTTABLE
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.
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 must be returned and tested with the B<condition> method.
154 my( $class, $eventtable ) = @_;
161 Condition classes may optionally define a disabled method. Returning a true
162 value disbles the condition entirely.
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.
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
185 sub implicit_flag { 0; }
189 Again, used internally by the I<once> and I<balance> conditions; probably not
190 a good idea for new custom conditions.
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.
199 sub remove_warning { ''; }
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.
206 =item order_sql_weight
208 In conjunction with order_sql, this defines which order the ordering fragments
209 supplied by different B<order_sql> should be used.
213 sub order_sql_weight { ''; }
219 These methods are defined in the base class for use in condition classes.
223 =item cust_main CUST_OBJECT
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).
231 my( $self, $cust_object ) = @_;
233 $cust_object->isa('FS::cust_main') ? $cust_object : $cust_object->cust_main;
237 =item option_label OPTIONNAME
239 Returns the label for the specified option name.
244 my( $self, $optionname ) = @_;
246 my %option_fields = $self->option_fields;
248 ref( $option_fields{$optionname} )
249 ? $option_fields{$optionname}->{'label'}
250 : $option_fields{$optionname}
256 =item option_type OPTION
258 Returns the type of the option, as a string: 'text', 'money', 'date',
264 my( $self, $optionname ) = @_;
266 my %option_fields = $self->option_fields;
268 ref( $option_fields{$optionname} )
269 ? $option_fields{$optionname}->{'type'}
273 =item option_age_from OPTION FROM_TIMESTAMP
275 Retreives a condition option, parses it from a frequency (such as "1d", "1w" or
276 "12m"), and subtracts that interval from the supplied timestamp. It is
277 primarily intended for use in B<condition>.
281 sub option_age_from {
282 my( $self, $option, $time ) = @_;
283 my $age = $self->option($option);
284 $age = '0m' unless length($age);
286 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
288 if ( $age =~ /^(\d+)m$/i ) {
290 until ( $mon >= 0 ) { $mon += 12; $year--; }
291 } elsif ( $age =~ /^(\d+)y$/i ) {
293 } elsif ( $age =~ /^(\d+)w$/i ) {
295 } elsif ( $age =~ /^(\d+)d$/i ) {
297 } elsif ( $age =~ /^(\d+)h$/i ) {
300 die "unparsable age: $age";
303 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
307 =item condition_sql_option OPTION
309 This is a class method that returns an SQL fragment for retreiving a condition
310 option. It is primarily intended for use in B<condition_sql>.
314 sub condition_sql_option {
315 my( $class, $option ) = @_;
317 ( my $condname = $class ) =~ s/^.*:://;
319 "( SELECT optionvalue FROM part_event_condition_option
320 WHERE part_event_condition_option.eventconditionnum =
321 cond_$condname.eventconditionnum
322 AND part_event_condition_option.optionname = '$option'
326 #c.f. part_event_condition_option.pm / part_event_condition_option_option
327 #used for part_event/Condition/payby.pm
328 sub condition_sql_option_option {
329 my( $class, $option ) = @_;
331 ( my $condname = $class ) =~ s/^.*:://;
334 "( SELECT optionnum FROM part_event_condition_option
335 WHERE part_event_condition_option.eventconditionnum =
336 cond_$condname.eventconditionnum
337 AND part_event_condition_option.optionname = '$option'
338 AND part_event_condition_option.optionvalue = 'HASH'
341 "( SELECT optionname FROM part_event_condition_option_option
342 WHERE optionnum IN $optionnum
347 #used for part_event/Condition/cust_bill_has_service.pm and has_cust_tag.pm
348 #a little false laziness w/above and condition_sql_option_integer
349 sub condition_sql_option_option_integer {
350 my( $class, $option ) = @_;
352 ( my $condname = $class ) =~ s/^.*:://;
355 "( SELECT optionnum FROM part_event_condition_option
356 WHERE part_event_condition_option.eventconditionnum =
357 cond_$condname.eventconditionnum
358 AND part_event_condition_option.optionname = '$option'
359 AND part_event_condition_option.optionvalue = 'HASH'
362 my $integer = (driver_name =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER';
364 my $optionname = "CAST(optionname AS $integer)";
366 "( SELECT $optionname FROM part_event_condition_option_option
367 WHERE optionnum IN $optionnum
372 =item condition_sql_option_age_from OPTION FROM_TIMESTAMP
374 This is a class method that returns an SQL fragment that will retreive a
375 condition option, parse it from a frequency (such as "1d", "1w" or "12m"),
376 and subtract that interval from the supplied timestamp. It is primarily
377 intended for use in B<condition_sql>.
381 sub condition_sql_option_age_from {
382 my( $class, $option, $from ) = @_;
384 my $value = $class->condition_sql_option($option);
386 # my $str2time = str2time_sql;
388 if ( driver_name =~ /^Pg/i ) {
390 #can we do better with Pg now that we have $from? yes we can, bob
391 "( $from - EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval ) )";
393 } elsif ( driver_name =~ /^mysql/i ) {
395 #hmm... is there a way we can save $value? we're just an expression, hmm
396 #we might be able to do something like "AS ${option}_value" except we get
397 #used in more complicated expressions and we need some sort of unique
398 #identifer passed down too... yow
400 "CASE WHEN $value IS NULL OR $value = ''
402 WHEN $value LIKE '%m'
404 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'm', '' ) MONTH
406 WHEN $value LIKE '%y'
408 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'y', '' ) YEAR
410 WHEN $value LIKE '%w'
412 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'w', '' ) WEEK
414 WHEN $value LIKE '%d'
416 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'd', '' ) DAY
418 WHEN $value LIKE '%h'
420 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'h', '' ) HOUR
426 die "FATAL: don't know how to subtract frequencies from dates for ".
427 driver_name. " databases";
433 =item condition_sql_option_age OPTION
435 This is a class method that returns an SQL fragment for retreiving a condition
436 option, and additionaly parsing it from a frequency (such as "1d", "1w" or
437 "12m") into an approximate number of seconds.
439 Note that since months vary in length, the results of this method should B<not>
440 be used in computations (use condition_sql_option_age_from for that). They are
441 useful for for ordering and comparison to other ages.
443 This method is primarily intended for use in B<order_sql>.
447 sub condition_sql_option_age {
448 my( $class, $option ) = @_;
449 $class->age2seconds_sql( $class->condition_sql_option($option) );
452 =item age2seconds_sql
454 Class method returns an SQL fragment for parsing an arbitrary frequeny (such
455 as "1d", "1w", "12m", "2y" or "12h") into an approximate number of seconds.
457 Approximate meaning: months are considered to be 30 days, years to be
458 365.25 days. Otherwise the numbers of seconds returned is exact.
462 sub age2seconds_sql {
463 my( $class, $value ) = @_;
465 if ( driver_name =~ /^Pg/i ) {
467 "EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval )";
469 } elsif ( driver_name =~ /^mysql/i ) {
471 #hmm... is there a way we can save $value? we're just an expression, hmm
472 #we might be able to do something like "AS ${option}_age" except we get
473 #used in more complicated expressions and we need some sort of unique
474 #identifer passed down too... yow
475 # 2592000 = 30d "1 month"
476 # 31557600 = 365.25d "1 year"
478 "CASE WHEN $value IS NULL OR $value = ''
480 WHEN $value LIKE '%m'
481 THEN REPLACE( $value, 'm', '' ) * 2592000
482 WHEN $value LIKE '%y'
483 THEN REPLACE( $value, 'y', '' ) * 31557600
484 WHEN $value LIKE '%w'
485 THEN REPLACE( $value, 'w', '' ) * 604800
486 WHEN $value LIKE '%d'
487 THEN REPLACE( $value, 'd', '' ) * 86400
488 WHEN $value LIKE '%h'
489 THEN REPLACE( $value, 'h', '' ) * 3600
494 die "FATAL: don't know how to approximate frequencies for ". driver_name.
501 =item condition_sql_option_integer OPTION [ DRIVER_NAME ]
503 As I<condition_sql_option>, but cast the option value to an integer so that
504 comparison to other integers is type-correct.
508 sub condition_sql_option_integer {
509 my ($class, $option, $driver_name) = @_;
511 my $integer = (driver_name() =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER';
514 COALESCE('. $class->condition_sql_option($option).
519 =head1 NEW CONDITION CLASSES
521 A module should be added in FS/FS/part_event/Condition/ which implements the
522 methods desribed above in L</METHODS>. An example may be found in the
523 eg/part_event-Condition-template.pm file.