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