FS/FS/part_event_condition.pm

   1 package FS::part_event_condition;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use FS::UID qw(dbh);
   6 use FS::Record qw( qsearch qsearchs );
   7 use FS::option_Common;
   8 use FS::part_event; #for order_conditions_sql...
   9
  10 @ISA = qw( FS::option_Common ); # FS::Record );
  11 $DEBUG = 0;
  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     eval "use $fullmod;";
 187     if ( $@ ) {
 188       die "error using $fullmod (skipping): $@\n" if $@;
 189       #warn "error using $fullmod (skipping): $@\n" if $@;
 190       #next;
 191     }
 192     #my $full_condition_sql = $fullmod. '::condition_sql';
 193     my $condition_sql_coderef = sub { $fullmod->condition_sql(@_) };
 194     my $order_sql_coderef = $fullmod->can('order_sql')
 195                               ? sub { $fullmod->order_sql(@_) }
 196                               : '';
 197     $conditions{$mod} = {
 198       ( map { $_ => $fullmod->$_() }
 199             qw( description eventtable_hashref
 200                 implicit_flag remove_warning
 201                 order_sql_weight
 202               )
 203             # deprecated
 204             #option_fields_hashref
 205       ),
 206       'option_fields' => [ $fullmod->option_fields() ],
 207       'condition_sql' => $condition_sql_coderef,
 208       'order_sql'     => $order_sql_coderef,
 209     };
 210   }
 211 }
 212
 213 sub conditions {
 214   my( $class, $eventtable ) = @_;
 215   (
 216     map  { $_ => $conditions{$_} }
 217 #    sort { $conditions{$a}->{'default_weight'}<=>$conditions{$b}->{'default_weight'} }
 218 #    sort by ?
 219     $class->all_conditionnames( $eventtable )
 220   );
 221
 222 }
 223
 224 =item all_conditionnames [ EVENTTABLE ]
 225
 226 Returns a list of just the condition names
 227
 228 =cut
 229
 230 sub all_conditionnames {
 231   my ( $class, $eventtable ) = @_;
 232
 233   grep { !$eventtable || $conditions{$_}->{'eventtable_hashref'}{$eventtable} }
 234        keys %conditions
 235 }
 236
 237 =item join_conditions_sql [ EVENTTABLE ]
 238
 239 Returns an SQL fragment selecting joining all condition options for an event as
 240 tables titled "cond_I<conditionname>".  Typically used in conjunction with
 241 B<where_conditions_sql>.
 242
 243 =cut
 244
 245 sub join_conditions_sql {
 246   my ( $class, $eventtable ) = @_;
 247   my %conditions = $class->conditions( $eventtable );
 248
 249   join(' ',
 250     map {
 251           "LEFT JOIN part_event_condition AS cond_$_".
 252           "  ON ( part_event.eventpart = cond_$_.eventpart".
 253           "       AND cond_$_.conditionname = ". dbh->quote($_).
 254           "     )";
 255         }
 256         keys %conditions
 257   );
 258
 259 }
 260
 261 =item where_conditions_sql [ EVENTTABLE [ , OPTION => VALUE, ... ] ]
 262
 263 Returns an SQL fragment to select events which have unsatisfied conditions.
 264 Must be used in conjunction with B<join_conditions_sql>.
 265
 266 The only current option is "time", the current time (or "pretend" current time
 267 as passed to freeside-daily), as a UNIX timestamp.
 268
 269 =cut
 270
 271 sub where_conditions_sql {
 272   my ( $class, $eventtable, %options ) = @_;
 273
 274   my $time = $options{'time'};
 275
 276   my %conditions = $class->conditions( $eventtable );
 277
 278   my $where = join(' AND ',
 279     map {
 280           my $conditionname = $_;
 281           my $coderef = $conditions{$conditionname}->{condition_sql};
 282           my $sql = &$coderef( $eventtable, 'time'=>$time );
 283           die "$coderef is not a CODEREF" unless ref($coderef) eq 'CODE';
 284           "( cond_$conditionname.conditionname IS NULL OR $sql )";
 285         }
 286         keys %conditions
 287   );
 288
 289   $where;
 290 }
 291
 292 =item order_conditions_sql [ EVENTTABLE ]
 293
 294 Returns an SQL fragment to order selected events.  Must be used in conjunction
 295 with B<join_conditions_sql>.
 296
 297 =cut
 298
 299 sub order_conditions_sql {
 300   my( $class, $eventtable ) = @_;
 301
 302   my %conditions = $class->conditions( $eventtable );
 303
 304   my $eventtables = join(' ', FS::part_event->eventtables_runorder);
 305
 306   my $order_by = join(', ',
 307     "position( part_event.eventtable in ' $eventtables ')",
 308     ( map  {
 309              my $conditionname = $_;
 310              my $coderef = $conditions{$conditionname}->{order_sql};
 311              my $sql = &$coderef( $eventtable );
 312              "CASE WHEN cond_$conditionname.conditionname IS NULL
 313                  THEN -1
 314                  ELSE $sql
 315               END
 316              ";
 317            }
 318       sort {     $conditions{$a}->{order_sql_weight}
 319              <=> $conditions{$b}->{order_sql_weight}
 320            }
 321       grep { $conditions{$_}->{order_sql} }
 322            keys %conditions
 323     ),
 324     'part_event.weight'
 325   );
 326
 327   "ORDER BY $order_by";
 328
 329 }
 330
 331 =back
 332
 333 =head1 BUGS
 334
 335 =head1 SEE ALSO
 336
 337 L<FS::part_event::Condition>, L<FS::part_event>, L<FS::Record>, schema.html from
 338 the base documentation.
 339
 340 =cut
 341
 342 1;
 343