FS/FS/cust_svc.pm

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