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