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,
63 Condition classes may define an option_fields method to indicate that they
64 accept one or more options.
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:
72 =item label - Description
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.
76 =item options - For checkbox-multiple and select, a list reference of available option values.
78 =item option_labels - For checkbox-multiple (and select?), a hash reference of availble option values and labels.
80 =item value - for checkbox, fixed, hidden (also a default for text, money, more?)
82 =item table - for select-table
84 =item name_col - for select-table
86 =item NOTE: See httemplate/elements/select-table.html for a full list of the optinal options for the select-table type
90 NOTE: A database connection is B<not> yet available when this subroutine is
97 'field' => 'description',
99 'another_field' => { 'label'=>'Amount', 'type'=>'money', },
101 'third_field' => { 'label' => 'Types',
102 'type' => 'checkbox-multiple',
103 'options' => [ 'h', 's' ],
104 'option_labels' => { 'h' => 'Happy',
117 =item condition CUSTOMER_EVENT_OBJECT
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.
124 To retreive option values, call the option method on the desired option, i.e.:
126 my( $self, $cust_object, %opts ) = @_;
127 $value_of_field = $self->option('field');
129 Available additional arguments:
131 $time = $opt{'time'}; #use this instead of time or $^T
133 $cust_event = $opt{'cust_event'}; #to retreive the cust_event object being tested
135 Return a true value if the condition has been met, and a false value if it has
138 =item condition_sql EVENTTABLE
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.
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.
155 my( $class, $eventtable ) = @_;
162 Condition classes may optionally define a disabled method. Returning a true
163 value disbles the condition entirely.
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.
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
186 sub implicit_flag { 0; }
190 Again, used internally by the I<once> and I<balance> conditions; probably not
191 a good idea for new custom conditions.
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.
200 sub remove_warning { ''; }
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.
207 =item order_sql_weight
209 In conjunction with order_sql, this defines which order the ordering fragments
210 supplied by different B<order_sql> should be used.
214 sub order_sql_weight { ''; }
220 These methods are defined in the base class for use in condition classes.
224 =item cust_main CUST_OBJECT
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).
232 my( $self, $cust_object ) = @_;
234 $cust_object->isa('FS::cust_main') ? $cust_object : $cust_object->cust_main;
238 =item cust_pkg OBJECT
240 Return the package object (L<FS::cust_pkg>) associated with the provided
241 object. The object must be either a service (L<FS::svc_Common>) or a
247 my( $self, $object ) = @_;
248 $object->isa('FS::cust_pkg') ? $object :
249 $object->isa('FS::svc_Common') ? $object->cust_svc->cust_pkg :
253 =item option_label OPTIONNAME
255 Returns the label for the specified option name.
260 my( $self, $optionname ) = @_;
262 my %option_fields = $self->option_fields;
264 ref( $option_fields{$optionname} )
265 ? $option_fields{$optionname}->{'label'}
266 : $option_fields{$optionname}
272 =item option_type OPTION
274 Returns the type of the option, as a string: 'text', 'money', 'date',
280 my( $self, $optionname ) = @_;
282 my %option_fields = $self->option_fields;
284 ref( $option_fields{$optionname} )
285 ? $option_fields{$optionname}->{'type'}
289 =item option_age_from OPTION FROM_TIMESTAMP
291 Retreives a condition option, parses it from a frequency (such as "1d", "1w" or
292 "12m"), and subtracts that interval from the supplied timestamp. It is
293 primarily intended for use in B<condition>.
297 sub option_age_from {
298 my( $self, $option, $time ) = @_;
299 my $age = $self->option($option);
300 $age = '0m' unless length($age);
302 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($time) )[0,1,2,3,4,5];
304 if ( $age =~ /^(\d+)m$/i ) {
306 until ( $mon >= 0 ) { $mon += 12; $year--; }
307 } elsif ( $age =~ /^(\d+)y$/i ) {
309 } elsif ( $age =~ /^(\d+)w$/i ) {
311 } elsif ( $age =~ /^(\d+)d$/i ) {
313 } elsif ( $age =~ /^(\d+)h$/i ) {
316 die "unparsable age: $age";
319 timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year);
323 =item condition_sql_option OPTION
325 This is a class method that returns an SQL fragment for retreiving a condition
326 option. It is primarily intended for use in B<condition_sql>.
330 sub condition_sql_option {
331 my( $class, $option ) = @_;
333 ( my $condname = $class ) =~ s/^.*:://;
335 "( SELECT optionvalue FROM part_event_condition_option
336 WHERE part_event_condition_option.eventconditionnum =
337 cond_$condname.eventconditionnum
338 AND part_event_condition_option.optionname = '$option'
342 #c.f. part_event_condition_option.pm / part_event_condition_option_option
343 #used for part_event/Condition/payby.pm
344 sub condition_sql_option_option {
345 my( $class, $option ) = @_;
347 ( my $condname = $class ) =~ s/^.*:://;
350 "( SELECT optionnum FROM part_event_condition_option
351 WHERE part_event_condition_option.eventconditionnum =
352 cond_$condname.eventconditionnum
353 AND part_event_condition_option.optionname = '$option'
354 AND part_event_condition_option.optionvalue = 'HASH'
357 "( SELECT optionname FROM part_event_condition_option_option
358 WHERE optionnum IN $optionnum
363 #used for part_event/Condition/cust_bill_has_service.pm and has_cust_tag.pm
364 #a little false laziness w/above and condition_sql_option_integer
365 sub condition_sql_option_option_integer {
366 my( $class, $option ) = @_;
368 ( my $condname = $class ) =~ s/^.*:://;
371 "( SELECT optionnum FROM part_event_condition_option
372 WHERE part_event_condition_option.eventconditionnum =
373 cond_$condname.eventconditionnum
374 AND part_event_condition_option.optionname = '$option'
375 AND part_event_condition_option.optionvalue = 'HASH'
378 my $integer = (driver_name =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER';
380 my $optionname = "CAST(optionname AS $integer)";
382 "( SELECT $optionname FROM part_event_condition_option_option
383 WHERE optionnum IN $optionnum
388 =item condition_sql_option_age_from OPTION FROM_TIMESTAMP
390 This is a class method that returns an SQL fragment that will retreive a
391 condition option, parse it from a frequency (such as "1d", "1w" or "12m"),
392 and subtract that interval from the supplied timestamp. It is primarily
393 intended for use in B<condition_sql>.
397 sub condition_sql_option_age_from {
398 my( $class, $option, $from ) = @_;
400 my $value = $class->condition_sql_option($option);
402 # my $str2time = str2time_sql;
404 if ( driver_name =~ /^Pg/i ) {
406 #can we do better with Pg now that we have $from? yes we can, bob
407 "( $from - EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval ) )";
409 } elsif ( driver_name =~ /^mysql/i ) {
411 #hmm... is there a way we can save $value? we're just an expression, hmm
412 #we might be able to do something like "AS ${option}_value" except we get
413 #used in more complicated expressions and we need some sort of unique
414 #identifer passed down too... yow
416 "CASE WHEN $value IS NULL OR $value = ''
418 WHEN $value LIKE '%m'
420 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'm', '' ) MONTH
422 WHEN $value LIKE '%y'
424 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'y', '' ) YEAR
426 WHEN $value LIKE '%w'
428 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'w', '' ) WEEK
430 WHEN $value LIKE '%d'
432 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'd', '' ) DAY
434 WHEN $value LIKE '%h'
436 FROM_UNIXTIME($from) - INTERVAL REPLACE( $value, 'h', '' ) HOUR
442 die "FATAL: don't know how to subtract frequencies from dates for ".
443 driver_name. " databases";
449 =item condition_sql_option_age OPTION
451 This is a class method that returns an SQL fragment for retreiving a condition
452 option, and additionaly parsing it from a frequency (such as "1d", "1w" or
453 "12m") into an approximate number of seconds.
455 Note that since months vary in length, the results of this method should B<not>
456 be used in computations (use condition_sql_option_age_from for that). They are
457 useful for for ordering and comparison to other ages.
459 This method is primarily intended for use in B<order_sql>.
463 sub condition_sql_option_age {
464 my( $class, $option ) = @_;
465 $class->age2seconds_sql( $class->condition_sql_option($option) );
468 =item age2seconds_sql
470 Class method returns an SQL fragment for parsing an arbitrary frequeny (such
471 as "1d", "1w", "12m", "2y" or "12h") into an approximate number of seconds.
473 Approximate meaning: months are considered to be 30 days, years to be
474 365.25 days. Otherwise the numbers of seconds returned is exact.
478 sub age2seconds_sql {
479 my( $class, $value ) = @_;
481 if ( driver_name =~ /^Pg/i ) {
483 "EXTRACT( EPOCH FROM REPLACE( $value, 'm', 'mon')::interval )";
485 } elsif ( driver_name =~ /^mysql/i ) {
487 #hmm... is there a way we can save $value? we're just an expression, hmm
488 #we might be able to do something like "AS ${option}_age" except we get
489 #used in more complicated expressions and we need some sort of unique
490 #identifer passed down too... yow
491 # 2592000 = 30d "1 month"
492 # 31557600 = 365.25d "1 year"
494 "CASE WHEN $value IS NULL OR $value = ''
496 WHEN $value LIKE '%m'
497 THEN REPLACE( $value, 'm', '' ) * 2592000
498 WHEN $value LIKE '%y'
499 THEN REPLACE( $value, 'y', '' ) * 31557600
500 WHEN $value LIKE '%w'
501 THEN REPLACE( $value, 'w', '' ) * 604800
502 WHEN $value LIKE '%d'
503 THEN REPLACE( $value, 'd', '' ) * 86400
504 WHEN $value LIKE '%h'
505 THEN REPLACE( $value, 'h', '' ) * 3600
510 die "FATAL: don't know how to approximate frequencies for ". driver_name.
517 =item condition_sql_option_integer OPTION [ DRIVER_NAME ]
519 As I<condition_sql_option>, but cast the option value to an integer so that
520 comparison to other integers is type-correct.
524 sub condition_sql_option_integer {
525 my ($class, $option, $driver_name) = @_;
527 my $integer = (driver_name() =~ /^mysql/) ? 'UNSIGNED INTEGER' : 'INTEGER';
530 COALESCE('. $class->condition_sql_option($option).
535 =head1 NEW CONDITION CLASSES
537 A module should be added in FS/FS/part_event/Condition/ which implements the
538 methods desribed above in L</METHODS>. An example may be found in the
539 eg/part_event-Condition-template.pm file.