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, src_svcpart=>$self->svcpart, @_);
 605 }
 606
 607 =item display_svcnum
 608
 609 Returns the displayed service number for this service: agent_svcid if it has a
 610 value, svcnum otherwise
 611
 612 =cut
 613
 614 sub display_svcnum {
 615   my $self = shift;
 616   $self->agent_svcid || $self->svcnum;
 617 }
 618
 619 =item part_svc
 620
 621 Returns the definition for this service, as a FS::part_svc object (see
 622 L<FS::part_svc>).
 623
 624 =cut
 625
 626 sub part_svc {
 627   my $self = shift;
 628   $self->{'_svcpart'}
 629     ? $self->{'_svcpart'}
 630     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 631 }
 632
 633 =item cust_pkg
 634
 635 Returns the package this service belongs to, as a FS::cust_pkg object (see
 636 L<FS::cust_pkg>).
 637
 638 =item pkg_svc
 639
 640 Returns the pkg_svc record for for this service, if applicable.
 641
 642 =cut
 643
 644 sub pkg_svc {
 645   my $self = shift;
 646   my $cust_pkg = $self->cust_pkg;
 647   return undef unless $cust_pkg;
 648
 649   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 650                          'pkgpart' => $cust_pkg->pkgpart,
 651                        }
 652           );
 653 }
 654
 655 =item date_inserted
 656
 657 Returns the date this service was inserted.
 658
 659 =cut
 660
 661 sub date_inserted {
 662   my $self = shift;
 663   $self->h_date('insert');
 664 }
 665
 666 =item pkg_cancel_date
 667
 668 Returns the date this service's package was canceled.  This normally only
 669 exists for a service that's been preserved through cancellation with the
 670 part_pkg.preserve flag.
 671
 672 =cut
 673
 674 sub pkg_cancel_date {
 675   my $self = shift;
 676   my $cust_pkg = $self->cust_pkg or return;
 677   return $cust_pkg->getfield('cancel') || '';
 678 }
 679
 680 =item label
 681
 682 Returns a list consisting of:
 683 - The name of this service (from part_svc)
 684 - A meaningful identifier (username, domain, or mail alias)
 685 - The table name (i.e. svc_domain) for this service
 686 - svcnum
 687
 688 Usage example:
 689
 690   my($label, $value, $svcdb) = $cust_svc->label;
 691
 692 =item label_long
 693
 694 Like the B<label> method, except the second item in the list ("meaningful
 695 identifier") may be longer - typically, a full name is included.
 696
 697 =cut
 698
 699 sub label      { shift->_label('svc_label',      @_); }
 700 sub label_long { shift->_label('svc_label_long', @_); }
 701
 702 sub _label {
 703   my $self = shift;
 704   my $method = shift;
 705   my $svc_x = $self->svc_x
 706     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 707
 708   $self->$method($svc_x);
 709 }
 710
 711 sub svc_label      { shift->_svc_label('label',      @_); }
 712 sub svc_label_long { shift->_svc_label('label_long', @_); }
 713
 714 sub _svc_label {
 715   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 716
 717   (
 718     $self->part_svc->svc,
 719     $svc_x->$method(@_),
 720     $self->part_svc->svcdb,
 721     $self->svcnum
 722   );
 723
 724 }
 725
 726 =item export_links
 727
 728 Returns a listref of html elements associated with this service's exports.
 729
 730 =cut
 731
 732 sub export_links {
 733   my $self = shift;
 734   my $svc_x = $self->svc_x
 735     or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
 736
 737   $svc_x->export_links;
 738 }
 739
 740 =item export_getsettings
 741
 742 Returns two hashrefs of settings associated with this service's exports.
 743
 744 =cut
 745
 746 sub export_getsettings {
 747   my $self = shift;
 748   my $svc_x = $self->svc_x
 749     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 750
 751   $svc_x->export_getsettings;
 752 }
 753
 754
 755 =item svc_x
 756
 757 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 758 FS::svc_domain object, etc.)
 759
 760 =cut
 761
 762 sub svc_x {
 763   my $self = shift;
 764   my $svcdb = $self->part_svc->svcdb;
 765   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 766     $self->{'_svc_acct'};
 767   } else {
 768     require "FS/$svcdb.pm";
 769     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 770          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 771       if $DEBUG;
 772     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 773   }
 774 }
 775
 776 =item seconds_since TIMESTAMP
 777
 778 See L<FS::svc_acct/seconds_since>.  Equivalent to
 779 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 780 where B<svcdb> is not "svc_acct".
 781
 782 =cut
 783
 784 #internal session db deprecated (or at least on hold)
 785 sub seconds_since { 'internal session db deprecated'; };
 786 ##note: implementation here, POD in FS::svc_acct
 787 #sub seconds_since {
 788 #  my($self, $since) = @_;
 789 #  my $dbh = dbh;
 790 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 791 #                              WHERE svcnum = ?
 792 #                                AND login >= ?
 793 #                                AND logout IS NOT NULL'
 794 #  ) or die $dbh->errstr;
 795 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 796 #  $sth->fetchrow_arrayref->[0];
 797 #}
 798
 799 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 800
 801 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 802 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 803 for records where B<svcdb> is not "svc_acct".
 804
 805 =cut
 806
 807 #note: implementation here, POD in FS::svc_acct
 808 sub seconds_since_sqlradacct {
 809   my($self, $start, $end) = @_;
 810
 811   my $mes = "$me seconds_since_sqlradacct:";
 812
 813   my $svc_x = $self->svc_x;
 814
 815   my @part_export = $self->part_svc->part_export_usage;
 816   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 817       " service definition"
 818     unless @part_export;
 819     #or return undef;
 820
 821   my $seconds = 0;
 822   foreach my $part_export ( @part_export ) {
 823
 824     next if $part_export->option('ignore_accounting');
 825
 826     warn "$mes connecting to sqlradius database\n"
 827       if $DEBUG;
 828
 829     my $dbh = DBI->connect( map { $part_export->option($_) }
 830                             qw(datasrc username password)    )
 831       or die "can't connect to sqlradius database: ". $DBI::errstr;
 832
 833     warn "$mes connected to sqlradius database\n"
 834       if $DEBUG;
 835
 836     #select a unix time conversion function based on database type
 837     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 838     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 839
 840     my $username = $part_export->export_username($svc_x);
 841
 842     my $query;
 843
 844     warn "$mes finding closed sessions completely within the given range\n"
 845       if $DEBUG;
 846
 847     my $realm = '';
 848     my $realmparam = '';
 849     if ($part_export->option('process_single_realm')) {
 850       $realm = 'AND Realm = ?';
 851       $realmparam = $part_export->option('realm');
 852     }
 853
 854     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 855                                FROM radacct
 856                                WHERE UserName = ?
 857                                  $realm
 858                                  AND $str2time AcctStartTime $closing >= ?
 859                                  AND $str2time AcctStopTime  $closing <  ?
 860                                  AND $str2time AcctStopTime  $closing > 0
 861                                  AND AcctStopTime IS NOT NULL"
 862     ) or die $dbh->errstr;
 863     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 864       or die $sth->errstr;
 865     my $regular = $sth->fetchrow_arrayref->[0];
 866
 867     warn "$mes finding open sessions which start in the range\n"
 868       if $DEBUG;
 869
 870     # count session start->range end
 871     $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
 872                 FROM radacct
 873                 WHERE UserName = ?
 874                   $realm
 875                   AND $str2time AcctStartTime $closing >= ?
 876                   AND $str2time AcctStartTime $closing <  ?
 877                   AND ( ? - $str2time AcctStartTime $closing ) < 86400
 878                   AND (    $str2time AcctStopTime $closing = 0
 879                                     OR AcctStopTime IS NULL )";
 880     $sth = $dbh->prepare($query) or die $dbh->errstr;
 881     $sth->execute( $end,
 882                    $username,
 883                    ($realm ? $realmparam : ()),
 884                    $start,
 885                    $end,
 886                    $end )
 887       or die $sth->errstr. " executing query $query";
 888     my $start_during = $sth->fetchrow_arrayref->[0];
 889
 890     warn "$mes finding closed sessions which start before the range but stop during\n"
 891       if $DEBUG;
 892
 893     #count range start->session end
 894     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
 895                             FROM radacct
 896                             WHERE UserName = ?
 897                               $realm
 898                               AND $str2time AcctStartTime $closing < ?
 899                               AND $str2time AcctStopTime  $closing >= ?
 900                               AND $str2time AcctStopTime  $closing <  ?
 901                               AND $str2time AcctStopTime  $closing > 0
 902                               AND AcctStopTime IS NOT NULL"
 903     ) or die $dbh->errstr;
 904     $sth->execute( $start,
 905                    $username,
 906                    ($realm ? $realmparam : ()),
 907                    $start,
 908                    $start,
 909                    $end )
 910       or die $sth->errstr;
 911     my $end_during = $sth->fetchrow_arrayref->[0];
 912
 913     warn "$mes finding closed sessions which start before the range but stop after\n"
 914       if $DEBUG;
 915
 916     # count range start->range end
 917     # don't count open sessions anymore (probably missing stop record)
 918     $sth = $dbh->prepare("SELECT COUNT(*)
 919                             FROM radacct
 920                             WHERE UserName = ?
 921                               $realm
 922                               AND $str2time AcctStartTime $closing < ?
 923                               AND ( $str2time AcctStopTime $closing >= ?
 924                                                                   )"
 925                               #      OR AcctStopTime =  0
 926                               #      OR AcctStopTime IS NULL       )"
 927     ) or die $dbh->errstr;
 928     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 929       or die $sth->errstr;
 930     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 931
 932     $seconds += $regular + $end_during + $start_during + $entire_range;
 933
 934     warn "$mes done finding sessions\n"
 935       if $DEBUG;
 936
 937   }
 938
 939   $seconds;
 940
 941 }
 942
 943 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 944
 945 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 946 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 947 for records where B<svcdb> is not "svc_acct".
 948
 949 =cut
 950
 951 #note: implementation here, POD in FS::svc_acct
 952 #(false laziness w/seconds_since_sqlradacct above)
 953 sub attribute_since_sqlradacct {
 954   my($self, $start, $end, $attrib) = @_;
 955
 956   my $mes = "$me attribute_since_sqlradacct:";
 957
 958   my $svc_x = $self->svc_x;
 959
 960   my @part_export = $self->part_svc->part_export_usage;
 961   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 962       " service definition"
 963     unless @part_export;
 964     #or return undef;
 965
 966   my $sum = 0;
 967
 968   foreach my $part_export ( @part_export ) {
 969
 970     next if $part_export->option('ignore_accounting');
 971
 972     warn "$mes connecting to sqlradius database\n"
 973       if $DEBUG;
 974
 975     my $dbh = DBI->connect( map { $part_export->option($_) }
 976                             qw(datasrc username password)    )
 977       or die "can't connect to sqlradius database: ". $DBI::errstr;
 978
 979     warn "$mes connected to sqlradius database\n"
 980       if $DEBUG;
 981
 982     #select a unix time conversion function based on database type
 983     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 984     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 985
 986     my $username = $part_export->export_username($svc_x);
 987
 988     warn "$mes SUMing $attrib sessions\n"
 989       if $DEBUG;
 990
 991     my $realm = '';
 992     my $realmparam = '';
 993     if ($part_export->option('process_single_realm')) {
 994       $realm = 'AND Realm = ?';
 995       $realmparam = $part_export->option('realm');
 996     }
 997
 998     my $sth = $dbh->prepare("SELECT SUM($attrib)
 999                                FROM radacct
1000                                WHERE UserName = ?
1001                                  $realm
1002                                  AND $str2time AcctStopTime $closing >= ?
1003                                  AND $str2time AcctStopTime $closing <  ?
1004                                  AND AcctStopTime IS NOT NULL"
1005     ) or die $dbh->errstr;
1006     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
1007       or die $sth->errstr;
1008
1009     my $row = $sth->fetchrow_arrayref;
1010     $sum += $row->[0] if defined($row->[0]);
1011
1012     warn "$mes done SUMing sessions\n"
1013       if $DEBUG;
1014
1015   }
1016
1017   $sum;
1018
1019 }
1020
1021 #note: implementation here, POD in FS::svc_acct
1022 # false laziness w/above
1023 sub attribute_last_sqlradacct {
1024   my($self, $attrib) = @_;
1025
1026   my $mes = "$me attribute_last_sqlradacct:";
1027
1028   my $svc_x = $self->svc_x;
1029
1030   my @part_export = $self->part_svc->part_export_usage;
1031   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1032       " service definition"
1033     unless @part_export;
1034     #or return undef;
1035
1036   my $value = '';
1037   my $AcctStartTime = 0;
1038
1039   foreach my $part_export ( @part_export ) {
1040
1041     next if $part_export->option('ignore_accounting');
1042
1043     warn "$mes connecting to sqlradius database\n"
1044       if $DEBUG;
1045
1046     my $dbh = DBI->connect( map { $part_export->option($_) }
1047                             qw(datasrc username password)    )
1048       or die "can't connect to sqlradius database: ". $DBI::errstr;
1049
1050     warn "$mes connected to sqlradius database\n"
1051       if $DEBUG;
1052
1053     #select a unix time conversion function based on database type
1054     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1055     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1056
1057     my $username = $part_export->export_username($svc_x);
1058
1059     warn "$mes finding most-recent $attrib\n"
1060       if $DEBUG;
1061
1062     my $realm = '';
1063     my $realmparam = '';
1064     if ($part_export->option('process_single_realm')) {
1065       $realm = 'AND Realm = ?';
1066       $realmparam = $part_export->option('realm');
1067     }
1068
1069     my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1070                                FROM radacct
1071                                WHERE UserName = ?
1072                                  $realm
1073                                ORDER BY AcctStartTime DESC LIMIT 1
1074     ") or die $dbh->errstr;
1075     $sth->execute($username, ($realm ? $realmparam : ()) )
1076       or die $sth->errstr;
1077
1078     my $row = $sth->fetchrow_arrayref;
1079     if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1080       $value = $row->[0];
1081       $AcctStartTime = $row->[1];
1082     }
1083
1084     warn "$mes done\n"
1085       if $DEBUG;
1086
1087   }
1088
1089   $value;
1090
1091 }
1092
1093 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1094
1095 See L<FS::svc_acct/get_session_history>.  Equivalent to
1096 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
1097 records where B<svcdb> is not "svc_acct".
1098
1099 =cut
1100
1101 sub get_session_history {
1102   my($self, $start, $end, $attrib) = @_;
1103
1104   #$attrib ???
1105
1106   my @part_export = $self->part_svc->part_export_usage;
1107   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1108       " service definition"
1109     unless @part_export;
1110     #or return undef;
1111
1112   my @sessions = ();
1113
1114   foreach my $part_export ( @part_export ) {
1115     push @sessions,
1116       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1117   }
1118
1119   @sessions;
1120
1121 }
1122
1123 =item tickets  [ STATUS ]
1124
1125 Returns an array of hashes representing the tickets linked to this service.
1126
1127 An optional status (or arrayref or hashref of statuses) may be specified.
1128
1129 =cut
1130
1131 sub tickets {
1132   my $self = shift;
1133   my $status = ( @_ && $_[0] ) ? shift : '';
1134
1135   my $conf = FS::Conf->new;
1136   my $num = $conf->config('cust_main-max_tickets') || 10;
1137   my @tickets = ();
1138
1139   if ( $conf->config('ticket_system') ) {
1140     unless ( $conf->config('ticket_system-custom_priority_field') ) {
1141
1142       @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1143                                                        $num,
1144                                                        undef,
1145                                                        $status,
1146                                                      )
1147                   };
1148
1149     } else {
1150
1151       foreach my $priority (
1152         $conf->config('ticket_system-custom_priority_field-values'), ''
1153       ) {
1154         last if scalar(@tickets) >= $num;
1155         push @tickets,
1156         @{ FS::TicketSystem->service_tickets( $self->svcnum,
1157                                               $num - scalar(@tickets),
1158                                               $priority,
1159                                               $status,
1160                                             )
1161          };
1162       }
1163     }
1164   }
1165   (@tickets);
1166 }
1167
1168 sub API_getinfo {
1169   my $self = shift;
1170   my $svc_x = $self->svc_x;
1171  +{ ( map { $_=>$self->$_ } $self->fields ),
1172     ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ),
1173   };
1174 }
1175
1176 =back
1177
1178 =head1 SUBROUTINES
1179
1180 =over 4
1181
1182 =item smart_search OPTION => VALUE ...
1183
1184 Accepts the option I<search>, the string to search for.  The string will
1185 be searched for as a username, email address, IP address, MAC address,
1186 phone number, and hardware serial number.  Unlike the I<smart_search> on
1187 customers, this always requires an exact match.
1188
1189 =cut
1190
1191 # though perhaps it should be fuzzy in some cases?
1192
1193 sub smart_search {
1194   my %param = __PACKAGE__->smart_search_param(@_);
1195   qsearch(\%param);
1196 }
1197
1198 sub smart_search_param {
1199   my $class = shift;
1200   my %opt = @_;
1201
1202   my $string = $opt{'search'};
1203   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1204
1205   my @or =
1206       map { my $table = $_;
1207             my $search_sql = "FS::$table"->search_sql($string);
1208             my $addl_from = "FS::$table"->search_sql_addl_from();
1209
1210             "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1211             "FROM $table $addl_from WHERE $search_sql";
1212           }
1213       FS::part_svc->svc_tables;
1214
1215   if ( $string =~ /^(\d+)$/ ) {
1216     unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1217   }
1218
1219   my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1220                   " ON (svc_all.svcnum = cust_svc.svcnum) ";
1221
1222   my @extra_sql;
1223
1224   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1225     'null_right' => 'View/link unlinked services'
1226   );
1227   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1228   #for agentnum
1229   $addl_from  .=  ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
1230                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1231                   ' LEFT JOIN part_svc  USING ( svcpart )';
1232
1233   (
1234     'table'     => 'cust_svc',
1235     'select'    => 'svc_all.svcnum AS svcnum, '.
1236                    'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1237                    'cust_svc.*',
1238     'addl_from' => $addl_from,
1239     'hashref'   => {},
1240     'extra_sql' => $extra_sql,
1241   );
1242 }
1243
1244 # If the associated cust_pkg is 'on hold'
1245 # and the associated pkg_svc has the provision_hold flag
1246 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1247 # then removes hold from pkg
1248 # returns $error or '' on success,
1249 # does not indicate if pkg status was changed
1250 sub _check_provision_hold {
1251   my $self = shift;
1252
1253   # check status of cust_pkg
1254   my $cust_pkg = $self->cust_pkg;
1255   return '' unless $cust_pkg->status eq 'on hold';
1256
1257   # check flag on this svc
1258   # small false laziness with $self->pkg_svc
1259   # to avoid looking up cust_pkg twice
1260   my $pkg_svc  = qsearchs( 'pkg_svc', {
1261     'svcpart' => $self->svcpart,
1262     'pkgpart' => $cust_pkg->pkgpart,
1263   });
1264   return '' unless $pkg_svc->provision_hold;
1265
1266   # check for any others available with that flag
1267   return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1268
1269   # conditions met, remove hold
1270   return $cust_pkg->unsuspend;
1271 }
1272
1273 sub _upgrade_data {
1274   my $class = shift;
1275
1276   # fix missing (deleted by mistake) svc_x records
1277   warn "searching for missing svc_x records...\n";
1278   my %search = (
1279     'table'     => 'cust_svc',
1280     'select'    => 'cust_svc.*',
1281     'addl_from' => ' LEFT JOIN ( ' .
1282       join(' UNION ',
1283         map { "SELECT svcnum FROM $_" }
1284         FS::part_svc->svc_tables
1285       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1286     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1287   );
1288   my @svcs = qsearch(\%search);
1289   warn "found ".scalar(@svcs)."\n";
1290
1291   local $FS::Record::nowarn_classload = 1; # for h_svc_
1292   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1293
1294   my %h_search = (
1295     'hashref'  => { history_action => 'delete' },
1296     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1297   );
1298   foreach my $cust_svc (@svcs) {
1299     my $svcnum = $cust_svc->svcnum;
1300     my $svcdb = $cust_svc->part_svc->svcdb;
1301     $h_search{'hashref'}{'svcnum'} = $svcnum;
1302     $h_search{'table'} = "h_$svcdb";
1303     my $h_svc_x = qsearchs(\%h_search)
1304       or next;
1305     my $class = "FS::$svcdb";
1306     my $new_svc_x = $class->new({ $h_svc_x->hash });
1307     my $error = $new_svc_x->insert;
1308     warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1309       if $error;
1310   }
1311
1312   '';
1313 }
1314
1315 =back
1316
1317 =head1 BUGS
1318
1319 Behaviour of changing the svcpart of cust_svc records is undefined and should
1320 possibly be prohibited, and pkg_svc records are not checked.
1321
1322 pkg_svc records are not checked in general (here).
1323
1324 Deleting this record doesn't check or delete the svc_* record associated
1325 with this record.
1326
1327 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1328 a DBI database handle is not yet implemented.
1329
1330 =head1 SEE ALSO
1331
1332 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1333 schema.html from the base documentation
1334
1335 =cut
1336
1337 1;
1338