FS/FS/cust_svc.pm

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