FS/FS/part_event_condition.pm

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