FS/FS/part_event_condition.pm

   1 package FS::part_event_condition;
   2 use base qw( FS::option_Common );
   3
   4 use strict;
   5 use vars qw( $DEBUG @SKIP_CONDITION_SQL );
   6 use FS::UID qw( dbh driver_name );
   7 use FS::part_event; #for order_conditions_sql...
   8
   9 $DEBUG = 0;
  10
  11 @SKIP_CONDITION_SQL = ();
  12
  13 =head1 NAME
  14
  15 FS::part_event_condition - Object methods for part_event_condition records
  16
  17 =head1 SYNOPSIS
  18
  19   use FS::part_event_condition;
  20
  21   $record = new FS::part_event_condition \%hash;
  22   $record = new FS::part_event_condition { 'column' => 'value' };
  23
  24   $error = $record->insert;
  25
  26   $error = $new_record->replace($old_record);
  27
  28   $error = $record->delete;
  29
  30   $error = $record->check;
  31
  32 =head1 DESCRIPTION
  33
  34 An FS::part_event_condition object represents an event condition.
  35 FS::part_event_condition inherits from FS::Record.  The following fields are
  36 currently supported:
  37
  38 =over 4
  39
  40 =item eventconditionnum - primary key
  41
  42 =item eventpart - Event definition (see L<FS::part_event>)
  43
  44 =item conditionname - Condition name - defines which FS::part_event::Condition::I<conditionname> evaluates this condition
  45
  46 =back
  47
  48 =head1 METHODS
  49
  50 =over 4
  51
  52 =item new HASHREF
  53
  54 Creates a new event.  To add the example to the database, see L<"insert">.
  55
  56 Note that this stores the hash reference, not a distinct copy of the hash it
  57 points to.  You can ask the object for a copy with the I<hash> method.
  58
  59 =cut
  60
  61 # the new method can be inherited from FS::Record, if a table method is defined
  62
  63 sub table { 'part_event_condition'; }
  64
  65 =item insert [ HASHREF | OPTION => VALUE ... ]
  66
  67 Adds this record to the database.  If there is an error, returns the error,
  68 otherwise returns false.
  69
  70 If a list or hash reference of options is supplied, part_event_condition_option
  71 records are created (see L<FS::part_event_condition_option>).
  72
  73 =cut
  74
  75 # the insert method can be inherited from FS::Record
  76
  77 =item delete
  78
  79 Delete this record from the database.
  80
  81 =cut
  82
  83 # the delete method can be inherited from FS::Record
  84
  85 =item replace OLD_RECORD [ HASHREF | OPTION => VALUE ... ]
  86
  87 Replaces the OLD_RECORD with this one in the database.  If there is an error,
  88 returns the error, otherwise returns false.
  89
  90 If a list or hash reference of options is supplied, part_event_condition_option
  91 records are created or modified (see L<FS::part_event_condition_option>).
  92
  93 =cut
  94
  95 # the replace method can be inherited from FS::Record
  96
  97 =item check
  98
  99 Checks all fields to make sure this is a valid example.  If there is
 100 an error, returns the error, otherwise returns false.  Called by the insert
 101 and replace methods.
 102
 103 =cut
 104
 105 # the check method should currently be supplied - FS::Record contains some
 106 # data checking routines
 107
 108 sub check {
 109   my $self = shift;
 110
 111   my $error =
 112     $self->ut_numbern('eventconditionnum')
 113     || $self->ut_foreign_key('eventpart', 'part_event', 'eventpart')
 114     || $self->ut_alpha('conditionname')
 115   ;
 116   return $error if $error;
 117
 118   #XXX check conditionname to make sure a module exists?
 119   # well it'll die in _rebless...
 120
 121   $self->SUPER::check;
 122 }
 123
 124
 125 =item _rebless
 126
 127 Reblesses the object into the FS::part_event::Condition::CONDITIONNAME class,
 128 where CONDITIONNAME is the object's I<conditionname> field.
 129
 130 =cut
 131
 132 sub _rebless {
 133   my $self = shift;
 134   my $conditionname = $self->conditionname;
 135   #my $class = ref($self). "::$conditionname";
 136   my $class = "FS::part_event::Condition::$conditionname";
 137   eval "use $class";
 138   die $@ if $@;
 139   bless($self, $class); #unless $@;
 140   $self;
 141 }
 142
 143 =back
 144
 145 =head1 CLASS METHODS
 146
 147 =over 4
 148
 149 =item conditions [ EVENTTABLE ]
 150
 151 Return information about the available conditions.  If an eventtable is
 152 specified, only return information about conditions available for that
 153 eventtable.
 154
 155 Information is returned as key-value pairs.  Keys are condition names.  Values
 156 are hashrefs with the following keys:
 157
 158 =over 4
 159
 160 =item description
 161
 162 =item option_fields
 163
 164 # =item default_weight
 165
 166 # =item deprecated
 167
 168 =back
 169
 170 See L<FS::part_event::Condition> for more information.
 171
 172 =cut
 173
 174 #false laziness w/part_event.pm
 175 #some false laziness w/part_export & part_pkg
 176 my %conditions;
 177 foreach my $INC ( @INC ) {
 178   foreach my $file ( glob("$INC/FS/part_event/Condition/*.pm") ) {
 179     warn "attempting to load Condition from $file\n" if $DEBUG;
 180     $file =~ /\/(\w+)\.pm$/ or do {
 181       warn "unrecognized file in $INC/FS/part_event/Condition/: $file\n";
 182       next;
 183     };
 184     my $mod = $1;
 185     my $fullmod = "FS::part_event::Condition::$mod";
 186     if ( $fullmod =~ /_(Mixin|Common)$/ ) {
 187       #warn "skipping $1 class $fullmod\n";
 188       next;
 189     }
 190     eval "use $fullmod;";
 191     if ( $@ ) {
 192       die "error using $fullmod (skipping): $@\n" if $@;
 193       #warn "error using $fullmod (skipping): $@\n" if $@;
 194       #next;
 195     }
 196     if ( $fullmod->disabled ) {
 197       warn "$fullmod is disabled; skipping\n";
 198       next;
 199     }
 200     #my $full_condition_sql = $fullmod. '::condition_sql';
 201     my $condition_sql_coderef = sub { $fullmod->condition_sql(@_) };
 202     my $order_sql_coderef = $fullmod->can('order_sql')
 203                               ? sub { $fullmod->order_sql(@_) }
 204                               : '';
 205     $conditions{$mod} = {
 206       ( map { $_ => $fullmod->$_() }
 207             qw( description eventtable_hashref
 208                 implicit_flag remove_warning
 209                 order_sql_weight
 210               )
 211             # deprecated
 212             #option_fields_hashref
 213       ),
 214       'option_fields' => [ $fullmod->option_fields() ],
 215       'condition_sql' => $condition_sql_coderef,
 216       'order_sql'     => $order_sql_coderef,
 217     };
 218   }
 219 }
 220
 221 sub conditions {
 222   my( $class, $eventtable ) = @_;
 223   (
 224     map  { $_ => $conditions{$_} }
 225     sort {$conditions{$a}->{'description'} cmp $conditions{$b}->{'description'}}
 226     $class->all_conditionnames( $eventtable )
 227   );
 228
 229 }
 230
 231 =item all_conditionnames [ EVENTTABLE ]
 232
 233 Returns a list of just the condition names
 234
 235 =cut
 236
 237 sub all_conditionnames {
 238   my ( $class, $eventtable ) = @_;
 239
 240   grep { !$eventtable || $conditions{$_}->{'eventtable_hashref'}{$eventtable} }
 241        keys %conditions
 242 }
 243
 244 =item join_conditions_sql [ EVENTTABLE [, OPTIONS ] ]
 245
 246 Returns an SQL fragment selecting joining all condition options for an event as
 247 tables titled "cond_I<conditionname>".  Typically used in conjunction with
 248 B<where_conditions_sql>.  OPTIONS should include 'time', the time to use
 249 in testing event conditions.
 250
 251 =cut
 252
 253 sub join_conditions_sql {
 254   my ( $class, $eventtable, %options ) = @_;
 255
 256   join(' ',
 257     map {
 258           "LEFT JOIN part_event_condition AS cond_$_".
 259           "  ON ( part_event.eventpart = cond_$_.eventpart".
 260           "       AND cond_$_.conditionname = ". dbh->quote($_).
 261           "     )";
 262         }
 263       map $_->[0], $class->_where_conditions( $eventtable, %options )
 264
 265   );
 266
 267 }
 268
 269 =item where_conditions_sql [ EVENTTABLE [ , OPTION => VALUE, ... ] ]
 270
 271 Returns an SQL fragment to select events which have unsatisfied conditions.
 272 Must be used in conjunction with B<join_conditions_sql>.
 273
 274 The only current option is "time", the current time (or "pretend" current time
 275 as passed to freeside-daily), as a UNIX timestamp.
 276
 277 =cut
 278
 279 sub where_conditions_sql {
 280   my ( $class, $eventtable, %options ) = @_;
 281
 282   join(' AND ',
 283          map { my $conditionname = $_->[0];
 284                my $sql = $_->[1];
 285                "( cond_$conditionname.conditionname IS NULL OR $sql )";
 286              }
 287            $class->_where_conditions( $eventtable, %options )
 288       );
 289 }
 290
 291 sub _where_conditions {
 292   my ( $class, $eventtable, %options ) = @_;
 293
 294   my $time = $options{'time'};
 295
 296   my %conditions = $class->conditions( $eventtable );
 297
 298   grep { $_->[1] !~ /^\s*true\s*$/i
 299          || $conditions{ $_->[0] }->{order_sql}
 300        }
 301     map {
 302           my $conditionname = $_;
 303           my $coderef = $conditions{$conditionname}->{condition_sql};
 304           #die "$coderef is not a CODEREF" unless ref($coderef) eq 'CODE';
 305           my $sql = &$coderef( $eventtable, 'time'        => $time,
 306                                             'driver_name' => driver_name(),
 307                              );
 308           [ $_, $sql ];
 309         }
 310       grep { my $cond = $_;
 311              ! grep { $_ eq $cond } @SKIP_CONDITION_SQL
 312            }
 313         keys %conditions;
 314 }
 315
 316 =item order_conditions_sql [ EVENTTABLE ]
 317
 318 Returns an SQL fragment to order selected events.  Must be used in conjunction
 319 with B<join_conditions_sql>.
 320
 321 =cut
 322
 323 sub order_conditions_sql {
 324   my( $class, $eventtable ) = @_;
 325
 326   my %conditions = $class->conditions( $eventtable );
 327
 328   my $eventtables = join(' ', FS::part_event->eventtables_runorder);
 329
 330   my $order_by = join(', ',
 331     "position( part_event.eventtable in ' $eventtables ')",
 332     ( map  {
 333              my $conditionname = $_;
 334              my $coderef = $conditions{$conditionname}->{order_sql};
 335              my $sql = &$coderef( $eventtable );
 336              "CASE WHEN cond_$conditionname.conditionname IS NULL
 337                  THEN -1
 338                  ELSE $sql
 339               END
 340              ";
 341            }
 342       sort {     $conditions{$a}->{order_sql_weight}
 343              <=> $conditions{$b}->{order_sql_weight}
 344            }
 345       grep { $conditions{$_}->{order_sql} }
 346            keys %conditions
 347     ),
 348     'part_event.weight'
 349   );
 350
 351   "ORDER BY $order_by";
 352
 353 }
 354
 355 =back
 356
 357 =head1 BUGS
 358
 359 =head1 SEE ALSO
 360
 361 L<FS::part_event::Condition>, L<FS::part_event>, L<FS::Record>, schema.html from
 362 the base documentation.
 363
 364 =cut
 365
 366 1;
 367