diff options
Diffstat (limited to 'FS/FS/part_event_condition.pm')
-rw-r--r-- | FS/FS/part_event_condition.pm | 343 |
1 files changed, 343 insertions, 0 deletions
diff --git a/FS/FS/part_event_condition.pm b/FS/FS/part_event_condition.pm new file mode 100644 index 0000000..1efd0f8 --- /dev/null +++ b/FS/FS/part_event_condition.pm @@ -0,0 +1,343 @@ +package FS::part_event_condition; + +use strict; +use vars qw( @ISA $DEBUG ); +use FS::UID qw(dbh); +use FS::Record qw( qsearch qsearchs ); +use FS::option_Common; +use FS::part_event; #for order_conditions_sql... + +@ISA = qw( FS::option_Common ); # FS::Record ); +$DEBUG = 0; + +=head1 NAME + +FS::part_event_condition - Object methods for part_event_condition records + +=head1 SYNOPSIS + + use FS::part_event_condition; + + $record = new FS::part_event_condition \%hash; + $record = new FS::part_event_condition { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::part_event_condition object represents an event condition. +FS::part_event_condition inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item eventconditionnum - primary key + +=item eventpart - Event definition (see L<FS::part_event>) + +=item conditionname - Condition name - defines which FS::part_event::Condition::I<conditionname> evaluates this condition + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new event. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'part_event_condition'; } + +=item insert [ HASHREF | OPTION => VALUE ... ] + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +If a list or hash reference of options is supplied, part_event_condition_option +records are created (see L<FS::part_event_condition_option>). + +=cut + +# the insert method can be inherited from FS::Record + +=item delete + +Delete this record from the database. + +=cut + +# the delete method can be inherited from FS::Record + +=item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ] + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +If a list or hash reference of options is supplied, part_event_condition_option +records are created or modified (see L<FS::part_event_condition_option>). + +=cut + +# the replace method can be inherited from FS::Record + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('eventconditionnum') + || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart') + || $self->ut_alpha('conditionname') + ; + return $error if $error; + + #XXX check conditionname to make sure a module exists? + # well it'll die in _rebless... + + $self->SUPER::check; +} + + +=item _rebless + +Reblesses the object into the FS::part_event::Condition::CONDITIONNAME class, +where CONDITIONNAME is the object's I<conditionname> field. + +=cut + +sub _rebless { + my $self = shift; + my $conditionname = $self->conditionname; + #my $class = ref($self). "::$conditionname"; + my $class = "FS::part_event::Condition::$conditionname"; + eval "use $class"; + die $@ if $@; + bless($self, $class); #unless $@; + $self; +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item conditions [ EVENTTABLE ] + +Return information about the available conditions. If an eventtable is +specified, only return information about conditions available for that +eventtable. + +Information is returned as key-value pairs. Keys are condition names. Values +are hashrefs with the following keys: + +=over 4 + +=item description + +=item option_fields + +# =item default_weight + +# =item deprecated + +=back + +See L<FS::part_event::Condition> for more information. + +=cut + +#false laziness w/part_event.pm +#some false laziness w/part_export & part_pkg +my %conditions; +foreach my $INC ( @INC ) { + foreach my $file ( glob("$INC/FS/part_event/Condition/*.pm") ) { + warn "attempting to load Condition from $file\n" if $DEBUG; + $file =~ /\/(\w+)\.pm$/ or do { + warn "unrecognized file in $INC/FS/part_event/Condition/: $file\n"; + next; + }; + my $mod = $1; + my $fullmod = "FS::part_event::Condition::$mod"; + eval "use $fullmod;"; + if ( $@ ) { + die "error using $fullmod (skipping): $@\n" if $@; + #warn "error using $fullmod (skipping): $@\n" if $@; + #next; + } + #my $full_condition_sql = $fullmod. '::condition_sql'; + my $condition_sql_coderef = sub { $fullmod->condition_sql(@_) }; + my $order_sql_coderef = $fullmod->can('order_sql') + ? sub { $fullmod->order_sql(@_) } + : ''; + $conditions{$mod} = { + ( map { $_ => $fullmod->$_() } + qw( description eventtable_hashref + implicit_flag remove_warning + order_sql_weight + ) + # deprecated + #option_fields_hashref + ), + 'option_fields' => [ $fullmod->option_fields() ], + 'condition_sql' => $condition_sql_coderef, + 'order_sql' => $order_sql_coderef, + }; + } +} + +sub conditions { + my( $class, $eventtable ) = @_; + ( + map { $_ => $conditions{$_} } +# sort { $conditions{$a}->{'default_weight'}<=>$conditions{$b}->{'default_weight'} } +# sort by ? + $class->all_conditionnames( $eventtable ) + ); + +} + +=item all_conditionnames [ EVENTTABLE ] + +Returns a list of just the condition names + +=cut + +sub all_conditionnames { + my ( $class, $eventtable ) = @_; + + grep { !$eventtable || $conditions{$_}->{'eventtable_hashref'}{$eventtable} } + keys %conditions +} + +=item join_conditions_sql [ EVENTTABLE ] + +Returns an SQL fragment selecting joining all condition options for an event as +tables titled "cond_I<conditionname>". Typically used in conjunction with +B<where_conditions_sql>. + +=cut + +sub join_conditions_sql { + my ( $class, $eventtable ) = @_; + my %conditions = $class->conditions( $eventtable ); + + join(' ', + map { + "LEFT JOIN part_event_condition AS cond_$_". + " ON ( part_event.eventpart = cond_$_.eventpart". + " AND cond_$_.conditionname = ". dbh->quote($_). + " )"; + } + keys %conditions + ); + +} + +=item where_conditions_sql [ EVENTTABLE [ , OPTION => VALUE, ... ] ] + +Returns an SQL fragment to select events which have unsatisfied conditions. +Must be used in conjunction with B<join_conditions_sql>. + +The only current option is "time", the current time (or "pretend" current time +as passed to freeside-daily), as a UNIX timestamp. + +=cut + +sub where_conditions_sql { + my ( $class, $eventtable, %options ) = @_; + + my $time = $options{'time'}; + + my %conditions = $class->conditions( $eventtable ); + + my $where = join(' AND ', + map { + my $conditionname = $_; + my $coderef = $conditions{$conditionname}->{condition_sql}; + my $sql = &$coderef( $eventtable, 'time'=>$time ); + die "$coderef is not a CODEREF" unless ref($coderef) eq 'CODE'; + "( cond_$conditionname.conditionname IS NULL OR $sql )"; + } + keys %conditions + ); + + $where; +} + +=item order_conditions_sql [ EVENTTABLE ] + +Returns an SQL fragment to order selected events. Must be used in conjunction +with B<join_conditions_sql>. + +=cut + +sub order_conditions_sql { + my( $class, $eventtable ) = @_; + + my %conditions = $class->conditions( $eventtable ); + + my $eventtables = join(' ', FS::part_event->eventtables_runorder); + + my $order_by = join(', ', + "position( part_event.eventtable in ' $eventtables ')", + ( map { + my $conditionname = $_; + my $coderef = $conditions{$conditionname}->{order_sql}; + my $sql = &$coderef( $eventtable ); + "CASE WHEN cond_$conditionname.conditionname IS NULL + THEN -1 + ELSE $sql + END + "; + } + sort { $conditions{$a}->{order_sql_weight} + <=> $conditions{$b}->{order_sql_weight} + } + grep { $conditions{$_}->{order_sql} } + keys %conditions + ), + 'part_event.weight' + ); + + "ORDER BY $order_by"; + +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::part_event::Condition>, L<FS::part_event>, L<FS::Record>, schema.html from +the base documentation. + +=cut + +1; + |