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 {
56 'cust_pay_batch' => 1,
57 'cust_statement' => 1,
64 Condition classes may define an option_fields method to indicate that they
65 accept one or more options.
67 This method should return a list of option names and option descriptions.
68 Each option description can be a scalar description, for simple options, or a
69 hashref with the following values:
73 =item label - Description
75 =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.
77 =item options - For checkbox-multiple and select, a list reference of available option values.
79 =item option_labels - For checkbox-multiple (and select?), a hash reference of availble option values and labels.
81 =item value - for checkbox, fixed, hidden (also a default for text, money, more?)
83 =item table - for select-table
85 =item name_col - for select-table
87 =item NOTE: See httemplate/elements/select-table.html for a full list of the optinal options for the select-table type
91 NOTE: A database connection is B<not> yet available when this subroutine is
98 'field' => 'description',
100 'another_field' => { 'label'=>'Amount', 'type'=>'money', },
102 'third_field' => { 'label' => 'Types',
103 'type' => 'checkbox-multiple',
104 'options' => [ 'h', 's' ],
105 'option_labels' => { 'h' => 'Happy',
118 =item condition CUSTOMER_EVENT_OBJECT
120 Condition classes must define a condition method. This method is evaluated
121 to determine if the condition has been met. The object which triggered the
122 event (an FS::cust_main, FS::cust_bill or FS::cust_pkg object) is passed as
123 the first argument. Additional arguments are list of key-value pairs.
125 To retreive option values, call the option method on the desired option, i.e.:
127 my( $self, $cust_object, %opts ) = @_;
128 $value_of_field = $self->option('field');
130 Available additional arguments:
132 $time = $opt{'time'}; #use this instead of time or $^T
134 $cust_event = $opt{'cust_event'}; #to retreive the cust_event object being tested
136 Return a true value if the condition has been met, and a false value if it has
139 =item condition_sql EVENTTABLE
141 Condition classes may optionally define a condition_sql method. This B<class>
142 method should return an SQL fragment that tests for this condition. The
143 fragment is evaluated and a true value of this expression indicates that the
144 condition has been met. The event table (cust_main, cust_bill or cust_pkg) is
145 passed as an argument.
147 This method is used for optimizing event queries. You may want to add indices
148 for any columns referenced. It is acceptable to return an SQL fragment which
149 partially tests the condition; doing so will still reduce the number of
150 records which must be returned and tested with the B<condition> method.
156 my( $class, $eventtable ) = @_;
163 Condition classes may optionally define a disabled method. Returning a true
164 value disbles the condition entirely.
174 This is used internally by the I<once> and I<balance> conditions. You probably
175 do B<not> want to define this method for new custom conditions, unless you're
176 sure you want B<every> new action to start with your condition.
178 Condition classes may define an implicit_flag method that returns true to
179 indicate that all new events should start with this condition. (Currently,
180 condition classes which do so should be applicable to all kinds of
181 I<eventtable>s.) The numeric value of the flag also defines the ordering of
187 sub implicit_flag { 0; }
191 Again, used internally by the I<once> and I<balance> conditions; probably not
192 a good idea for new custom conditions.
194 Condition classes may define a remove_warning method containing a string
195 warning message to enable a confirmation dialog triggered when the condition
196 is removed from an event.
201 sub remove_warning { ''; }
205 This is used internally by the I<balance_age> and I<cust_bill_age> conditions
206 to declare ordering; probably not of general use for new custom conditions.
208 =item order_sql_weight
210 In conjunction with order_sql, this defines which order the ordering fragments
211 supplied by different B<order_sql> should be used.
215 sub order_sql_weight { ''; }
221 These methods are defined in the base class for use in condition classes.
225 =item cust_main CUST_OBJECT
227 Return the customer object (see L<FS::cust_main>) associated with the provided
228 object (the object itself if it is already a customer object).
233 my( $self, $cust_object ) = @_;
235 $cust_object->isa('FS::cust_main') ? $cust_object : $cust_object->cust_main;
239 =item cust_pkg OBJECT
241 Return the package object (L<FS::cust_pkg>) associated with the provided
242 object. The object must be either a service (L<FS::svc_Common>) or a
248 my( $self, $object ) = @_;
249 $object->isa('FS::cust_pkg') ? $object :
250 $object->isa('FS::svc_Common') ? $object->cust_svc->cust_pkg :
254 =item option_label OPTIONNAME
256 Returns the label for the specified option name.
261 my( $self, $optionname ) = @_;
263 my %option_fields = $self->option_fields;
265 ref( $option_fields{$optionname} )
266 ? $option_fields{$optionname}->{'label'}
267 : $option_fields{$optionname}
273 =item option_type OPTION
275 Returns the type of the option, as a string: 'text', 'money', 'date',
281 my( $self, $optionname ) = @_;
283 my %option_fields = $self->option_fields;
285 ref( $option_fields{$optionname} )
286 ? $option_fields{$optionname}->{'type'}
290 =item option_age_from OPTION FROM_TIMESTAMP
292 Retreives a condition option, parses it from a frequency (such as "1d", "1w" or
293 "12m"), and subtracts that interval from the supplied timestamp. It is
294 primarily intended for use in B<condition>.
298 sub option_age_from {
299 my( $self, $option, $time ) = @_;
300 my $age = $self->option($option);
301 $age = '0m' unless length($age);
303 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
305 if ( $age =~ /^(\d+)m$/i ) {
307 until ( $mon >= 0 ) { $mon += 12; $year--; }
308 } elsif ( $age =~ /^(\d+)y$/i ) {
310 } elsif ( $age =~ /^(\d+)w$/i ) {
312 } elsif ( $age =~ /^(\d+)d$/i ) {
314 } elsif ( $age =~ /^(\d+)h$/i ) {
317 die "unparsable age: $age";
320 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
324 =item condition_sql_option OPTION
326 This is a class method that returns an SQL fragment for retreiving a condition
327 option. It is primarily intended for use in B<condition_sql>.
331 sub condition_sql_option {
332 my( $class, $option ) = @_;
334 ( my $condname = $class ) =~ s/^.*:://;
336 "( SELECT optionvalue FROM part_event_condition_option
337 WHERE part_event_condition_option.eventconditionnum =
338 cond_$condname.eventconditionnum
339 AND part_event_condition_option.optionname = '$option'
343 #c.f. part_event_condition_option.pm / part_event_condition_option_option
344 #used for part_event/Condition/payby.pm
345 sub condition_sql_option_option {
346 my( $class, $option ) = @_;
348 ( my $condname = $class ) =~ s/^.*:://;
351 "( SELECT optionnum FROM part_event_condition_option
352 WHERE part_event_condition_option.eventconditionnum =
353 cond_$condname.eventconditionnum
354 AND part_event_condition_option.optionname = '$option'
355 AND part_event_condition_option.optionvalue = 'HASH'
358 "( SELECT optionname FROM part_event_condition_option_option
359 WHERE optionnum IN $optionnum
364 #used for part_event/Condition/cust_bill_has_service.pm and has_cust_tag.pm
365 #a little false laziness w/above and condition_sql_option_integer
366 sub condition_sql_option_option_integer {
367 my( $class, $option ) = @_;
369 ( my $condname = $class ) =~ s/^.*:://;
372 "( SELECT optionnum FROM part_event_condition_option
373 WHERE part_event_condition_option.eventconditionnum =
374 cond_$condname.eventconditionnum
375 AND part_event_condition_option.optionname = '$option'
376 AND part_event_condition_option.optionvalue = 'HASH'
379 my $integer = (driver_name =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER';
381 my $optionname = "CAST(optionname AS $integer)";
383 "( SELECT $optionname FROM part_event_condition_option_option
384 WHERE optionnum IN $optionnum
389 =item condition_sql_option_age_from OPTION FROM_TIMESTAMP
391 This is a class method that returns an SQL fragment that will retreive a
392 condition option, parse it from a frequency (such as "1d", "1w" or "12m"),
393 and subtract that interval from the supplied timestamp. It is primarily
394 intended for use in B<condition_sql>.
398 sub condition_sql_option_age_from {
399 my( $class, $option, $from ) = @_;
401 my $value = $class->condition_sql_option($option);
403 # my $str2time = str2time_sql;
405 if ( driver_name =~ /^Pg/i ) {
407 #can we do better with Pg now that we have $from? yes we can, bob
408 "( $from - EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval ) )";
410 } elsif ( driver_name =~ /^mysql/i ) {
412 #hmm... is there a way we can save $value? we're just an expression, hmm
413 #we might be able to do something like "AS ${option}_value" except we get
414 #used in more complicated expressions and we need some sort of unique
415 #identifer passed down too... yow
417 "CASE WHEN $value IS NULL OR $value = ''
419 WHEN $value LIKE '%m'
421 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'm', '' ) MONTH
423 WHEN $value LIKE '%y'
425 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'y', '' ) YEAR
427 WHEN $value LIKE '%w'
429 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'w', '' ) WEEK
431 WHEN $value LIKE '%d'
433 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'd', '' ) DAY
435 WHEN $value LIKE '%h'
437 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'h', '' ) HOUR
443 die "FATAL: don't know how to subtract frequencies from dates for ".
444 driver_name. " databases";
450 =item condition_sql_option_age OPTION
452 This is a class method that returns an SQL fragment for retreiving a condition
453 option, and additionaly parsing it from a frequency (such as "1d", "1w" or
454 "12m") into an approximate number of seconds.
456 Note that since months vary in length, the results of this method should B<not>
457 be used in computations (use condition_sql_option_age_from for that). They are
458 useful for for ordering and comparison to other ages.
460 This method is primarily intended for use in B<order_sql>.
464 sub condition_sql_option_age {
465 my( $class, $option ) = @_;
466 $class->age2seconds_sql( $class->condition_sql_option($option) );
469 =item age2seconds_sql
471 Class method returns an SQL fragment for parsing an arbitrary frequeny (such
472 as "1d", "1w", "12m", "2y" or "12h") into an approximate number of seconds.
474 Approximate meaning: months are considered to be 30 days, years to be
475 365.25 days. Otherwise the numbers of seconds returned is exact.
479 sub age2seconds_sql {
480 my( $class, $value ) = @_;
482 if ( driver_name =~ /^Pg/i ) {
484 "EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval )";
486 } elsif ( driver_name =~ /^mysql/i ) {
488 #hmm... is there a way we can save $value? we're just an expression, hmm
489 #we might be able to do something like "AS ${option}_age" except we get
490 #used in more complicated expressions and we need some sort of unique
491 #identifer passed down too... yow
492 # 2592000 = 30d "1 month"
493 # 31557600 = 365.25d "1 year"
495 "CASE WHEN $value IS NULL OR $value = ''
497 WHEN $value LIKE '%m'
498 THEN REPLACE( $value, 'm', '' ) * 2592000
499 WHEN $value LIKE '%y'
500 THEN REPLACE( $value, 'y', '' ) * 31557600
501 WHEN $value LIKE '%w'
502 THEN REPLACE( $value, 'w', '' ) * 604800
503 WHEN $value LIKE '%d'
504 THEN REPLACE( $value, 'd', '' ) * 86400
505 WHEN $value LIKE '%h'
506 THEN REPLACE( $value, 'h', '' ) * 3600
511 die "FATAL: don't know how to approximate frequencies for ". driver_name.
518 =item condition_sql_option_integer OPTION [ DRIVER_NAME ]
520 As I<condition_sql_option>, but cast the option value to an integer so that
521 comparison to other integers is type-correct.
525 sub condition_sql_option_integer {
526 my ($class, $option, $driver_name) = @_;
528 my $integer = (driver_name() =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER';
531 COALESCE('. $class->condition_sql_option($option).
536 =head1 NEW CONDITION CLASSES
538 A module should be added in FS/FS/part_event/Condition/ which implements the
539 methods desribed above in L</METHODS>. An example may be found in the
540 eg/part_event-Condition-template.pm file.