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