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