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