FS/FS/svc_Common.pm

   1 package FS::svc_Common;
   2
   3 use strict;
   4 use vars qw( @ISA $noexport_hack );
   5 use FS::Record qw( qsearch qsearchs fields dbh );
   6 use FS::cust_svc;
   7 use FS::part_svc;
   8 use FS::queue;
   9
  10 @ISA = qw( FS::Record );
  11
  12 =head1 NAME
  13
  14 FS::svc_Common - Object method for all svc_ records
  15
  16 =head1 SYNOPSIS
  17
  18 use FS::svc_Common;
  19
  20 @ISA = qw( FS::svc_Common );
  21
  22 =head1 DESCRIPTION
  23
  24 FS::svc_Common is intended as a base class for table-specific classes to
  25 inherit from, i.e. FS::svc_acct.  FS::svc_Common inherits from FS::Record.
  26
  27 =head1 METHODS
  28
  29 =over 4
  30
  31 =cut
  32
  33 sub virtual_fields {
  34
  35   # This restricts the fields based on part_svc_column and the svcpart of
  36   # the service.  There are four possible cases:
  37   # 1.  svcpart passed as part of the svc_x hash.
  38   # 2.  svcpart fetched via cust_svc based on svcnum.
  39   # 3.  No svcnum or svcpart.  In this case, return ALL the fields with
  40   #     dbtable eq $self->table.
  41   # 4.  Called via "fields('svc_acct')" or something similar.  In this case
  42   #     there is no $self object.
  43
  44   my $self = shift;
  45   my $svcpart;
  46   my @vfields = $self->SUPER::virtual_fields;
  47
  48   return @vfields unless (ref $self); # Case 4
  49
  50   if ($self->svcpart) { # Case 1
  51     $svcpart = $self->svcpart;
  52   } elsif ( $self->svcnum ) { #Case 2
  53     $svcpart = $self->cust_svc->svcpart;
  54   } else { # Case 3
  55     $svcpart = '';
  56   }
  57
  58   if ($svcpart) { #Cases 1 and 2
  59     my %flags = map { $_->columnname, $_->columnflag } (
  60         qsearch ('part_svc_column', { svcpart => $svcpart } )
  61       );
  62     return grep { not ($flags{$_} eq 'X') } @vfields;
  63   } else { # Case 3
  64     return @vfields;
  65   }
  66   return ();
  67 }
  68
  69 =item check
  70
  71 Checks the validity of fields in this record.
  72
  73 At present, this does nothing but call FS::Record::check (which, in turn,
  74 does nothing but run virtual field checks).
  75
  76 =cut
  77
  78 sub check {
  79   my $self = shift;
  80   $self->SUPER::check;
  81 }
  82
  83 =item insert [ JOBNUM_ARRAYREF [ OBJECTS_ARRAYREF ] ]
  84
  85 Adds this record to the database.  If there is an error, returns the error,
  86 otherwise returns false.
  87
  88 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  89 defined.  An FS::cust_svc record will be created and inserted.
  90
  91 If an arrayref is passed as parameter, the B<jobnum>s of any export jobs will
  92 be added to the array.
  93
  94 If an arrayref of FS::tablename objects (for example, FS::acct_snarf objects)
  95 is passed as the optional second parameter, they will have their svcnum fields
  96 set and will be inserted after this record, but before any exports are run.
  97
  98 =cut
  99
 100 sub insert {
 101   my $self = shift;
 102   local $FS::queue::jobnums = shift if @_;
 103   my $objects = scalar(@_) ? shift : [];
 104   my $error;
 105
 106   local $SIG{HUP} = 'IGNORE';
 107   local $SIG{INT} = 'IGNORE';
 108   local $SIG{QUIT} = 'IGNORE';
 109   local $SIG{TERM} = 'IGNORE';
 110   local $SIG{TSTP} = 'IGNORE';
 111   local $SIG{PIPE} = 'IGNORE';
 112
 113   my $oldAutoCommit = $FS::UID::AutoCommit;
 114   local $FS::UID::AutoCommit = 0;
 115   my $dbh = dbh;
 116
 117   $error = $self->check;
 118   return $error if $error;
 119
 120   my $svcnum = $self->svcnum;
 121   my $cust_svc;
 122   #unless ( $svcnum ) {
 123   if ( ! $svcnum || ! qsearchs('cust_svc',{'svcnum'=>$self->svcnum} ) ) {
 124     $cust_svc = new FS::cust_svc ( {
 125       #hua?# 'svcnum'  => $svcnum,
 126       'svcnum'  => $self->svcnum,
 127       'pkgnum'  => $self->pkgnum,
 128       'svcpart' => $self->svcpart,
 129     } );
 130     $error = $cust_svc->insert;
 131     if ( $error ) {
 132       $dbh->rollback if $oldAutoCommit;
 133       return $error;
 134     }
 135     $svcnum = $self->svcnum($cust_svc->svcnum);
 136   } else {
 137     $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 138     unless ( $cust_svc ) {
 139       $dbh->rollback if $oldAutoCommit;
 140       return "no cust_svc record found for svcnum ". $self->svcnum;
 141     }
 142     $self->pkgnum($cust_svc->pkgnum);
 143     $self->svcpart($cust_svc->svcpart);
 144   }
 145
 146   $error = $self->SUPER::insert;
 147   if ( $error ) {
 148     $dbh->rollback if $oldAutoCommit;
 149     return $error;
 150   }
 151
 152   foreach my $object ( @$objects ) {
 153     $object->svcnum($self->svcnum);
 154     $error = $object->insert;
 155     if ( $error ) {
 156       $dbh->rollback if $oldAutoCommit;
 157       return $error;
 158     }
 159   }
 160
 161   #new-style exports!
 162   unless ( $noexport_hack ) {
 163     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 164       my $error = $part_export->export_insert($self);
 165       if ( $error ) {
 166         $dbh->rollback if $oldAutoCommit;
 167         return "exporting to ". $part_export->exporttype.
 168                " (transaction rolled back): $error";
 169       }
 170     }
 171   }
 172
 173   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 174
 175   '';
 176 }
 177
 178 =item delete
 179
 180 Deletes this account from the database.  If there is an error, returns the
 181 error, otherwise returns false.
 182
 183 The corresponding FS::cust_svc record will be deleted as well.
 184
 185 =cut
 186
 187 sub delete {
 188   my $self = shift;
 189   my $error;
 190
 191   local $SIG{HUP} = 'IGNORE';
 192   local $SIG{INT} = 'IGNORE';
 193   local $SIG{QUIT} = 'IGNORE';
 194   local $SIG{TERM} = 'IGNORE';
 195   local $SIG{TSTP} = 'IGNORE';
 196   local $SIG{PIPE} = 'IGNORE';
 197
 198   my $svcnum = $self->svcnum;
 199
 200   my $oldAutoCommit = $FS::UID::AutoCommit;
 201   local $FS::UID::AutoCommit = 0;
 202   my $dbh = dbh;
 203
 204   $error = $self->SUPER::delete;
 205   return $error if $error;
 206
 207   #new-style exports!
 208   unless ( $noexport_hack ) {
 209     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 210       my $error = $part_export->export_delete($self);
 211       if ( $error ) {
 212         $dbh->rollback if $oldAutoCommit;
 213         return "exporting to ". $part_export->exporttype.
 214                " (transaction rolled back): $error";
 215       }
 216     }
 217   }
 218
 219   return $error if $error;
 220
 221   my $cust_svc = $self->cust_svc;
 222   $error = $cust_svc->delete;
 223   return $error if $error;
 224
 225   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 226
 227   '';
 228 }
 229
 230 =item replace OLD_RECORD
 231
 232 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 233 otherwise returns false.
 234
 235 =cut
 236
 237 sub replace {
 238   my ($new, $old) = (shift, shift);
 239
 240   local $SIG{HUP} = 'IGNORE';
 241   local $SIG{INT} = 'IGNORE';
 242   local $SIG{QUIT} = 'IGNORE';
 243   local $SIG{TERM} = 'IGNORE';
 244   local $SIG{TSTP} = 'IGNORE';
 245   local $SIG{PIPE} = 'IGNORE';
 246
 247   my $oldAutoCommit = $FS::UID::AutoCommit;
 248   local $FS::UID::AutoCommit = 0;
 249   my $dbh = dbh;
 250
 251   my $error = $new->SUPER::replace($old);
 252   if ($error) {
 253     $dbh->rollback if $oldAutoCommit;
 254     return $error;
 255   }
 256
 257   #new-style exports!
 258   unless ( $noexport_hack ) {
 259     foreach my $part_export ( $new->cust_svc->part_svc->part_export ) {
 260       my $error = $part_export->export_replace($new,$old);
 261       if ( $error ) {
 262         $dbh->rollback if $oldAutoCommit;
 263         return "error exporting to ". $part_export->exporttype.
 264                " (transaction rolled back): $error";
 265       }
 266     }
 267   }
 268
 269   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 270   '';
 271 }
 272
 273
 274 =item setfixed
 275
 276 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 277 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 278 to test the return).  Usually called by the check method.
 279
 280 =cut
 281
 282 sub setfixed {
 283   my $self = shift;
 284   $self->setx('F');
 285 }
 286
 287 =item setdefault
 288
 289 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 290 current values.  If there is an error, returns the error, otherwise returns
 291 the FS::part_svc object (use ref() to test the return).
 292
 293 =cut
 294
 295 sub setdefault {
 296   my $self = shift;
 297   $self->setx('D');
 298 }
 299
 300 sub setx {
 301   my $self = shift;
 302   my $x = shift;
 303
 304   my $error;
 305
 306   $error =
 307     $self->ut_numbern('svcnum')
 308   ;
 309   return $error if $error;
 310
 311   #get part_svc
 312   my $svcpart;
 313   if ( $self->svcnum ) {
 314     my $cust_svc = $self->cust_svc;
 315     return "Unknown svcnum" unless $cust_svc;
 316     $svcpart = $cust_svc->svcpart;
 317   } else {
 318     $svcpart = $self->getfield('svcpart');
 319   }
 320   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 321   return "Unkonwn svcpart" unless $part_svc;
 322
 323   #set default/fixed/whatever fields from part_svc
 324   my $table = $self->table;
 325   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 326     my $part_svc_column = $part_svc->part_svc_column($field);
 327     if ( $part_svc_column->columnflag eq $x ) {
 328       $self->setfield( $field, $part_svc_column->columnvalue );
 329     }
 330   }
 331
 332  $part_svc;
 333
 334 }
 335
 336 =item cust_svc
 337
 338 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 339 object (see L<FS::cust_svc>).
 340
 341 =cut
 342
 343 sub cust_svc {
 344   my $self = shift;
 345   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 346 }
 347
 348 =item suspend
 349
 350 Runs export_suspend callbacks.
 351
 352 =cut
 353
 354 sub suspend {
 355   my $self = shift;
 356
 357   local $SIG{HUP} = 'IGNORE';
 358   local $SIG{INT} = 'IGNORE';
 359   local $SIG{QUIT} = 'IGNORE';
 360   local $SIG{TERM} = 'IGNORE';
 361   local $SIG{TSTP} = 'IGNORE';
 362   local $SIG{PIPE} = 'IGNORE';
 363
 364   my $oldAutoCommit = $FS::UID::AutoCommit;
 365   local $FS::UID::AutoCommit = 0;
 366   my $dbh = dbh;
 367
 368   #new-style exports!
 369   unless ( $noexport_hack ) {
 370     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 371       my $error = $part_export->export_suspend($self);
 372       if ( $error ) {
 373         $dbh->rollback if $oldAutoCommit;
 374         return "error exporting to ". $part_export->exporttype.
 375                " (transaction rolled back): $error";
 376       }
 377     }
 378   }
 379
 380   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 381   '';
 382
 383 }
 384
 385 =item unsuspend
 386
 387 Runs export_unsuspend callbacks.
 388
 389 =cut
 390
 391 sub unsuspend {
 392   my $self = shift;
 393
 394   local $SIG{HUP} = 'IGNORE';
 395   local $SIG{INT} = 'IGNORE';
 396   local $SIG{QUIT} = 'IGNORE';
 397   local $SIG{TERM} = 'IGNORE';
 398   local $SIG{TSTP} = 'IGNORE';
 399   local $SIG{PIPE} = 'IGNORE';
 400
 401   my $oldAutoCommit = $FS::UID::AutoCommit;
 402   local $FS::UID::AutoCommit = 0;
 403   my $dbh = dbh;
 404
 405   #new-style exports!
 406   unless ( $noexport_hack ) {
 407     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 408       my $error = $part_export->export_unsuspend($self);
 409       if ( $error ) {
 410         $dbh->rollback if $oldAutoCommit;
 411         return "error exporting to ". $part_export->exporttype.
 412                " (transaction rolled back): $error";
 413       }
 414     }
 415   }
 416
 417   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 418   '';
 419
 420 }
 421
 422 =item cancel
 423
 424 Stub - returns false (no error) so derived classes don't need to define these
 425 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 426
 427 =cut
 428
 429 sub cancel { ''; }
 430
 431 =back
 432
 433 =head1 BUGS
 434
 435 The setfixed method return value.
 436
 437 =head1 SEE ALSO
 438
 439 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 440 from the base documentation.
 441
 442 =cut
 443
 444 1;
 445