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 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 827 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 828 for records where B<svcdb> is not "svc_acct".
 829
 830 =cut
 831
 832 #note: implementation here, POD in FS::svc_acct
 833 sub seconds_since_sqlradacct {
 834   my($self, $start, $end) = @_;
 835
 836   my $mes = "$me seconds_since_sqlradacct:";
 837
 838   my $svc_x = $self->svc_x;
 839
 840   my @part_export = $self->part_svc->part_export_usage;
 841   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 842       " service definition"
 843     unless @part_export;
 844     #or return undef;
 845
 846   my $seconds = 0;
 847   foreach my $part_export ( @part_export ) {
 848
 849     next if $part_export->option('ignore_accounting');
 850
 851     warn "$mes connecting to sqlradius database\n"
 852       if $DEBUG;
 853
 854     my $dbh = DBI->connect( map { $part_export->option($_) }
 855                             qw(datasrc username password)    )
 856       or die "can't connect to sqlradius database: ". $DBI::errstr;
 857
 858     warn "$mes connected to sqlradius database\n"
 859       if $DEBUG;
 860
 861     #select a unix time conversion function based on database type
 862     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 863     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 864
 865     my $username = $part_export->export_username($svc_x);
 866
 867     my $query;
 868
 869     warn "$mes finding closed sessions completely within the given range\n"
 870       if $DEBUG;
 871
 872     my $realm = '';
 873     my $realmparam = '';
 874     if ($part_export->option('process_single_realm')) {
 875       $realm = 'AND Realm = ?';
 876       $realmparam = $part_export->option('realm');
 877     }
 878
 879     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 880                                FROM radacct
 881                                WHERE UserName = ?
 882                                  $realm
 883                                  AND $str2time AcctStartTime $closing >= ?
 884                                  AND $str2time AcctStopTime  $closing <  ?
 885                                  AND $str2time AcctStopTime  $closing > 0
 886                                  AND AcctStopTime IS NOT NULL"
 887     ) or die $dbh->errstr;
 888     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 889       or die $sth->errstr;
 890     my $regular = $sth->fetchrow_arrayref->[0];
 891
 892     warn "$mes finding open sessions which start in the range\n"
 893       if $DEBUG;
 894
 895     # count session start->range end
 896     $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
 897                 FROM radacct
 898                 WHERE UserName = ?
 899                   $realm
 900                   AND $str2time AcctStartTime $closing >= ?
 901                   AND $str2time AcctStartTime $closing <  ?
 902                   AND ( ? - $str2time AcctStartTime $closing ) < 86400
 903                   AND (    $str2time AcctStopTime $closing = 0
 904                                     OR AcctStopTime IS NULL )";
 905     $sth = $dbh->prepare($query) or die $dbh->errstr;
 906     $sth->execute( $end,
 907                    $username,
 908                    ($realm ? $realmparam : ()),
 909                    $start,
 910                    $end,
 911                    $end )
 912       or die $sth->errstr. " executing query $query";
 913     my $start_during = $sth->fetchrow_arrayref->[0];
 914
 915     warn "$mes finding closed sessions which start before the range but stop during\n"
 916       if $DEBUG;
 917
 918     #count range start->session end
 919     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
 920                             FROM radacct
 921                             WHERE UserName = ?
 922                               $realm
 923                               AND $str2time AcctStartTime $closing < ?
 924                               AND $str2time AcctStopTime  $closing >= ?
 925                               AND $str2time AcctStopTime  $closing <  ?
 926                               AND $str2time AcctStopTime  $closing > 0
 927                               AND AcctStopTime IS NOT NULL"
 928     ) or die $dbh->errstr;
 929     $sth->execute( $start,
 930                    $username,
 931                    ($realm ? $realmparam : ()),
 932                    $start,
 933                    $start,
 934                    $end )
 935       or die $sth->errstr;
 936     my $end_during = $sth->fetchrow_arrayref->[0];
 937
 938     warn "$mes finding closed sessions which start before the range but stop after\n"
 939       if $DEBUG;
 940
 941     # count range start->range end
 942     # don't count open sessions anymore (probably missing stop record)
 943     $sth = $dbh->prepare("SELECT COUNT(*)
 944                             FROM radacct
 945                             WHERE UserName = ?
 946                               $realm
 947                               AND $str2time AcctStartTime $closing < ?
 948                               AND ( $str2time AcctStopTime $closing >= ?
 949                                                                   )"
 950                               #      OR AcctStopTime =  0
 951                               #      OR AcctStopTime IS NULL       )"
 952     ) or die $dbh->errstr;
 953     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 954       or die $sth->errstr;
 955     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 956
 957     $seconds += $regular + $end_during + $start_during + $entire_range;
 958
 959     warn "$mes done finding sessions\n"
 960       if $DEBUG;
 961
 962   }
 963
 964   $seconds;
 965
 966 }
 967
 968 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 969
 970 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 971 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 972 for records where B<svcdb> is not "svc_acct".
 973
 974 =cut
 975
 976 #note: implementation here, POD in FS::svc_acct
 977 #(false laziness w/seconds_since_sqlradacct above)
 978 sub attribute_since_sqlradacct {
 979   my($self, $start, $end, $attrib) = @_;
 980
 981   my $mes = "$me attribute_since_sqlradacct:";
 982
 983   my $svc_x = $self->svc_x;
 984
 985   my @part_export = $self->part_svc->part_export_usage;
 986   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 987       " service definition"
 988     unless @part_export;
 989     #or return undef;
 990
 991   my $sum = 0;
 992
 993   foreach my $part_export ( @part_export ) {
 994
 995     next if $part_export->option('ignore_accounting');
 996
 997     warn "$mes connecting to sqlradius database\n"
 998       if $DEBUG;
 999
1000     my $dbh = DBI->connect( map { $part_export->option($_) }
1001                             qw(datasrc username password)    )
1002       or die "can't connect to sqlradius database: ". $DBI::errstr;
1003
1004     warn "$mes connected to sqlradius database\n"
1005       if $DEBUG;
1006
1007     #select a unix time conversion function based on database type
1008     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1009     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1010
1011     my $username = $part_export->export_username($svc_x);
1012
1013     warn "$mes SUMing $attrib sessions\n"
1014       if $DEBUG;
1015
1016     my $realm = '';
1017     my $realmparam = '';
1018     if ($part_export->option('process_single_realm')) {
1019       $realm = 'AND Realm = ?';
1020       $realmparam = $part_export->option('realm');
1021     }
1022
1023     my $sth = $dbh->prepare("SELECT SUM($attrib)
1024                                FROM radacct
1025                                WHERE UserName = ?
1026                                  $realm
1027                                  AND $str2time AcctStopTime $closing >= ?
1028                                  AND $str2time AcctStopTime $closing <  ?
1029                                  AND AcctStopTime IS NOT NULL"
1030     ) or die $dbh->errstr;
1031     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
1032       or die $sth->errstr;
1033
1034     my $row = $sth->fetchrow_arrayref;
1035     $sum += $row->[0] if defined($row->[0]);
1036
1037     warn "$mes done SUMing sessions\n"
1038       if $DEBUG;
1039
1040   }
1041
1042   $sum;
1043
1044 }
1045
1046 #note: implementation here, POD in FS::svc_acct
1047 # false laziness w/above
1048 sub attribute_last_sqlradacct {
1049   my($self, $attrib) = @_;
1050
1051   my $mes = "$me attribute_last_sqlradacct:";
1052
1053   my $svc_x = $self->svc_x;
1054
1055   my @part_export = $self->part_svc->part_export_usage;
1056   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1057       " service definition"
1058     unless @part_export;
1059     #or return undef;
1060
1061   my $value = '';
1062   my $AcctStartTime = 0;
1063
1064   foreach my $part_export ( @part_export ) {
1065
1066     next if $part_export->option('ignore_accounting');
1067
1068     warn "$mes connecting to sqlradius database\n"
1069       if $DEBUG;
1070
1071     my $dbh = DBI->connect( map { $part_export->option($_) }
1072                             qw(datasrc username password)    )
1073       or die "can't connect to sqlradius database: ". $DBI::errstr;
1074
1075     warn "$mes connected to sqlradius database\n"
1076       if $DEBUG;
1077
1078     #select a unix time conversion function based on database type
1079     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1080     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1081
1082     my $username = $part_export->export_username($svc_x);
1083
1084     warn "$mes finding most-recent $attrib\n"
1085       if $DEBUG;
1086
1087     my $realm = '';
1088     my $realmparam = '';
1089     if ($part_export->option('process_single_realm')) {
1090       $realm = 'AND Realm = ?';
1091       $realmparam = $part_export->option('realm');
1092     }
1093
1094     my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1095                                FROM radacct
1096                                WHERE UserName = ?
1097                                  $realm
1098                                ORDER BY AcctStartTime DESC LIMIT 1
1099     ") or die $dbh->errstr;
1100     $sth->execute($username, ($realm ? $realmparam : ()) )
1101       or die $sth->errstr;
1102
1103     my $row = $sth->fetchrow_arrayref;
1104     if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1105       $value = $row->[0];
1106       $AcctStartTime = $row->[1];
1107     }
1108
1109     warn "$mes done\n"
1110       if $DEBUG;
1111
1112   }
1113
1114   $value;
1115
1116 }
1117
1118 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1119
1120 See L<FS::svc_acct/get_session_history>.  Equivalent to
1121 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
1122 records where B<svcdb> is not "svc_acct".
1123
1124 =cut
1125
1126 sub get_session_history {
1127   my($self, $start, $end, $attrib) = @_;
1128
1129   #$attrib ???
1130
1131   my @part_export = $self->part_svc->part_export_usage;
1132   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1133       " service definition"
1134     unless @part_export;
1135     #or return undef;
1136
1137   my @sessions = ();
1138
1139   foreach my $part_export ( @part_export ) {
1140     push @sessions,
1141       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1142   }
1143
1144   @sessions;
1145
1146 }
1147
1148 =item tickets  [ STATUS ]
1149
1150 Returns an array of hashes representing the tickets linked to this service.
1151
1152 An optional status (or arrayref or hashref of statuses) may be specified.
1153
1154 =cut
1155
1156 sub tickets {
1157   my $self = shift;
1158   my $status = ( @_ && $_[0] ) ? shift : '';
1159
1160   my $conf = FS::Conf->new;
1161   my $num = $conf->config('cust_main-max_tickets') || 10;
1162   my @tickets = ();
1163
1164   if ( $conf->config('ticket_system') ) {
1165     unless ( $conf->config('ticket_system-custom_priority_field') ) {
1166
1167       @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1168                                                        $num,
1169                                                        undef,
1170                                                        $status,
1171                                                      )
1172                   };
1173
1174     } else {
1175
1176       foreach my $priority (
1177         $conf->config('ticket_system-custom_priority_field-values'), ''
1178       ) {
1179         last if scalar(@tickets) >= $num;
1180         push @tickets,
1181         @{ FS::TicketSystem->service_tickets( $self->svcnum,
1182                                               $num - scalar(@tickets),
1183                                               $priority,
1184                                               $status,
1185                                             )
1186          };
1187       }
1188     }
1189   }
1190   (@tickets);
1191 }
1192
1193 sub API_getinfo {
1194   my $self = shift;
1195   my $svc_x = $self->svc_x;
1196  +{ ( map { $_=>$self->$_ } $self->fields ),
1197     ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ),
1198   };
1199 }
1200
1201 =back
1202
1203 =head1 SUBROUTINES
1204
1205 =over 4
1206
1207 =item smart_search OPTION => VALUE ...
1208
1209 Accepts the option I<search>, the string to search for.  The string will
1210 be searched for as a username, email address, IP address, MAC address,
1211 phone number, and hardware serial number.  Unlike the I<smart_search> on
1212 customers, this always requires an exact match.
1213
1214 =cut
1215
1216 # though perhaps it should be fuzzy in some cases?
1217
1218 sub smart_search {
1219   my %param = __PACKAGE__->smart_search_param(@_);
1220   qsearch(\%param);
1221 }
1222
1223 sub smart_search_param {
1224   my $class = shift;
1225   my %opt = @_;
1226
1227   my $string = $opt{'search'};
1228   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1229
1230   my @or =
1231       map { my $table = $_;
1232             my $search_sql = "FS::$table"->search_sql($string);
1233             my $addl_from = "FS::$table"->search_sql_addl_from();
1234
1235             "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1236             "FROM $table $addl_from WHERE $search_sql";
1237           }
1238       FS::part_svc->svc_tables;
1239
1240   if ( $string =~ /^(\d+)$/ ) {
1241     unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1242   }
1243
1244   my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1245                   " ON (svc_all.svcnum = cust_svc.svcnum) ";
1246
1247   my @extra_sql;
1248
1249   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1250     'null_right' => 'View/link unlinked services'
1251   );
1252   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1253   #for agentnum
1254   $addl_from  .=  ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
1255                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1256                   ' LEFT JOIN part_svc  USING ( svcpart )';
1257
1258   (
1259     'table'     => 'cust_svc',
1260     'select'    => 'svc_all.svcnum AS svcnum, '.
1261                    'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1262                    'cust_svc.*',
1263     'addl_from' => $addl_from,
1264     'hashref'   => {},
1265     'extra_sql' => $extra_sql,
1266   );
1267 }
1268
1269 # If the associated cust_pkg is 'on hold'
1270 # and the associated pkg_svc has the provision_hold flag
1271 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1272 # then removes hold from pkg
1273 # returns $error or '' on success,
1274 # does not indicate if pkg status was changed
1275 sub _check_provision_hold {
1276   my $self = shift;
1277
1278   # check status of cust_pkg
1279   my $cust_pkg = $self->cust_pkg;
1280   return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1281
1282   # check flag on this svc
1283   # small false laziness with $self->pkg_svc
1284   # to avoid looking up cust_pkg twice
1285   my $pkg_svc  = qsearchs( 'pkg_svc', {
1286     'svcpart' => $self->svcpart,
1287     'pkgpart' => $cust_pkg->pkgpart,
1288   });
1289   return '' unless $pkg_svc->provision_hold;
1290
1291   # check for any others available with that flag
1292   return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1293
1294   # conditions met, remove hold
1295   return $cust_pkg->unsuspend;
1296 }
1297
1298 sub _upgrade_data {
1299   my $class = shift;
1300
1301   # fix missing (deleted by mistake) svc_x records
1302   warn "searching for missing svc_x records...\n";
1303   my %search = (
1304     'table'     => 'cust_svc',
1305     'select'    => 'cust_svc.*',
1306     'addl_from' => ' LEFT JOIN ( ' .
1307       join(' UNION ',
1308         map { "SELECT svcnum FROM $_" }
1309         FS::part_svc->svc_tables
1310       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1311     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1312   );
1313   my @svcs = qsearch(\%search);
1314   warn "found ".scalar(@svcs)."\n";
1315
1316   local $FS::Record::nowarn_classload = 1; # for h_svc_
1317   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1318
1319   my %h_search = (
1320     'hashref'  => { history_action => 'delete' },
1321     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1322   );
1323   foreach my $cust_svc (@svcs) {
1324     my $svcnum = $cust_svc->svcnum;
1325     my $svcdb = $cust_svc->part_svc->svcdb;
1326     $h_search{'hashref'}{'svcnum'} = $svcnum;
1327     $h_search{'table'} = "h_$svcdb";
1328     my $h_svc_x = qsearchs(\%h_search);
1329     if ( $h_svc_x ) {
1330       my $class = "FS::$svcdb";
1331       my $new_svc_x = $class->new({ $h_svc_x->hash });
1332       my $error = $new_svc_x->insert;
1333       warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1334         if $error;
1335     } else {
1336       # can't be fixed, so remove the dangling cust_svc to avoid breaking
1337       # stuff
1338       my $error = $cust_svc->delete;
1339       warn "error cleaning up missing svcnum $svcnum ($svcdb):\n$error\n";
1340     }
1341   }
1342
1343   '';
1344 }
1345
1346 =back
1347
1348 =head1 BUGS
1349
1350 Behaviour of changing the svcpart of cust_svc records is undefined and should
1351 possibly be prohibited, and pkg_svc records are not checked.
1352
1353 pkg_svc records are not checked in general (here).
1354
1355 Deleting this record doesn't check or delete the svc_* record associated
1356 with this record.
1357
1358 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1359 a DBI database handle is not yet implemented.
1360
1361 =head1 SEE ALSO
1362
1363 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1364 schema.html from the base documentation
1365
1366 =cut
1367
1368 1;
1369