FS/FS/cust_svc.pm

   1 package FS::cust_svc;
   2 use base qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
   3
   4 use strict;
   5 use vars qw( $DEBUG $me $ignore_quantity $conf $ticket_system );
   6 use Carp qw(cluck);
   7 #use Scalar::Util qw( blessed );
   8 use List::Util qw( max );
   9 use FS::Conf;
  10 use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing );
  11 use FS::part_pkg;
  12 use FS::part_svc;
  13 use FS::pkg_svc;
  14 use FS::part_svc_link;
  15 use FS::domain_record;
  16 use FS::part_export;
  17 use FS::cdr;
  18 use FS::UI::Web;
  19 use FS::export_cust_svc;
  20
  21 #most FS::svc_ classes are autoloaded in svc_x emthod
  22 use FS::svc_acct;  #this one is used in the cache stuff
  23
  24
  25 $DEBUG = 0;
  26 $me = '[cust_svc]';
  27
  28 $ignore_quantity = 0;
  29
  30 #ask FS::UID to run this stuff for us later
  31 FS::UID->install_callback( sub {
  32   $conf = new FS::Conf;
  33   $ticket_system = $conf->config('ticket_system')
  34 });
  35
  36 our $cache_enabled = 0;
  37
  38 sub _simplecache {
  39   my( $self, $hashref ) = @_;
  40   if ( $cache_enabled && $hashref->{'svc'} ) {
  41     $self->{'_svcpart'} = FS::part_svc->new($hashref);
  42   }
  43 }
  44
  45 sub _cache {
  46   my $self = shift;
  47   my ( $hashref, $cache ) = @_;
  48   if ( $hashref->{'username'} ) {
  49     $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
  50   }
  51   if ( $hashref->{'svc'} ) {
  52     $self->{'_svcpart'} = FS::part_svc->new($hashref);
  53   }
  54 }
  55
  56 =head1 NAME
  57
  58 FS::cust_svc - Object method for cust_svc objects
  59
  60 =head1 SYNOPSIS
  61
  62   use FS::cust_svc;
  63
  64   $record = new FS::cust_svc \%hash
  65   $record = new FS::cust_svc { 'column' => 'value' };
  66
  67   $error = $record->insert;
  68
  69   $error = $new_record->replace($old_record);
  70
  71   $error = $record->delete;
  72
  73   $error = $record->check;
  74
  75   ($label, $value) = $record->label;
  76
  77 =head1 DESCRIPTION
  78
  79 An FS::cust_svc represents a service.  FS::cust_svc inherits from FS::Record.
  80 The following fields are currently supported:
  81
  82 =over 4
  83
  84 =item svcnum - primary key (assigned automatically for new services)
  85
  86 =item pkgnum - Package (see L<FS::cust_pkg>)
  87
  88 =item svcpart - Service definition (see L<FS::part_svc>)
  89
  90 =item agent_svcid - Optional legacy service ID
  91
  92 =item overlimit - date the service exceeded its usage limit
  93
  94 =back
  95
  96 =head1 METHODS
  97
  98 =over 4
  99
 100 =item new HASHREF
 101
 102 Creates a new service.  To add the refund to the database, see L<"insert">.
 103 Services are normally created by creating FS::svc_ objects (see
 104 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
 105
 106 =cut
 107
 108 sub table { 'cust_svc'; }
 109
 110 =item insert
 111
 112 Adds this service to the database.  If there is an error, returns the error,
 113 otherwise returns false.
 114
 115 =cut
 116
 117 sub insert {
 118   my $self = shift;
 119
 120   local $SIG{HUP} = 'IGNORE';
 121   local $SIG{INT} = 'IGNORE';
 122   local $SIG{QUIT} = 'IGNORE';
 123   local $SIG{TERM} = 'IGNORE';
 124   local $SIG{TSTP} = 'IGNORE';
 125   local $SIG{PIPE} = 'IGNORE';
 126
 127   my $oldAutoCommit = $FS::UID::AutoCommit;
 128   local $FS::UID::AutoCommit = 0;
 129   my $dbh = dbh;
 130
 131   my $error = $self->SUPER::insert;
 132
 133   #check if this releases a hold (see FS::pkg_svc provision_hold)
 134   $error ||= $self->_check_provision_hold;
 135
 136   if ( $error ) {
 137     $dbh->rollback if $oldAutoCommit;
 138     return $error if $error
 139   }
 140
 141   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 142   ''; #no error
 143
 144 }
 145
 146 =item delete
 147
 148 Deletes this service from the database.  If there is an error, returns the
 149 error, otherwise returns false.  Note that this only removes the cust_svc
 150 record - you should probably use the B<cancel> method instead.
 151
 152 =cut
 153
 154 my $rt_session;
 155
 156 sub delete {
 157   my $self = shift;
 158
 159   my $cust_pkg = $self->cust_pkg;
 160   my $custnum = $cust_pkg->custnum if $cust_pkg;
 161
 162   local $SIG{HUP} = 'IGNORE';
 163   local $SIG{INT} = 'IGNORE';
 164   local $SIG{QUIT} = 'IGNORE';
 165   local $SIG{TERM} = 'IGNORE';
 166   local $SIG{TSTP} = 'IGNORE';
 167   local $SIG{PIPE} = 'IGNORE';
 168
 169   my $oldAutoCommit = $FS::UID::AutoCommit;
 170   local $FS::UID::AutoCommit = 0;
 171   my $dbh = dbh;
 172
 173   # delete associated export_cust_svc
 174   foreach my $export_cust_svc (
 175     qsearch('export_cust_svc',{ 'svcnum' => $self->svcnum })
 176   ) {
 177     my $error = $export_cust_svc->delete;
 178     if ( $error ) {
 179       $dbh->rollback if $oldAutoCommit;
 180       return $error;
 181     }
 182   }
 183
 184   my $error = $self->SUPER::delete;
 185   if ( $error ) {
 186     $dbh->rollback if $oldAutoCommit;
 187     return $error;
 188   }
 189
 190   foreach my $part_svc_link ( $self->part_svc_link(
 191                                 link_type   => 'cust_svc_unprovision_cascade',
 192                               )
 193   ) {
 194     foreach my $cust_svc ( qsearch( 'cust_svc', {
 195                              'pkgnum'  => $self->pkgnum,
 196                              'svcpart' => $part_svc_link->dst_svcpart,
 197                            })
 198     ) {
 199       my $error = $cust_svc->svc_x->delete;
 200       if ( $error ) {
 201         $dbh->rollback if $oldAutoCommit;
 202         return $error;
 203       }
 204     }
 205
 206   }
 207
 208   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 209
 210   if ( $ticket_system eq 'RT_Internal' ) {
 211     unless ( $rt_session ) {
 212       FS::TicketSystem->init;
 213       $rt_session = FS::TicketSystem->session;
 214     }
 215     my $links = RT::Links->new($rt_session->{CurrentUser});
 216     my $svcnum = $self->svcnum;
 217     $links->Limit(FIELD => 'Target',
 218                   VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
 219     while ( my $l = $links->Next ) {
 220       my ($val, $msg);
 221       if ( $custnum ) {
 222         # re-link to point to the customer instead
 223         ($val, $msg) =
 224           $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
 225       } else {
 226         # unlinked service
 227         ($val, $msg) = $l->Delete;
 228       }
 229       # can't do anything useful on error
 230       warn "error unlinking ticket $svcnum: $msg\n" if !$val;
 231     }
 232   }
 233
 234   '';
 235
 236 }
 237
 238 =item suspend
 239
 240 Suspends the relevant service by calling the B<suspend> method of the associated
 241 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object).
 242
 243 If there is an error, returns the error, otherwise returns false.
 244
 245 =cut
 246
 247 sub suspend {
 248   my( $self, %opt ) = @_;
 249
 250   $self->part_svc->svcdb =~ /^([\w\-]+)$/ or return 'Illegal part_svc.svcdb';
 251   my $svcdb = $1;
 252   require "FS/$svcdb.pm";
 253
 254   my $svc = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } )
 255     or return '';
 256
 257   my $error = $svc->suspend;
 258   return $error if $error;
 259
 260   if ( $opt{labels_arryref} ) {
 261     my( $label, $value ) = $self->label;
 262     push @{ $opt{labels_arrayref} }, "$label: $value";
 263   }
 264
 265   '';
 266
 267 }
 268
 269 =item cancel
 270
 271 Cancels the relevant service by calling the B<cancel> method of the associated
 272 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
 273 deleting the FS::svc_XXX record and then deleting this record.
 274
 275 If there is an error, returns the error, otherwise returns false.
 276
 277 =cut
 278
 279 sub cancel {
 280   my($self,%opt) = @_;
 281
 282   local $SIG{HUP} = 'IGNORE';
 283   local $SIG{INT} = 'IGNORE';
 284   local $SIG{QUIT} = 'IGNORE';
 285   local $SIG{TERM} = 'IGNORE';
 286   local $SIG{TSTP} = 'IGNORE';
 287   local $SIG{PIPE} = 'IGNORE';
 288
 289   my $oldAutoCommit = $FS::UID::AutoCommit;
 290   local $FS::UID::AutoCommit = 0;
 291   my $dbh = dbh;
 292
 293   my $part_svc = $self->part_svc;
 294
 295   $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 296     $dbh->rollback if $oldAutoCommit;
 297     return "Illegal svcdb value in part_svc!";
 298   };
 299   my $svcdb = $1;
 300   require "FS/$svcdb.pm";
 301
 302   my $svc = $self->svc_x;
 303   if ($svc) {
 304     if ( %opt && $opt{'date'} ) {
 305         my $error = $svc->expire($opt{'date'});
 306         if ( $error ) {
 307           $dbh->rollback if $oldAutoCommit;
 308           return "Error expiring service: $error";
 309         }
 310     } else {
 311         my $error = $svc->cancel;
 312         if ( $error ) {
 313           $dbh->rollback if $oldAutoCommit;
 314           return "Error canceling service: $error";
 315         }
 316         $error = $svc->delete; #this deletes this cust_svc record as well
 317         if ( $error ) {
 318           $dbh->rollback if $oldAutoCommit;
 319           return "Error deleting service: $error";
 320         }
 321     }
 322
 323   } elsif ( !%opt ) {
 324
 325     #huh?
 326     warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
 327          "; deleting cust_svc only\n";
 328
 329     my $error = $self->delete;
 330     if ( $error ) {
 331       $dbh->rollback if $oldAutoCommit;
 332       return "Error deleting cust_svc: $error";
 333     }
 334
 335   }
 336
 337   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 338
 339   ''; #no errors
 340
 341 }
 342
 343 =item overlimit [ ACTION ]
 344
 345 Retrieves or sets the overlimit date.  If ACTION is absent, return
 346 the present value of overlimit.  If ACTION is present, it can
 347 have the value 'suspend' or 'unsuspend'.  In the case of 'suspend' overlimit
 348 is set to the current time if it is not already set.  The 'unsuspend' value
 349 causes the time to be cleared.
 350
 351 If there is an error on setting, returns the error, otherwise returns false.
 352
 353 =cut
 354
 355 sub overlimit {
 356   my $self = shift;
 357   my $action = shift or return $self->getfield('overlimit');
 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   if ( $action eq 'suspend' ) {
 371     $self->setfield('overlimit', time) unless $self->getfield('overlimit');
 372   }elsif ( $action eq 'unsuspend' ) {
 373     $self->setfield('overlimit', '');
 374   }else{
 375     die "unexpected action value: $action";
 376   }
 377
 378   local $ignore_quantity = 1;
 379   my $error = $self->replace;
 380   if ( $error ) {
 381     $dbh->rollback if $oldAutoCommit;
 382     return "Error setting overlimit: $error";
 383   }
 384
 385   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 386
 387   ''; #no errors
 388
 389 }
 390
 391 =item replace OLD_RECORD
 392
 393 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 394 returns the error, otherwise returns false.
 395
 396 =cut
 397
 398 sub replace {
 399 #  my $new = shift;
 400 #
 401 #  my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 402 #              ? shift
 403 #              : $new->replace_old;
 404   my ( $new, $old ) = ( shift, shift );
 405   $old = $new->replace_old unless defined($old);
 406
 407   local $SIG{HUP} = 'IGNORE';
 408   local $SIG{INT} = 'IGNORE';
 409   local $SIG{QUIT} = 'IGNORE';
 410   local $SIG{TERM} = 'IGNORE';
 411   local $SIG{TSTP} = 'IGNORE';
 412   local $SIG{PIPE} = 'IGNORE';
 413
 414   my $oldAutoCommit = $FS::UID::AutoCommit;
 415   local $FS::UID::AutoCommit = 0;
 416   my $dbh = dbh;
 417
 418   if ( $new->svcpart != $old->svcpart ) {
 419     my $svc_x = $new->svc_x;
 420     my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
 421     local($FS::Record::nowarn_identical) = 1;
 422     my $error = $new_svc_x->replace($svc_x);
 423     if ( $error ) {
 424       $dbh->rollback if $oldAutoCommit;
 425       return $error if $error;
 426     }
 427   }
 428
 429 #  #trigger a re-export on pkgnum changes?
 430 #  # (of prepaid packages), for Expiration RADIUS attribute
 431 #  if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
 432 #    my $svc_x = $new->svc_x;
 433 #    local($FS::Record::nowarn_identical) = 1;
 434 #    my $error = $svc_x->export('replace');
 435 #    if ( $error ) {
 436 #      $dbh->rollback if $oldAutoCommit;
 437 #      return $error if $error;
 438 #    }
 439 #  }
 440
 441   #trigger a pkg_change export on pkgnum changes
 442   if ( $new->pkgnum != $old->pkgnum ) {
 443     my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
 444                                                   $old->cust_pkg,
 445                                    );
 446
 447     if ( $error ) {
 448       $dbh->rollback if $oldAutoCommit;
 449       return $error if $error;
 450     }
 451   } # if pkgnum is changing
 452
 453   #my $error = $new->SUPER::replace($old, @_);
 454   my $error = $new->SUPER::replace($old);
 455
 456   #trigger a relocate export on location changes (NENA2 and Northern 911 export)
 457   my $old_pkg = $old->cust_pkg;
 458   my $new_pkg = $new->cust_pkg;
 459   if ( $old_pkg && $new_pkg && $new_pkg->locationnum != $old_pkg->locationnum ) {
 460     my $svc_x = $new->svc_x;
 461     if ( $svc_x->locationnum ) {
 462       if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
 463         # in this case, set the service location to be the same as the new
 464         # package location
 465         $svc_x->set('locationnum', $new->cust_pkg->locationnum);
 466         # and replace it, which triggers a relocate export so we don't
 467         # need to
 468         $error ||= $svc_x->replace;
 469       } else {
 470         # the service already has a different location from its package
 471         # so don't change it
 472       }
 473     } else {
 474       # the service doesn't have a locationnum (either isn't of a type
 475       # that has the locationnum field, or the locationnum is null and
 476       # defaults to cust_pkg->locationnum)
 477       # so just trigger the export here
 478       $error ||= $new->svc_x->export('relocate',
 479                                      $new->cust_pkg->cust_location,
 480                                      $old->cust_pkg->cust_location,
 481                                   );
 482     } # if ($svc_x->locationnum)
 483   } # if this is a location change
 484
 485   #check if this releases a hold (see FS::pkg_svc provision_hold)
 486   $error ||= $new->_check_provision_hold;
 487
 488   if ( $error ) {
 489     $dbh->rollback if $oldAutoCommit;
 490     return $error if $error
 491   }
 492
 493   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 494   ''; #no error
 495
 496 }
 497
 498 =item check
 499
 500 Checks all fields to make sure this is a valid service.  If there is an error,
 501 returns the error, otherwise returns false.  Called by the insert and
 502 replace methods.
 503
 504 =cut
 505
 506 sub check {
 507   my $self = shift;
 508
 509   my $error =
 510     $self->ut_numbern('svcnum')
 511     || $self->ut_numbern('pkgnum')
 512     || $self->ut_number('svcpart')
 513     || $self->ut_numbern('agent_svcid')
 514     || $self->ut_numbern('overlimit')
 515   ;
 516   return $error if $error;
 517
 518   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 519   return "Unknown svcpart" unless $part_svc;
 520
 521   if ( $self->pkgnum && ! $ignore_quantity ) {
 522
 523     #slightly inefficient since ->pkg_svc will also look it up, but fixing
 524     # a much larger perf problem and have bigger fish to fry
 525     my $cust_pkg = $self->cust_pkg;
 526
 527     my $pkg_svc = $self->pkg_svc
 528                     || new FS::pkg_svc { 'svcpart'  => $self->svcpart,
 529                                          'pkgpart'  => $cust_pkg->pkgpart,
 530                                          'quantity' => 0,
 531                                        };
 532
 533     #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
 534     foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
 535       my $addon_pkg_svc = qsearchs('pkg_svc', {
 536                             pkgpart => $part_pkg_link->dst_pkgpart,
 537                             svcpart => $self->svcpart,
 538                           });
 539       $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
 540         if $addon_pkg_svc;
 541     }
 542
 543    #better error message?  UI shouldn't get here
 544    return "No svcpart ". $self->svcpart.
 545           " services in pkgpart ". $cust_pkg->pkgpart
 546      unless $pkg_svc->quantity > 0;
 547
 548     my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
 549
 550     #false laziness w/cust_pkg->part_svc
 551     my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
 552                             - $num_cust_svc
 553                        );
 554
 555    #better error message?  again, UI shouldn't get here
 556     return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
 557            " services for pkgnum ". $self->pkgnum
 558       if $num_avail <= 0;
 559
 560     #part_svc_link rules (only make sense in pkgpart context, and
 561     # skipping this when ignore_quantity is set DTRT when we're "forcing"
 562     # an implicit change here (location change triggered pkgpart change,
 563     # ->overlimit, bulk customer service changes)
 564     foreach my $part_svc_link ( $self->part_svc_link(
 565                                   link_type   => 'cust_svc_provision_restrict',
 566                                 )
 567     ) {
 568       return $part_svc_link->dst_svc. ' must be provisioned before '.
 569              $part_svc_link->src_svc
 570         unless qsearchs({
 571           'table'    => 'cust_svc',
 572           'hashref'  => { 'pkgnum'  => $self->pkgnum,
 573                           'svcpart' => $part_svc_link->dst_svcpart,
 574                         },
 575           'order_by' => 'LIMIT 1',
 576         });
 577     }
 578
 579   }
 580
 581   $self->SUPER::check;
 582 }
 583
 584 =item check_part_svc_link_unprovision
 585
 586 Checks service dependency unprovision rules for this service.
 587
 588 If there is an error, returns the error, otherwise returns false.
 589
 590 =cut
 591
 592 sub check_part_svc_link_unprovision {
 593   my $self = shift;
 594
 595   foreach my $part_svc_link ( $self->part_svc_link(
 596                                 link_type   => 'cust_svc_unprovision_restrict',
 597                               )
 598   ) {
 599     return $part_svc_link->dst_svc. ' must be unprovisioned before '.
 600            $part_svc_link->src_svc
 601       if qsearchs({
 602         'table'    => 'cust_svc',
 603         'hashref'  => { 'pkgnum'  => $self->pkgnum,
 604                         'svcpart' => $part_svc_link->dst_svcpart,
 605                       },
 606         'order_by' => 'LIMIT 1',
 607       });
 608   }
 609
 610   '';
 611 }
 612
 613 =item part_svc_link
 614
 615 Returns the service dependencies (see L<FS::part_svc_link>) for the given
 616 search options, taking into account this service definition as source and
 617 this customer's agent.
 618
 619 Available options are any field in part_svc_link.  Typically used options are
 620 link_type.
 621
 622 =cut
 623
 624 sub part_svc_link {
 625   my $self = shift;
 626   my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
 627   FS::part_svc_link->by_agentnum($agentnum,
 628     src_svcpart=>$self->svcpart,
 629     disabled   => '',
 630     @_
 631   );
 632 }
 633
 634 =item display_svcnum
 635
 636 Returns the displayed service number for this service: agent_svcid if it has a
 637 value, svcnum otherwise
 638
 639 =cut
 640
 641 sub display_svcnum {
 642   my $self = shift;
 643   $self->agent_svcid || $self->svcnum;
 644 }
 645
 646 =item part_svc
 647
 648 Returns the definition for this service, as a FS::part_svc object (see
 649 L<FS::part_svc>).
 650
 651 =cut
 652
 653 sub part_svc {
 654   my $self = shift;
 655   return $self->{_svcpart} if $self->{_svcpart};
 656   cluck 'cust_svc->part_svc called' if $DEBUG;
 657   qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 658 }
 659
 660 =item cust_pkg
 661
 662 Returns the package this service belongs to, as a FS::cust_pkg object (see
 663 L<FS::cust_pkg>).
 664
 665 =item pkg_svc
 666
 667 Returns the pkg_svc record for for this service, if applicable.
 668
 669 =cut
 670
 671 sub pkg_svc {
 672   my $self = shift;
 673   my $cust_pkg = $self->cust_pkg;
 674   return undef unless $cust_pkg;
 675
 676   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 677                          'pkgpart' => $cust_pkg->pkgpart,
 678                        }
 679           );
 680 }
 681
 682 =item date_inserted
 683
 684 Returns the date this service was inserted.
 685
 686 =cut
 687
 688 sub date_inserted {
 689   my $self = shift;
 690   $self->h_date('insert');
 691 }
 692
 693 =item pkg_cancel_date
 694
 695 Returns the date this service's package was canceled.  This normally only
 696 exists for a service that's been preserved through cancellation with the
 697 part_pkg.preserve flag.
 698
 699 =cut
 700
 701 sub pkg_cancel_date {
 702   my $self = shift;
 703   my $cust_pkg = $self->cust_pkg or return;
 704   return $cust_pkg->getfield('cancel') || '';
 705 }
 706
 707 =item label [ LOCALE ]
 708
 709 Returns a list consisting of:
 710 - The name of this service (from part_svc), optionally localized
 711 - A meaningful identifier (username, domain, or mail alias)
 712 - The table name (i.e. svc_domain) for this service
 713 - svcnum
 714
 715 Usage example:
 716
 717   my($label, $value, $svcdb) = $cust_svc->label;
 718
 719 =item label_long [ LOCALE ]
 720
 721 Like the B<label> method, except the second item in the list ("meaningful
 722 identifier") may be longer - typically, a full name is included.
 723
 724 =cut
 725
 726 sub label      { shift->_label('svc_label',      @_); }
 727 sub label_long { shift->_label('svc_label_long', @_); }
 728
 729 sub _label {
 730   my $self = shift;
 731   my $method = shift;
 732   my $locale = shift;
 733   my $svc_x = $self->svc_x
 734     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 735
 736   $self->$method($svc_x, undef, undef, $locale);
 737 }
 738
 739 # svc_label(_long) takes three arguments: end date, start date, locale
 740 # and FS::svc_*::label methods must accept those also, if they even care
 741
 742 sub svc_label      { shift->_svc_label('label',      @_); }
 743 sub svc_label_long { shift->_svc_label('label_long', @_); }
 744
 745 sub _svc_label {
 746   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 747   my ($end, $start, $locale) = @_;
 748
 749   (
 750     $self->part_svc->svc_locale($locale),
 751     $svc_x->$method(@_),
 752     $self->part_svc->svcdb,
 753     $self->svcnum
 754   );
 755
 756 }
 757
 758 =item export_links
 759
 760 Returns a listref of html elements associated with this service's exports.
 761
 762 =cut
 763
 764 sub export_links {
 765   my $self = shift;
 766   my $svc_x = $self->svc_x
 767     or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
 768
 769   $svc_x->export_links;
 770 }
 771
 772 =item export_getsettings
 773
 774 Returns two hashrefs of settings associated with this service's exports.
 775
 776 =cut
 777
 778 sub export_getsettings {
 779   my $self = shift;
 780   my $svc_x = $self->svc_x
 781     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 782
 783   $svc_x->export_getsettings;
 784 }
 785
 786
 787 =item svc_x
 788
 789 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 790 FS::svc_domain object, etc.)
 791
 792 =cut
 793
 794 sub svc_x {
 795   my $self = shift;
 796   my $svcdb = $self->part_svc->svcdb;
 797   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 798     $self->{'_svc_acct'};
 799   } else {
 800     require "FS/$svcdb.pm";
 801     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 802          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 803       if $DEBUG;
 804     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 805   }
 806 }
 807
 808 =item seconds_since TIMESTAMP
 809
 810 See L<FS::svc_acct/seconds_since>.  Equivalent to
 811 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 812 where B<svcdb> is not "svc_acct".
 813
 814 =cut
 815
 816 #internal session db deprecated (or at least on hold)
 817 sub seconds_since { 'internal session db deprecated'; };
 818 ##note: implementation here, POD in FS::svc_acct
 819 #sub seconds_since {
 820 #  my($self, $since) = @_;
 821 #  my $dbh = dbh;
 822 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 823 #                              WHERE svcnum = ?
 824 #                                AND login >= ?
 825 #                                AND logout IS NOT NULL'
 826 #  ) or die $dbh->errstr;
 827 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 828 #  $sth->fetchrow_arrayref->[0];
 829 #}
 830
 831 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 832
 833 Equivalent to $cust_svc->svc_x->seconds_since_sqlradacct, but
 834 more efficient.  Meaningless for records where B<svcdb> is not
 835 svc_acct or svc_broadband.
 836
 837 =cut
 838
 839 sub seconds_since_sqlradacct {
 840   my($self, $start, $end) = @_;
 841
 842   my $mes = "$me seconds_since_sqlradacct:";
 843
 844   my $svc_x = $self->svc_x;
 845
 846   my @part_export = $self->part_svc->part_export_usage;
 847   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 848       " service definition"
 849     unless @part_export;
 850     #or return undef;
 851
 852   my $seconds = 0;
 853   foreach my $part_export ( @part_export ) {
 854
 855     next if $part_export->option('ignore_accounting');
 856
 857     warn "$mes connecting to sqlradius database\n"
 858       if $DEBUG;
 859
 860     my $dbh = DBI->connect( map { $part_export->option($_) }
 861                             qw(datasrc username password)    )
 862       or die "can't connect to sqlradius database: ". $DBI::errstr;
 863
 864     warn "$mes connected to sqlradius database\n"
 865       if $DEBUG;
 866
 867     #select a unix time conversion function based on database type
 868     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 869     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 870
 871     my $username = $part_export->export_username($svc_x);
 872
 873     my $query;
 874
 875     warn "$mes finding closed sessions completely within the given range\n"
 876       if $DEBUG;
 877
 878     my $realm = '';
 879     my $realmparam = '';
 880     if ($part_export->option('process_single_realm')) {
 881       $realm = 'AND Realm = ?';
 882       $realmparam = $part_export->option('realm');
 883     }
 884
 885     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 886                                FROM radacct
 887                                WHERE UserName = ?
 888                                  $realm
 889                                  AND $str2time AcctStartTime $closing >= ?
 890                                  AND $str2time AcctStopTime  $closing <  ?
 891                                  AND $str2time AcctStopTime  $closing > 0
 892                                  AND AcctStopTime IS NOT NULL"
 893     ) or die $dbh->errstr;
 894     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 895       or die $sth->errstr;
 896     my $regular = $sth->fetchrow_arrayref->[0];
 897
 898     warn "$mes finding open sessions which start in the range\n"
 899       if $DEBUG;
 900
 901     # count session start->range end
 902     $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
 903                 FROM radacct
 904                 WHERE UserName = ?
 905                   $realm
 906                   AND $str2time AcctStartTime $closing >= ?
 907                   AND $str2time AcctStartTime $closing <  ?
 908                   AND ( ? - $str2time AcctStartTime $closing ) < 86400
 909                   AND (    $str2time AcctStopTime $closing = 0
 910                                     OR AcctStopTime IS NULL )";
 911     $sth = $dbh->prepare($query) or die $dbh->errstr;
 912     $sth->execute( $end,
 913                    $username,
 914                    ($realm ? $realmparam : ()),
 915                    $start,
 916                    $end,
 917                    $end )
 918       or die $sth->errstr. " executing query $query";
 919     my $start_during = $sth->fetchrow_arrayref->[0];
 920
 921     warn "$mes finding closed sessions which start before the range but stop during\n"
 922       if $DEBUG;
 923
 924     #count range start->session end
 925     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
 926                             FROM radacct
 927                             WHERE UserName = ?
 928                               $realm
 929                               AND $str2time AcctStartTime $closing < ?
 930                               AND $str2time AcctStopTime  $closing >= ?
 931                               AND $str2time AcctStopTime  $closing <  ?
 932                               AND $str2time AcctStopTime  $closing > 0
 933                               AND AcctStopTime IS NOT NULL"
 934     ) or die $dbh->errstr;
 935     $sth->execute( $start,
 936                    $username,
 937                    ($realm ? $realmparam : ()),
 938                    $start,
 939                    $start,
 940                    $end )
 941       or die $sth->errstr;
 942     my $end_during = $sth->fetchrow_arrayref->[0];
 943
 944     warn "$mes finding closed sessions which start before the range but stop after\n"
 945       if $DEBUG;
 946
 947     # count range start->range end
 948     # don't count open sessions anymore (probably missing stop record)
 949     $sth = $dbh->prepare("SELECT COUNT(*)
 950                             FROM radacct
 951                             WHERE UserName = ?
 952                               $realm
 953                               AND $str2time AcctStartTime $closing < ?
 954                               AND ( $str2time AcctStopTime $closing >= ?
 955                                                                   )"
 956                               #      OR AcctStopTime =  0
 957                               #      OR AcctStopTime IS NULL       )"
 958     ) or die $dbh->errstr;
 959     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 960       or die $sth->errstr;
 961     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 962
 963     $seconds += $regular + $end_during + $start_during + $entire_range;
 964
 965     warn "$mes done finding sessions\n"
 966       if $DEBUG;
 967
 968   }
 969
 970   $seconds;
 971
 972 }
 973
 974 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 975
 976 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 977 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.
 978 Meaningless for records where B<svcdb> is not svc_acct or svc_broadband.
 979
 980 =cut
 981
 982 #(false laziness w/seconds_since_sqlradacct above)
 983 sub attribute_since_sqlradacct {
 984   my($self, $start, $end, $attrib) = @_;
 985
 986   my $mes = "$me attribute_since_sqlradacct:";
 987
 988   my $svc_x = $self->svc_x;
 989
 990   my @part_export = $self->part_svc->part_export_usage;
 991   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 992       " service definition"
 993     unless @part_export;
 994     #or return undef;
 995
 996   my $sum = 0;
 997
 998   foreach my $part_export ( @part_export ) {
 999
1000     next if $part_export->option('ignore_accounting');
1001
1002     warn "$mes connecting to sqlradius database\n"
1003       if $DEBUG;
1004
1005     my $dbh = DBI->connect( map { $part_export->option($_) }
1006                             qw(datasrc username password)    )
1007       or die "can't connect to sqlradius database: ". $DBI::errstr;
1008
1009     warn "$mes connected to sqlradius database\n"
1010       if $DEBUG;
1011
1012     #select a unix time conversion function based on database type
1013     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1014     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1015
1016     my $username = $part_export->export_username($svc_x);
1017
1018     warn "$mes SUMing $attrib sessions\n"
1019       if $DEBUG;
1020
1021     my $realm = '';
1022     my $realmparam = '';
1023     if ($part_export->option('process_single_realm')) {
1024       $realm = 'AND Realm = ?';
1025       $realmparam = $part_export->option('realm');
1026     }
1027
1028     my $sth = $dbh->prepare("SELECT SUM($attrib)
1029                                FROM radacct
1030                                WHERE UserName = ?
1031                                  $realm
1032                                  AND $str2time AcctStopTime $closing >= ?
1033                                  AND $str2time AcctStopTime $closing <  ?
1034                                  AND AcctStopTime IS NOT NULL"
1035     ) or die $dbh->errstr;
1036     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
1037       or die $sth->errstr;
1038
1039     my $row = $sth->fetchrow_arrayref;
1040     $sum += $row->[0] if defined($row->[0]);
1041
1042     warn "$mes done SUMing sessions\n"
1043       if $DEBUG;
1044
1045   }
1046
1047   $sum;
1048
1049 }
1050
1051 #note: implementation here, POD in FS::svc_acct
1052 # false laziness w/above
1053 sub attribute_last_sqlradacct {
1054   my($self, $attrib) = @_;
1055
1056   my $mes = "$me attribute_last_sqlradacct:";
1057
1058   my $svc_x = $self->svc_x;
1059
1060   my @part_export = $self->part_svc->part_export_usage;
1061   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1062       " service definition"
1063     unless @part_export;
1064     #or return undef;
1065
1066   my $value = '';
1067   my $AcctStartTime = 0;
1068
1069   foreach my $part_export ( @part_export ) {
1070
1071     next if $part_export->option('ignore_accounting');
1072
1073     warn "$mes connecting to sqlradius database\n"
1074       if $DEBUG;
1075
1076     my $dbh = DBI->connect( map { $part_export->option($_) }
1077                             qw(datasrc username password)    )
1078       or die "can't connect to sqlradius database: ". $DBI::errstr;
1079
1080     warn "$mes connected to sqlradius database\n"
1081       if $DEBUG;
1082
1083     #select a unix time conversion function based on database type
1084     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1085     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1086
1087     my $username = $part_export->export_username($svc_x);
1088
1089     warn "$mes finding most-recent $attrib\n"
1090       if $DEBUG;
1091
1092     my $realm = '';
1093     my $realmparam = '';
1094     if ($part_export->option('process_single_realm')) {
1095       $realm = 'AND Realm = ?';
1096       $realmparam = $part_export->option('realm');
1097     }
1098
1099     my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1100                                FROM radacct
1101                                WHERE UserName = ?
1102                                  $realm
1103                                ORDER BY AcctStartTime DESC LIMIT 1
1104     ") or die $dbh->errstr;
1105     $sth->execute($username, ($realm ? $realmparam : ()) )
1106       or die $sth->errstr;
1107
1108     my $row = $sth->fetchrow_arrayref;
1109     if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1110       $value = $row->[0];
1111       $AcctStartTime = $row->[1];
1112     }
1113
1114     warn "$mes done\n"
1115       if $DEBUG;
1116
1117   }
1118
1119   $value;
1120
1121 }
1122
1123 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1124
1125 See L<FS::svc_acct/get_session_history>.  Equivalent to
1126 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
1127 records where B<svcdb> is not "svc_acct".
1128
1129 =cut
1130
1131 sub get_session_history {
1132   my($self, $start, $end, $attrib) = @_;
1133
1134   #$attrib ???
1135
1136   my @part_export = $self->part_svc->part_export_usage;
1137   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1138       " service definition"
1139     unless @part_export;
1140     #or return undef;
1141
1142   my @sessions = ();
1143
1144   foreach my $part_export ( @part_export ) {
1145     push @sessions,
1146       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1147   }
1148
1149   @sessions;
1150
1151 }
1152
1153 =item tickets  [ STATUS ]
1154
1155 Returns an array of hashes representing the tickets linked to this service.
1156
1157 An optional status (or arrayref or hashref of statuses) may be specified.
1158
1159 =cut
1160
1161 sub tickets {
1162   my $self = shift;
1163   my $status = ( @_ && $_[0] ) ? shift : '';
1164
1165   my $conf = FS::Conf->new;
1166   my $num = $conf->config('cust_main-max_tickets') || 10;
1167   my @tickets = ();
1168
1169   if ( $conf->config('ticket_system') ) {
1170     unless ( $conf->config('ticket_system-custom_priority_field') ) {
1171
1172       @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1173                                                        $num,
1174                                                        undef,
1175                                                        $status,
1176                                                      )
1177                   };
1178
1179     } else {
1180
1181       foreach my $priority (
1182         $conf->config('ticket_system-custom_priority_field-values'), ''
1183       ) {
1184         last if scalar(@tickets) >= $num;
1185         push @tickets,
1186         @{ FS::TicketSystem->service_tickets( $self->svcnum,
1187                                               $num - scalar(@tickets),
1188                                               $priority,
1189                                               $status,
1190                                             )
1191          };
1192       }
1193     }
1194   }
1195   (@tickets);
1196 }
1197
1198 sub API_getinfo {
1199   my $self = shift;
1200   my $svc_x = $self->svc_x;
1201  +{ ( map { $_=>$self->$_ } $self->fields ),
1202     ( map { $_=>$svc_x->$_ } $svc_x->fields ),
1203   };
1204 }
1205
1206 =back
1207
1208 =head1 SUBROUTINES
1209
1210 =over 4
1211
1212 =item smart_search OPTION => VALUE ...
1213
1214 Accepts the option I<search>, the string to search for.  The string will
1215 be searched for as a username, email address, IP address, MAC address,
1216 phone number, and hardware serial number.  Unlike the I<smart_search> on
1217 customers, this always requires an exact match.
1218
1219 =cut
1220
1221 # though perhaps it should be fuzzy in some cases?
1222
1223 sub smart_search {
1224   my %param = __PACKAGE__->smart_search_param(@_);
1225   qsearch(\%param);
1226 }
1227
1228 sub smart_search_param {
1229   my $class = shift;
1230   my %opt = @_;
1231
1232   my $string = $opt{'search'};
1233   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1234
1235   my @or =
1236       map { my $table = $_;
1237             my $search_sql = "FS::$table"->search_sql($string);
1238             my $addl_from = "FS::$table"->search_sql_addl_from();
1239
1240             "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1241             "FROM $table $addl_from WHERE $search_sql";
1242           }
1243       FS::part_svc->svc_tables;
1244
1245   if ( $string =~ /^(\d+)$/ ) {
1246     unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1247   }
1248
1249   my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1250                   " ON (svc_all.svcnum = cust_svc.svcnum) ";
1251
1252   my @extra_sql;
1253
1254   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1255     'null_right' => 'View/link unlinked services'
1256   );
1257   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1258   #for agentnum
1259   $addl_from  .=  ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
1260                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1261                   ' LEFT JOIN part_svc  USING ( svcpart )';
1262
1263   (
1264     'table'     => 'cust_svc',
1265     'select'    => 'svc_all.svcnum AS svcnum, '.
1266                    'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1267                    'cust_svc.*',
1268     'addl_from' => $addl_from,
1269     'hashref'   => {},
1270     'extra_sql' => $extra_sql,
1271   );
1272 }
1273
1274 # If the associated cust_pkg is 'on hold'
1275 # and the associated pkg_svc has the provision_hold flag
1276 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1277 # then removes hold from pkg
1278 # returns $error or '' on success,
1279 # does not indicate if pkg status was changed
1280 sub _check_provision_hold {
1281   my $self = shift;
1282
1283   # check status of cust_pkg
1284   my $cust_pkg = $self->cust_pkg;
1285   return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1286
1287   # check flag on this svc
1288   # small false laziness with $self->pkg_svc
1289   # to avoid looking up cust_pkg twice
1290   my $pkg_svc  = qsearchs( 'pkg_svc', {
1291     'svcpart' => $self->svcpart,
1292     'pkgpart' => $cust_pkg->pkgpart,
1293   });
1294   return '' unless $pkg_svc->provision_hold;
1295
1296   # check for any others available with that flag
1297   return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1298
1299   # conditions met, remove hold
1300   return $cust_pkg->unsuspend;
1301 }
1302
1303 sub _upgrade_data {
1304   my $class = shift;
1305
1306   # fix missing (deleted by mistake) svc_x records
1307   warn "searching for missing svc_x records...\n";
1308   my %search = (
1309     'table'     => 'cust_svc',
1310     'select'    => 'cust_svc.*',
1311     'addl_from' => ' LEFT JOIN ( ' .
1312       join(' UNION ',
1313         map { "SELECT svcnum FROM $_" }
1314         FS::part_svc->svc_tables
1315       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1316     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1317   );
1318   my @svcs = qsearch(\%search);
1319   warn "found ".scalar(@svcs)."\n";
1320
1321   local $FS::Record::nowarn_classload = 1; # for h_svc_
1322   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1323
1324   my %h_search = (
1325     'hashref'  => { history_action => 'delete' },
1326     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1327   );
1328   foreach my $cust_svc (@svcs) {
1329     my $svcnum = $cust_svc->svcnum;
1330     my $svcdb = $cust_svc->part_svc->svcdb;
1331     $h_search{'hashref'}{'svcnum'} = $svcnum;
1332     $h_search{'table'} = "h_$svcdb";
1333     my $h_svc_x = qsearchs(\%h_search);
1334     if ( $h_svc_x ) {
1335       my $class = "FS::$svcdb";
1336       my $new_svc_x = $class->new({ $h_svc_x->hash });
1337       my $error = $new_svc_x->insert;
1338       warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1339         if $error;
1340     } else {
1341       # can't be fixed, so remove the dangling cust_svc to avoid breaking
1342       # stuff
1343       my $error = $cust_svc->delete;
1344       warn "error cleaning up missing svcnum $svcnum ($svcdb):\n$error\n";
1345     }
1346   }
1347
1348   '';
1349 }
1350
1351 =back
1352
1353 =head1 BUGS
1354
1355 Behaviour of changing the svcpart of cust_svc records is undefined and should
1356 possibly be prohibited, and pkg_svc records are not checked.
1357
1358 pkg_svc records are not checked in general (here).
1359
1360 Deleting this record doesn't check or delete the svc_* record associated
1361 with this record.
1362
1363 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1364 a DBI database handle is not yet implemented.
1365
1366 =head1 SEE ALSO
1367
1368 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1369 schema.html from the base documentation
1370
1371 =cut
1372
1373 1;
1374