FS/FS/cust_svc.pm

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