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