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   $error = $self->svc_export;
 104   if ( $error ) {
 105     $dbh->rollback if $oldAutoCommit;
 106     return $error;
 107   }
 108
 109   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 110   '';
 111 }
 112
 113 =item delete
 114
 115 Delete this record from the database.
 116
 117 =cut
 118
 119 sub delete {
 120   my $self = shift;
 121
 122   local $SIG{HUP} = 'IGNORE';
 123   local $SIG{INT} = 'IGNORE';
 124   local $SIG{QUIT} = 'IGNORE';
 125   local $SIG{TERM} = 'IGNORE';
 126   local $SIG{TSTP} = 'IGNORE';
 127   local $SIG{PIPE} = 'IGNORE';
 128
 129   my $oldAutoCommit = $FS::UID::AutoCommit;
 130   local $FS::UID::AutoCommit = 0;
 131   my $dbh = dbh;
 132
 133   my @del = $self->cgp_rule_condition;
 134   push @del, $self->cgp_rule_action;
 135
 136   foreach my $del (@del) {
 137     my $error = $del->delete;
 138     if ( $error ) {
 139       $dbh->rollback if $oldAutoCommit;
 140       return $error;
 141     }
 142   }
 143
 144   my $error = $self->SUPER::delete(@_);
 145   if ( $error ) {
 146     $dbh->rollback if $oldAutoCommit;
 147     return $error;
 148   }
 149
 150   $error = $self->svc_export;
 151   if ( $error ) {
 152     $dbh->rollback if $oldAutoCommit;
 153     return $error;
 154   }
 155
 156   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 157   '';
 158 }
 159
 160 =item replace OLD_RECORD
 161
 162 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 163 returns the error, otherwise returns false.
 164
 165 =cut
 166
 167 sub replace {
 168   my $new = shift;
 169
 170   my $old = ( ref($_[0]) eq ref($new) )
 171               ? shift
 172               : $new->replace_old;
 173
 174   local $SIG{HUP} = 'IGNORE';
 175   local $SIG{INT} = 'IGNORE';
 176   local $SIG{QUIT} = 'IGNORE';
 177   local $SIG{TERM} = 'IGNORE';
 178   local $SIG{TSTP} = 'IGNORE';
 179   local $SIG{PIPE} = 'IGNORE';
 180
 181   my $oldAutoCommit = $FS::UID::AutoCommit;
 182   local $FS::UID::AutoCommit = 0;
 183   my $dbh = dbh;
 184
 185   my $error = $new->SUPER::replace($old, @_);
 186   if ( $error ) {
 187     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 188     return $error;
 189   }
 190
 191   $error = $new->svc_export;
 192   if ( $error ) {
 193     $dbh->rollback if $oldAutoCommit;
 194     return $error;
 195   }
 196
 197   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 198   '';
 199
 200 }
 201
 202 =item svc_export
 203
 204 Calls the replace export for any communigate exports attached to this rule's
 205 service.
 206
 207 =cut
 208
 209 sub svc_export {
 210   my $self = shift;
 211
 212   my $cust_svc = $self->cust_svc;
 213   my $svc_x = $cust_svc->svc_x;
 214
 215   #_singledomain too
 216   my @exports = $cust_svc->part_svc->part_export('communigate_pro');
 217   my @errors = map $_->export_replace($svc_x, $svc_x), @exports;
 218
 219   @errors ? join(' / ', @errors) : '';
 220
 221 }
 222
 223 =item check
 224
 225 Checks all fields to make sure this is a valid rule.  If there is
 226 an error, returns the error, otherwise returns false.  Called by the insert
 227 and replace methods.
 228
 229 =cut
 230
 231 # the check method should currently be supplied - FS::Record contains some
 232 # data checking routines
 233
 234 sub check {
 235   my $self = shift;
 236
 237   my $error =
 238     $self->ut_numbern('rulenum')
 239     || $self->ut_text('name')
 240     || $self->ut_textn('comment')
 241     || $self->ut_foreign_key('svcnum', 'cust_svc', 'svcnum')
 242     || $self->ut_number('priority')
 243   ;
 244   return $error if $error;
 245
 246   $self->SUPER::check;
 247 }
 248
 249 =item cust_svc
 250
 251 =cut
 252
 253 sub cust_svc {
 254   my $self = shift;
 255   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 256 }
 257
 258 =item cgp_rule_condition
 259
 260 Returns the conditions associated with this rule, as FS::cgp_rule_condition
 261 objects.
 262
 263 =cut
 264
 265 sub cgp_rule_condition {
 266   my $self = shift;
 267   qsearch('cgp_rule_condition', { 'rulenum' => $self->rulenum } );
 268 }
 269
 270 =item cgp_rule_action
 271
 272 Returns the actions associated with this rule, as FS::cgp_rule_action
 273 objects.
 274
 275 =cut
 276
 277 sub cgp_rule_action {
 278   my $self = shift;
 279   qsearch('cgp_rule_action', { 'rulenum' => $self->rulenum } );
 280 }
 281
 282 =item arrayref
 283
 284 Returns an arraref representing this rule, suitable for Communigate Pro API
 285 commands:
 286
 287 The first element specifies the rule priority.
 288
 289 The second element specifies the rule name.
 290
 291 The third element specifies the rule conditions.
 292
 293 The fourth element specifies the rule actions.
 294
 295 The fifth element specifies the rule comment.
 296
 297 =cut
 298
 299 sub arrayref {
 300   my $self = shift;
 301   [ $self->priority,
 302     $self->name,
 303     [ map $_->arrayref, $self->cgp_rule_condition ],
 304     [ map $_->arrayref, $self->cgp_rule_action ],
 305     $self->comment,
 306   ],
 307 }
 308
 309 =back
 310
 311 =head1 BUGS
 312
 313 =head1 SEE ALSO
 314
 315 L<FS::Record>, schema.html from the base documentation.
 316
 317 =cut
 318
 319 1;
 320