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     $cust_svc = new FS::cust_svc ( {
 124       #hua?# 'svcnum'  => $svcnum,
 125       'pkgnum'  => $self->pkgnum,
 126       'svcpart' => $self->svcpart,
 127     } );
 128     $error = $cust_svc->insert;
 129     if ( $error ) {
 130       $dbh->rollback if $oldAutoCommit;
 131       return $error;
 132     }
 133     $svcnum = $self->svcnum($cust_svc->svcnum);
 134   } else {
 135     $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 136     unless ( $cust_svc ) {
 137       $dbh->rollback if $oldAutoCommit;
 138       return "no cust_svc record found for svcnum ". $self->svcnum;
 139     }
 140     $self->pkgnum($cust_svc->pkgnum);
 141     $self->svcpart($cust_svc->svcpart);
 142   }
 143
 144   $error = $self->SUPER::insert;
 145   if ( $error ) {
 146     $dbh->rollback if $oldAutoCommit;
 147     return $error;
 148   }
 149
 150   foreach my $object ( @$objects ) {
 151     $object->svcnum($self->svcnum);
 152     $error = $object->insert;
 153     if ( $error ) {
 154       $dbh->rollback if $oldAutoCommit;
 155       return $error;
 156     }
 157   }
 158
 159   #new-style exports!
 160   unless ( $noexport_hack ) {
 161     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 162       my $error = $part_export->export_insert($self);
 163       if ( $error ) {
 164         $dbh->rollback if $oldAutoCommit;
 165         return "exporting to ". $part_export->exporttype.
 166                " (transaction rolled back): $error";
 167       }
 168     }
 169   }
 170
 171   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 172
 173   '';
 174 }
 175
 176 =item delete
 177
 178 Deletes this account from the database.  If there is an error, returns the
 179 error, otherwise returns false.
 180
 181 The corresponding FS::cust_svc record will be deleted as well.
 182
 183 =cut
 184
 185 sub delete {
 186   my $self = shift;
 187   my $error;
 188
 189   local $SIG{HUP} = 'IGNORE';
 190   local $SIG{INT} = 'IGNORE';
 191   local $SIG{QUIT} = 'IGNORE';
 192   local $SIG{TERM} = 'IGNORE';
 193   local $SIG{TSTP} = 'IGNORE';
 194   local $SIG{PIPE} = 'IGNORE';
 195
 196   my $svcnum = $self->svcnum;
 197
 198   my $oldAutoCommit = $FS::UID::AutoCommit;
 199   local $FS::UID::AutoCommit = 0;
 200   my $dbh = dbh;
 201
 202   $error = $self->SUPER::delete;
 203   return $error if $error;
 204
 205   #new-style exports!
 206   unless ( $noexport_hack ) {
 207     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 208       my $error = $part_export->export_delete($self);
 209       if ( $error ) {
 210         $dbh->rollback if $oldAutoCommit;
 211         return "exporting to ". $part_export->exporttype.
 212                " (transaction rolled back): $error";
 213       }
 214     }
 215   }
 216
 217   return $error if $error;
 218
 219   my $cust_svc = $self->cust_svc;
 220   $error = $cust_svc->delete;
 221   return $error if $error;
 222
 223   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 224
 225   '';
 226 }
 227
 228 =item replace OLD_RECORD
 229
 230 Replaces OLD_RECORD with this one.  If there is an error, returns the error,
 231 otherwise returns false.
 232
 233 =cut
 234
 235 sub replace {
 236   my ($new, $old) = (shift, shift);
 237
 238   local $SIG{HUP} = 'IGNORE';
 239   local $SIG{INT} = 'IGNORE';
 240   local $SIG{QUIT} = 'IGNORE';
 241   local $SIG{TERM} = 'IGNORE';
 242   local $SIG{TSTP} = 'IGNORE';
 243   local $SIG{PIPE} = 'IGNORE';
 244
 245   my $oldAutoCommit = $FS::UID::AutoCommit;
 246   local $FS::UID::AutoCommit = 0;
 247   my $dbh = dbh;
 248
 249   my $error = $new->SUPER::replace($old);
 250   if ($error) {
 251     $dbh->rollback if $oldAutoCommit;
 252     return $error;
 253   }
 254
 255   #new-style exports!
 256   unless ( $noexport_hack ) {
 257     foreach my $part_export ( $new->cust_svc->part_svc->part_export ) {
 258       my $error = $part_export->export_replace($new,$old);
 259       if ( $error ) {
 260         $dbh->rollback if $oldAutoCommit;
 261         return "error exporting to ". $part_export->exporttype.
 262                " (transaction rolled back): $error";
 263       }
 264     }
 265   }
 266
 267   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 268   '';
 269 }
 270
 271
 272 =item setfixed
 273
 274 Sets any fixed fields for this service (see L<FS::part_svc>).  If there is an
 275 error, returns the error, otherwise returns the FS::part_svc object (use ref()
 276 to test the return).  Usually called by the check method.
 277
 278 =cut
 279
 280 sub setfixed {
 281   my $self = shift;
 282   $self->setx('F');
 283 }
 284
 285 =item setdefault
 286
 287 Sets all fields to their defaults (see L<FS::part_svc>), overriding their
 288 current values.  If there is an error, returns the error, otherwise returns
 289 the FS::part_svc object (use ref() to test the return).
 290
 291 =cut
 292
 293 sub setdefault {
 294   my $self = shift;
 295   $self->setx('D');
 296 }
 297
 298 sub setx {
 299   my $self = shift;
 300   my $x = shift;
 301
 302   my $error;
 303
 304   $error =
 305     $self->ut_numbern('svcnum')
 306   ;
 307   return $error if $error;
 308
 309   #get part_svc
 310   my $svcpart;
 311   if ( $self->svcnum ) {
 312     my $cust_svc = $self->cust_svc;
 313     return "Unknown svcnum" unless $cust_svc;
 314     $svcpart = $cust_svc->svcpart;
 315   } else {
 316     $svcpart = $self->getfield('svcpart');
 317   }
 318   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $svcpart } );
 319   return "Unkonwn svcpart" unless $part_svc;
 320
 321   #set default/fixed/whatever fields from part_svc
 322   my $table = $self->table;
 323   foreach my $field ( grep { $_ ne 'svcnum' } $self->fields ) {
 324     my $part_svc_column = $part_svc->part_svc_column($field);
 325     if ( $part_svc_column->columnflag eq $x ) {
 326       $self->setfield( $field, $part_svc_column->columnvalue );
 327     }
 328   }
 329
 330  $part_svc;
 331
 332 }
 333
 334 =item cust_svc
 335
 336 Returns the cust_svc record associated with this svc_ record, as a FS::cust_svc
 337 object (see L<FS::cust_svc>).
 338
 339 =cut
 340
 341 sub cust_svc {
 342   my $self = shift;
 343   qsearchs('cust_svc', { 'svcnum' => $self->svcnum } );
 344 }
 345
 346 =item suspend
 347
 348 Runs export_suspend callbacks.
 349
 350 =cut
 351
 352 sub suspend {
 353   my $self = shift;
 354
 355   local $SIG{HUP} = 'IGNORE';
 356   local $SIG{INT} = 'IGNORE';
 357   local $SIG{QUIT} = 'IGNORE';
 358   local $SIG{TERM} = 'IGNORE';
 359   local $SIG{TSTP} = 'IGNORE';
 360   local $SIG{PIPE} = 'IGNORE';
 361
 362   my $oldAutoCommit = $FS::UID::AutoCommit;
 363   local $FS::UID::AutoCommit = 0;
 364   my $dbh = dbh;
 365
 366   #new-style exports!
 367   unless ( $noexport_hack ) {
 368     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 369       my $error = $part_export->export_suspend($self);
 370       if ( $error ) {
 371         $dbh->rollback if $oldAutoCommit;
 372         return "error exporting to ". $part_export->exporttype.
 373                " (transaction rolled back): $error";
 374       }
 375     }
 376   }
 377
 378   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 379   '';
 380
 381 }
 382
 383 =item unsuspend
 384
 385 Runs export_unsuspend callbacks.
 386
 387 =cut
 388
 389 sub unsuspend {
 390   my $self = shift;
 391
 392   local $SIG{HUP} = 'IGNORE';
 393   local $SIG{INT} = 'IGNORE';
 394   local $SIG{QUIT} = 'IGNORE';
 395   local $SIG{TERM} = 'IGNORE';
 396   local $SIG{TSTP} = 'IGNORE';
 397   local $SIG{PIPE} = 'IGNORE';
 398
 399   my $oldAutoCommit = $FS::UID::AutoCommit;
 400   local $FS::UID::AutoCommit = 0;
 401   my $dbh = dbh;
 402
 403   #new-style exports!
 404   unless ( $noexport_hack ) {
 405     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 406       my $error = $part_export->export_unsuspend($self);
 407       if ( $error ) {
 408         $dbh->rollback if $oldAutoCommit;
 409         return "error exporting to ". $part_export->exporttype.
 410                " (transaction rolled back): $error";
 411       }
 412     }
 413   }
 414
 415   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 416   '';
 417
 418 }
 419
 420 =item cancel
 421
 422 Stub - returns false (no error) so derived classes don't need to define these
 423 methods.  Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 424
 425 =cut
 426
 427 sub cancel { ''; }
 428
 429 =back
 430
 431 =head1 BUGS
 432
 433 The setfixed method return value.
 434
 435 =head1 SEE ALSO
 436
 437 L<FS::Record>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, schema.html
 438 from the base documentation.
 439
 440 =cut
 441
 442 1;
 443