FS/FS/cgp_rule.pm

   1 package FS::cgp_rule;
   2
   3 use strict;
   4 use base qw( FS::o2m_Common FS::Record );
   5 use FS::Record qw( qsearch qsearchs dbh );
   6 use FS::cust_svc;
   7 use FS::cgp_rule_condition;
   8 use FS::cgp_rule_action;
   9
  10 =head1 NAME
  11
  12 FS::cgp_rule - Object methods for cgp_rule records
  13
  14 =head1 SYNOPSIS
  15
  16   use FS::cgp_rule;
  17
  18   $record = new FS::cgp_rule \%hash;
  19   $record = new FS::cgp_rule { 'column' => 'value' };
  20
  21   $error = $record->insert;
  22
  23   $error = $new_record->replace($old_record);
  24
  25   $error = $record->delete;
  26
  27   $error = $record->check;
  28
  29 =head1 DESCRIPTION
  30
  31 An FS::cgp_rule object represents a mail filtering rule.  FS::cgp_rule
  32 inherits from FS::Record.  The following fields are currently supported:
  33
  34 =over 4
  35
  36 =item rulenum
  37
  38 primary key
  39
  40 =item name
  41
  42 name
  43
  44 =item comment
  45
  46 comment
  47
  48 =item svcnum
  49
  50 svcnum
  51
  52 =item priority
  53
  54 priority
  55
  56
  57 =back
  58
  59 =head1 METHODS
  60
  61 =over 4
  62
  63 =item new HASHREF
  64
  65 Creates a new rule.  To add the rule to the database, see L<"insert">.
  66
  67 Note that this stores the hash reference, not a distinct copy of the hash it
  68 points to.  You can ask the object for a copy with the I<hash> method.
  69
  70 =cut
  71
  72 # the new method can be inherited from FS::Record, if a table method is defined
  73
  74 sub table { 'cgp_rule'; }
  75
  76 =item insert
  77
  78 Adds this record to the database.  If there is an error, returns the error,
  79 otherwise returns false.
  80
  81 =cut
  82
  83 sub insert {
  84   my $self = shift;
  85
  86   local $SIG{HUP} = 'IGNORE';
  87   local $SIG{INT} = 'IGNORE';
  88   local $SIG{QUIT} = 'IGNORE';
  89   local $SIG{TERM} = 'IGNORE';
  90   local $SIG{TSTP} = 'IGNORE';
  91   local $SIG{PIPE} = 'IGNORE';
  92
  93   my $oldAutoCommit = $FS::UID::AutoCommit;
  94   local $FS::UID::AutoCommit = 0;
  95   my $dbh = dbh;
  96
  97   my $error = $self->SUPER::insert(@_);
  98   if ( $error ) {
  99     $dbh->rollback if $oldAutoCommit;
 100     return $error;
 101   }
 102
 103   #conditions and actions not in yet
 104   #$error = $self->svc_export;
 105   #if ( $error ) {
 106   #  $dbh->rollback if $oldAutoCommit;
 107   #  return $error;
 108   #}
 109
 110   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 111   '';
 112 }
 113
 114 =item delete
 115
 116 Delete this record from the database.
 117
 118 =cut
 119
 120 sub delete {
 121   my $self = shift;
 122
 123   local $SIG{HUP} = 'IGNORE';
 124   local $SIG{INT} = 'IGNORE';
 125   local $SIG{QUIT} = 'IGNORE';
 126   local $SIG{TERM} = 'IGNORE';
 127   local $SIG{TSTP} = 'IGNORE';
 128   local $SIG{PIPE} = 'IGNORE';
 129
 130   my $oldAutoCommit = $FS::UID::AutoCommit;
 131   local $FS::UID::AutoCommit = 0;
 132   my $dbh = dbh;
 133
 134   my @del = $self->cgp_rule_condition;
 135   push @del, $self->cgp_rule_action;
 136
 137   foreach my $del (@del) {
 138     my $error = $del->delete;
 139     if ( $error ) {
 140       $dbh->rollback if $oldAutoCommit;
 141       return $error;
 142     }
 143   }
 144
 145   my $error = $self->SUPER::delete(@_);
 146   if ( $error ) {
 147     $dbh->rollback if $oldAutoCommit;
 148     return $error;
 149   }
 150
 151   $error = $self->svc_export;
 152   if ( $error ) {
 153     $dbh->rollback if $oldAutoCommit;
 154     return $error;
 155   }
 156
 157   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 158   '';
 159 }
 160
 161 =item replace OLD_RECORD
 162
 163 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 164 returns the error, otherwise returns false.
 165
 166 =cut
 167
 168 sub replace {
 169   my $new = shift;
 170
 171   my $old = ( ref($_[0]) eq ref($new) )
 172               ? shift
 173               : $new->replace_old;
 174
 175   local $SIG{HUP} = 'IGNORE';
 176   local $SIG{INT} = 'IGNORE';
 177   local $SIG{QUIT} = 'IGNORE';
 178   local $SIG{TERM} = 'IGNORE';
 179   local $SIG{TSTP} = 'IGNORE';
 180   local $SIG{PIPE} = 'IGNORE';
 181
 182   my $oldAutoCommit = $FS::UID::AutoCommit;
 183   local $FS::UID::AutoCommit = 0;
 184   my $dbh = dbh;
 185
 186   my $error = $new->SUPER::replace($old, @_);
 187   if ( $error ) {
 188     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 189     return $error;
 190   }
 191
 192   #conditions and actions not in yet
 193   #$error = $new->svc_export;
 194   #if ( $error ) {
 195   #  $dbh->rollback if $oldAutoCommit;
 196   #  return $error;
 197   #}
 198
 199   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 200   '';
 201
 202 }
 203
 204 =item svc_export
 205
 206 Calls the replace export for any communigate exports attached to this rule's
 207 service.
 208
 209 =cut
 210
 211 sub svc_export {
 212   my $self = shift;
 213
 214   my $cust_svc = $self->cust_svc;
 215   my $svc_x = $cust_svc->svc_x;
 216
 217   #_singledomain too
 218   my @exports = $cust_svc->part_svc->part_export('communigate_pro');
 219   my @errors = map $_->export_replace($svc_x, $svc_x), @exports;
 220
 221   @errors ? join(' / ', @errors) : '';
 222
 223 }
 224
 225 =item check
 226
 227 Checks all fields to make sure this is a valid rule.  If there is
 228 an error, returns the error, otherwise returns false.  Called by the insert
 229 and replace methods.
 230
 231 =cut
 232
 233 # the check method should currently be supplied - FS::Record contains some
 234 # data checking routines
 235
 236 sub check {
 237   my $self = shift;
 238
 239   my $error =
 240     $self->ut_numbern('rulenum')
 241     || $self->ut_text('name')
 242     || $self->ut_textn('comment')
 243     || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum')
 244     || $self->ut_number('priority')
 245   ;
 246   return $error if $error;
 247
 248   $self->SUPER::check;
 249 }
 250
 251 =item clone NEW_SVCNUM
 252
 253 Clones this rule into an identical rule for the specified new service.
 254
 255 If there is an error, returns the error, otherwise returns false.
 256
 257 =cut
 258
 259 #should return the newly inserted rule instead? used in misc/clone-cgp_rule.html
 260
 261 #i should probably be transactionalized so i'm all-or-nothing
 262 sub clone {
 263   my( $self, $svcnum ) = @_;
 264
 265   my $new = $self->new( { $self->hash } );
 266   $new->rulenum('');
 267   $new->svcnum( $svcnum );
 268   my $error = $new->insert;
 269   return $error if $error;
 270
 271   my @dup = $self->cgp_rule_condition;
 272   push @dup, $self->cgp_rule_action;
 273
 274   foreach my $dup (@dup) {
 275     my $new_dup = $dup->new( { $dup->hash } );
 276     my $pk = $new_dup->primary_key;
 277     $new_dup->$pk('');
 278     $new_dup->rulenum( $new->rulenum );
 279
 280     $error = $new_dup->insert;
 281     return $error if $error;
 282
 283   }
 284
 285   $error = $new->svc_export;
 286   return $error if $error;
 287
 288   '';
 289
 290 }
 291
 292 =item cust_svc
 293
 294 =cut
 295
 296 sub cust_svc {
 297   my $self = shift;
 298   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 299 }
 300
 301 =item cgp_rule_condition
 302
 303 Returns the conditions associated with this rule, as FS::cgp_rule_condition
 304 objects.
 305
 306 =cut
 307
 308 sub cgp_rule_condition {
 309   my $self = shift;
 310   qsearch('cgp_rule_condition', { 'rulenum' => $self->rulenum } );
 311 }
 312
 313 =item cgp_rule_action
 314
 315 Returns the actions associated with this rule, as FS::cgp_rule_action
 316 objects.
 317
 318 =cut
 319
 320 sub cgp_rule_action {
 321   my $self = shift;
 322   qsearch('cgp_rule_action', { 'rulenum' => $self->rulenum } );
 323 }
 324
 325 =item arrayref
 326
 327 Returns an arraref representing this rule, suitable for Communigate Pro API
 328 commands:
 329
 330 The first element specifies the rule priority.
 331
 332 The second element specifies the rule name.
 333
 334 The third element specifies the rule conditions.
 335
 336 The fourth element specifies the rule actions.
 337
 338 The fifth element specifies the rule comment.
 339
 340 =cut
 341
 342 sub arrayref {
 343   my $self = shift;
 344   [ $self->priority,
 345     $self->name,
 346     [ map $_->arrayref, $self->cgp_rule_condition ],
 347     [ map $_->arrayref, $self->cgp_rule_action ],
 348     $self->comment,
 349   ],
 350 }
 351
 352 =back
 353
 354 =head1 BUGS
 355
 356 =head1 SEE ALSO
 357
 358 L<FS::Record>, schema.html from the base documentation.
 359
 360 =cut
 361
 362 1;
 363