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