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
 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   #check if this releases a hold (see FS::pkg_svc provision_hold)
 432   $error ||= $new->_check_provision_hold;
 433
 434   if ( $error ) {
 435     $dbh->rollback if $oldAutoCommit;
 436     return $error if $error
 437   }
 438
 439   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 440   ''; #no error
 441
 442 }
 443
 444 =item check
 445
 446 Checks all fields to make sure this is a valid service.  If there is an error,
 447 returns the error, otherwise returns false.  Called by the insert and
 448 replace methods.
 449
 450 =cut
 451
 452 sub check {
 453   my $self = shift;
 454
 455   my $error =
 456     $self->ut_numbern('svcnum')
 457     || $self->ut_numbern('pkgnum')
 458     || $self->ut_number('svcpart')
 459     || $self->ut_numbern('agent_svcid')
 460     || $self->ut_numbern('overlimit')
 461   ;
 462   return $error if $error;
 463
 464   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 465   return "Unknown svcpart" unless $part_svc;
 466
 467   if ( $self->pkgnum && ! $ignore_quantity ) {
 468
 469     #slightly inefficient since ->pkg_svc will also look it up, but fixing
 470     # a much larger perf problem and have bigger fish to fry
 471     my $cust_pkg = $self->cust_pkg;
 472
 473     my $pkg_svc = $self->pkg_svc
 474                     || new FS::pkg_svc { 'svcpart'  => $self->svcpart,
 475                                          'pkgpart'  => $cust_pkg->pkgpart,
 476                                          'quantity' => 0,
 477                                        };
 478
 479     #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
 480     foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
 481       my $addon_pkg_svc = qsearchs('pkg_svc', {
 482                             pkgpart => $part_pkg_link->dst_pkgpart,
 483                             svcpart => $self->svcpart,
 484                           });
 485       $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
 486         if $addon_pkg_svc;
 487     }
 488
 489    #better error message?  UI shouldn't get here
 490    return "No svcpart ". $self->svcpart.
 491           " services in pkgpart ". $cust_pkg->pkgpart
 492      unless $pkg_svc->quantity > 0;
 493
 494     my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
 495
 496     #false laziness w/cust_pkg->part_svc
 497     my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
 498                             - $num_cust_svc
 499                        );
 500
 501    #better error message?  again, UI shouldn't get here
 502     return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
 503            " services for pkgnum ". $self->pkgnum
 504       if $num_avail <= 0;
 505
 506   }
 507
 508   $self->SUPER::check;
 509 }
 510
 511 =item display_svcnum
 512
 513 Returns the displayed service number for this service: agent_svcid if it has a
 514 value, svcnum otherwise
 515
 516 =cut
 517
 518 sub display_svcnum {
 519   my $self = shift;
 520   $self->agent_svcid || $self->svcnum;
 521 }
 522
 523 =item part_svc
 524
 525 Returns the definition for this service, as a FS::part_svc object (see
 526 L<FS::part_svc>).
 527
 528 =cut
 529
 530 sub part_svc {
 531   my $self = shift;
 532   return $self->{_svcpart} if $self->{_svcpart};
 533   cluck 'cust_svc->part_svc called' if $DEBUG;
 534   qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 535 }
 536
 537 =item cust_pkg
 538
 539 Returns the package this service belongs to, as a FS::cust_pkg object (see
 540 L<FS::cust_pkg>).
 541
 542 =cut
 543
 544 sub cust_pkg {
 545   my $self = shift;
 546   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 547 }
 548
 549 =item pkg_svc
 550
 551 Returns the pkg_svc record for for this service, if applicable.
 552
 553 =cut
 554
 555 sub pkg_svc {
 556   my $self = shift;
 557   my $cust_pkg = $self->cust_pkg;
 558   return undef unless $cust_pkg;
 559
 560   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 561                          'pkgpart' => $cust_pkg->pkgpart,
 562                        }
 563           );
 564 }
 565
 566 =item date_inserted
 567
 568 Returns the date this service was inserted.
 569
 570 =cut
 571
 572 sub date_inserted {
 573   my $self = shift;
 574   $self->h_date('insert');
 575 }
 576
 577 =item pkg_cancel_date
 578
 579 Returns the date this service's package was canceled.  This normally only
 580 exists for a service that's been preserved through cancellation with the
 581 part_pkg.preserve flag.
 582
 583 =cut
 584
 585 sub pkg_cancel_date {
 586   my $self = shift;
 587   my $cust_pkg = $self->cust_pkg or return;
 588   return $cust_pkg->getfield('cancel') || '';
 589 }
 590
 591 =item label [ LOCALE ]
 592
 593 Returns a list consisting of:
 594 - The name of this service (from part_svc), optionally localized
 595 - A meaningful identifier (username, domain, or mail alias)
 596 - The table name (i.e. svc_domain) for this service
 597 - svcnum
 598
 599 Usage example:
 600
 601   my($label, $value, $svcdb) = $cust_svc->label;
 602
 603 =item label_long [ LOCALE ]
 604
 605 Like the B<label> method, except the second item in the list ("meaningful
 606 identifier") may be longer - typically, a full name is included.
 607
 608 =cut
 609
 610 sub label      { shift->_label('svc_label',      @_); }
 611 sub label_long { shift->_label('svc_label_long', @_); }
 612
 613 sub _label {
 614   my $self = shift;
 615   my $method = shift;
 616   my $locale = shift;
 617   my $svc_x = $self->svc_x
 618     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 619
 620   $self->$method($svc_x, undef, undef, $locale);
 621 }
 622
 623 # svc_label(_long) takes three arguments: end date, start date, locale
 624 # and FS::svc_*::label methods must accept those also, if they even care
 625
 626 sub svc_label      { shift->_svc_label('label',      @_); }
 627 sub svc_label_long { shift->_svc_label('label_long', @_); }
 628
 629 sub _svc_label {
 630   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 631   my ($end, $start, $locale) = @_;
 632
 633   (
 634     $self->part_svc->svc_locale($locale),
 635     $svc_x->$method(@_),
 636     $self->part_svc->svcdb,
 637     $self->svcnum
 638   );
 639
 640 }
 641
 642 =item export_links
 643
 644 Returns a listref of html elements associated with this service's exports.
 645
 646 =cut
 647
 648 sub export_links {
 649   my $self = shift;
 650   my $svc_x = $self->svc_x
 651     or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
 652
 653   $svc_x->export_links;
 654 }
 655
 656 =item export_getsettings
 657
 658 Returns two hashrefs of settings associated with this service's exports.
 659
 660 =cut
 661
 662 sub export_getsettings {
 663   my $self = shift;
 664   my $svc_x = $self->svc_x
 665     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 666
 667   $svc_x->export_getsettings;
 668 }
 669
 670
 671 =item svc_x
 672
 673 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 674 FS::svc_domain object, etc.)
 675
 676 =cut
 677
 678 sub svc_x {
 679   my $self = shift;
 680   my $svcdb = $self->part_svc->svcdb;
 681   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 682     $self->{'_svc_acct'};
 683   } else {
 684     require "FS/$svcdb.pm";
 685     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 686          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 687       if $DEBUG;
 688     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 689   }
 690 }
 691
 692 =item seconds_since TIMESTAMP
 693
 694 See L<FS::svc_acct/seconds_since>.  Equivalent to
 695 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 696 where B<svcdb> is not "svc_acct".
 697
 698 =cut
 699
 700 #internal session db deprecated (or at least on hold)
 701 sub seconds_since { 'internal session db deprecated'; };
 702 ##note: implementation here, POD in FS::svc_acct
 703 #sub seconds_since {
 704 #  my($self, $since) = @_;
 705 #  my $dbh = dbh;
 706 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 707 #                              WHERE svcnum = ?
 708 #                                AND login >= ?
 709 #                                AND logout IS NOT NULL'
 710 #  ) or die $dbh->errstr;
 711 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 712 #  $sth->fetchrow_arrayref->[0];
 713 #}
 714
 715 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 716
 717 Equivalent to $cust_svc->svc_x->seconds_since_sqlradacct, but
 718 more efficient.  Meaningless for records where B<svcdb> is not
 719 svc_acct or svc_broadband.
 720
 721 =cut
 722
 723 sub seconds_since_sqlradacct {
 724   my($self, $start, $end) = @_;
 725
 726   my $mes = "$me seconds_since_sqlradacct:";
 727
 728   my $svc_x = $self->svc_x;
 729
 730   my @part_export = $self->part_svc->part_export_usage;
 731   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 732       " service definition"
 733     unless @part_export;
 734     #or return undef;
 735
 736   my $seconds = 0;
 737   foreach my $part_export ( @part_export ) {
 738
 739     next if $part_export->option('ignore_accounting');
 740
 741     warn "$mes connecting to sqlradius database\n"
 742       if $DEBUG;
 743
 744     my $dbh = DBI->connect( map { $part_export->option($_) }
 745                             qw(datasrc username password)    )
 746       or die "can't connect to sqlradius database: ". $DBI::errstr;
 747
 748     warn "$mes connected to sqlradius database\n"
 749       if $DEBUG;
 750
 751     #select a unix time conversion function based on database type
 752     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 753     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 754
 755     my $username = $part_export->export_username($svc_x);
 756
 757     my $query;
 758
 759     warn "$mes finding closed sessions completely within the given range\n"
 760       if $DEBUG;
 761
 762     my $realm = '';
 763     my $realmparam = '';
 764     if ($part_export->option('process_single_realm')) {
 765       $realm = 'AND Realm = ?';
 766       $realmparam = $part_export->option('realm');
 767     }
 768
 769     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 770                                FROM radacct
 771                                WHERE UserName = ?
 772                                  $realm
 773                                  AND $str2time AcctStartTime $closing >= ?
 774                                  AND $str2time AcctStopTime  $closing <  ?
 775                                  AND $str2time AcctStopTime  $closing > 0
 776                                  AND AcctStopTime IS NOT NULL"
 777     ) or die $dbh->errstr;
 778     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 779       or die $sth->errstr;
 780     my $regular = $sth->fetchrow_arrayref->[0];
 781
 782     warn "$mes finding open sessions which start in the range\n"
 783       if $DEBUG;
 784
 785     # count session start->range end
 786     $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
 787                 FROM radacct
 788                 WHERE UserName = ?
 789                   $realm
 790                   AND $str2time AcctStartTime $closing >= ?
 791                   AND $str2time AcctStartTime $closing <  ?
 792                   AND ( ? - $str2time AcctStartTime $closing ) < 86400
 793                   AND (    $str2time AcctStopTime $closing = 0
 794                                     OR AcctStopTime IS NULL )";
 795     $sth = $dbh->prepare($query) or die $dbh->errstr;
 796     $sth->execute( $end,
 797                    $username,
 798                    ($realm ? $realmparam : ()),
 799                    $start,
 800                    $end,
 801                    $end )
 802       or die $sth->errstr. " executing query $query";
 803     my $start_during = $sth->fetchrow_arrayref->[0];
 804
 805     warn "$mes finding closed sessions which start before the range but stop during\n"
 806       if $DEBUG;
 807
 808     #count range start->session end
 809     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
 810                             FROM radacct
 811                             WHERE UserName = ?
 812                               $realm
 813                               AND $str2time AcctStartTime $closing < ?
 814                               AND $str2time AcctStopTime  $closing >= ?
 815                               AND $str2time AcctStopTime  $closing <  ?
 816                               AND $str2time AcctStopTime  $closing > 0
 817                               AND AcctStopTime IS NOT NULL"
 818     ) or die $dbh->errstr;
 819     $sth->execute( $start,
 820                    $username,
 821                    ($realm ? $realmparam : ()),
 822                    $start,
 823                    $start,
 824                    $end )
 825       or die $sth->errstr;
 826     my $end_during = $sth->fetchrow_arrayref->[0];
 827
 828     warn "$mes finding closed sessions which start before the range but stop after\n"
 829       if $DEBUG;
 830
 831     # count range start->range end
 832     # don't count open sessions anymore (probably missing stop record)
 833     $sth = $dbh->prepare("SELECT COUNT(*)
 834                             FROM radacct
 835                             WHERE UserName = ?
 836                               $realm
 837                               AND $str2time AcctStartTime $closing < ?
 838                               AND ( $str2time AcctStopTime $closing >= ?
 839                                                                   )"
 840                               #      OR AcctStopTime =  0
 841                               #      OR AcctStopTime IS NULL       )"
 842     ) or die $dbh->errstr;
 843     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 844       or die $sth->errstr;
 845     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 846
 847     $seconds += $regular + $end_during + $start_during + $entire_range;
 848
 849     warn "$mes done finding sessions\n"
 850       if $DEBUG;
 851
 852   }
 853
 854   $seconds;
 855
 856 }
 857
 858 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 859
 860 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 861 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.
 862 Meaningless for records where B<svcdb> is not svc_acct or svc_broadband.
 863
 864 =cut
 865
 866 #(false laziness w/seconds_since_sqlradacct above)
 867 sub attribute_since_sqlradacct {
 868   my($self, $start, $end, $attrib) = @_;
 869
 870   my $mes = "$me attribute_since_sqlradacct:";
 871
 872   my $svc_x = $self->svc_x;
 873
 874   my @part_export = $self->part_svc->part_export_usage;
 875   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 876       " service definition"
 877     unless @part_export;
 878     #or return undef;
 879
 880   my $sum = 0;
 881
 882   foreach my $part_export ( @part_export ) {
 883
 884     next if $part_export->option('ignore_accounting');
 885
 886     warn "$mes connecting to sqlradius database\n"
 887       if $DEBUG;
 888
 889     my $dbh = DBI->connect( map { $part_export->option($_) }
 890                             qw(datasrc username password)    )
 891       or die "can't connect to sqlradius database: ". $DBI::errstr;
 892
 893     warn "$mes connected to sqlradius database\n"
 894       if $DEBUG;
 895
 896     #select a unix time conversion function based on database type
 897     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 898     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 899
 900     my $username = $part_export->export_username($svc_x);
 901
 902     warn "$mes SUMing $attrib sessions\n"
 903       if $DEBUG;
 904
 905     my $realm = '';
 906     my $realmparam = '';
 907     if ($part_export->option('process_single_realm')) {
 908       $realm = 'AND Realm = ?';
 909       $realmparam = $part_export->option('realm');
 910     }
 911
 912     my $sth = $dbh->prepare("SELECT SUM($attrib)
 913                                FROM radacct
 914                                WHERE UserName = ?
 915                                  $realm
 916                                  AND $str2time AcctStopTime $closing >= ?
 917                                  AND $str2time AcctStopTime $closing <  ?
 918                                  AND AcctStopTime IS NOT NULL"
 919     ) or die $dbh->errstr;
 920     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 921       or die $sth->errstr;
 922
 923     my $row = $sth->fetchrow_arrayref;
 924     $sum += $row->[0] if defined($row->[0]);
 925
 926     warn "$mes done SUMing sessions\n"
 927       if $DEBUG;
 928
 929   }
 930
 931   $sum;
 932
 933 }
 934
 935 #note: implementation here, POD in FS::svc_acct
 936 # false laziness w/above
 937 sub attribute_last_sqlradacct {
 938   my($self, $attrib) = @_;
 939
 940   my $mes = "$me attribute_last_sqlradacct:";
 941
 942   my $svc_x = $self->svc_x;
 943
 944   my @part_export = $self->part_svc->part_export_usage;
 945   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 946       " service definition"
 947     unless @part_export;
 948     #or return undef;
 949
 950   my $value = '';
 951   my $AcctStartTime = 0;
 952
 953   foreach my $part_export ( @part_export ) {
 954
 955     next if $part_export->option('ignore_accounting');
 956
 957     warn "$mes connecting to sqlradius database\n"
 958       if $DEBUG;
 959
 960     my $dbh = DBI->connect( map { $part_export->option($_) }
 961                             qw(datasrc username password)    )
 962       or die "can't connect to sqlradius database: ". $DBI::errstr;
 963
 964     warn "$mes connected to sqlradius database\n"
 965       if $DEBUG;
 966
 967     #select a unix time conversion function based on database type
 968     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 969     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 970
 971     my $username = $part_export->export_username($svc_x);
 972
 973     warn "$mes finding most-recent $attrib\n"
 974       if $DEBUG;
 975
 976     my $realm = '';
 977     my $realmparam = '';
 978     if ($part_export->option('process_single_realm')) {
 979       $realm = 'AND Realm = ?';
 980       $realmparam = $part_export->option('realm');
 981     }
 982
 983     my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
 984                                FROM radacct
 985                                WHERE UserName = ?
 986                                  $realm
 987                                ORDER BY AcctStartTime DESC LIMIT 1
 988     ") or die $dbh->errstr;
 989     $sth->execute($username, ($realm ? $realmparam : ()) )
 990       or die $sth->errstr;
 991
 992     my $row = $sth->fetchrow_arrayref;
 993     if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
 994       $value = $row->[0];
 995       $AcctStartTime = $row->[1];
 996     }
 997
 998     warn "$mes done\n"
 999       if $DEBUG;
1000
1001   }
1002
1003   $value;
1004
1005 }
1006
1007 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1008
1009 See L<FS::svc_acct/get_session_history>.  Equivalent to
1010 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
1011 records where B<svcdb> is not "svc_acct".
1012
1013 =cut
1014
1015 sub get_session_history {
1016   my($self, $start, $end, $attrib) = @_;
1017
1018   #$attrib ???
1019
1020   my @part_export = $self->part_svc->part_export_usage;
1021   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1022       " service definition"
1023     unless @part_export;
1024     #or return undef;
1025
1026   my @sessions = ();
1027
1028   foreach my $part_export ( @part_export ) {
1029     push @sessions,
1030       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1031   }
1032
1033   @sessions;
1034
1035 }
1036
1037 =item tickets  [ STATUS ]
1038
1039 Returns an array of hashes representing the tickets linked to this service.
1040
1041 An optional status (or arrayref or hashref of statuses) may be specified.
1042
1043 =cut
1044
1045 sub tickets {
1046   my $self = shift;
1047   my $status = ( @_ && $_[0] ) ? shift : '';
1048
1049   my $conf = FS::Conf->new;
1050   my $num = $conf->config('cust_main-max_tickets') || 10;
1051   my @tickets = ();
1052
1053   if ( $conf->config('ticket_system') ) {
1054     unless ( $conf->config('ticket_system-custom_priority_field') ) {
1055
1056       @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1057                                                        $num,
1058                                                        undef,
1059                                                        $status,
1060                                                      )
1061                   };
1062
1063     } else {
1064
1065       foreach my $priority (
1066         $conf->config('ticket_system-custom_priority_field-values'), ''
1067       ) {
1068         last if scalar(@tickets) >= $num;
1069         push @tickets,
1070         @{ FS::TicketSystem->service_tickets( $self->svcnum,
1071                                               $num - scalar(@tickets),
1072                                               $priority,
1073                                               $status,
1074                                             )
1075          };
1076       }
1077     }
1078   }
1079   (@tickets);
1080 }
1081
1082 sub API_getinfo {
1083   my $self = shift;
1084   my $svc_x = $self->svc_x;
1085  +{ ( map { $_=>$self->$_ } $self->fields ),
1086     ( map { $_=>$svc_x->$_ } $svc_x->fields ),
1087   };
1088 }
1089
1090 =back
1091
1092 =head1 SUBROUTINES
1093
1094 =over 4
1095
1096 =item smart_search OPTION => VALUE ...
1097
1098 Accepts the option I<search>, the string to search for.  The string will
1099 be searched for as a username, email address, IP address, MAC address,
1100 phone number, and hardware serial number.  Unlike the I<smart_search> on
1101 customers, this always requires an exact match.
1102
1103 =cut
1104
1105 # though perhaps it should be fuzzy in some cases?
1106
1107 sub smart_search {
1108   my %param = __PACKAGE__->smart_search_param(@_);
1109   qsearch(\%param);
1110 }
1111
1112 sub smart_search_param {
1113   my $class = shift;
1114   my %opt = @_;
1115
1116   my $string = $opt{'search'};
1117   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1118
1119   my @or =
1120       map { my $table = $_;
1121             my $search_sql = "FS::$table"->search_sql($string);
1122             my $addl_from = "FS::$table"->search_sql_addl_from();
1123
1124             "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1125             "FROM $table $addl_from WHERE $search_sql";
1126           }
1127       FS::part_svc->svc_tables;
1128
1129   if ( $string =~ /^(\d+)$/ ) {
1130     unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1131   }
1132
1133   my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1134                   " ON (svc_all.svcnum = cust_svc.svcnum) ";
1135
1136   my @extra_sql;
1137
1138   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1139     'null_right' => 'View/link unlinked services'
1140   );
1141   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1142   #for agentnum
1143   $addl_from  .=  ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
1144                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1145                   ' LEFT JOIN part_svc  USING ( svcpart )';
1146
1147   (
1148     'table'     => 'cust_svc',
1149     'select'    => 'svc_all.svcnum AS svcnum, '.
1150                    'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1151                    'cust_svc.*',
1152     'addl_from' => $addl_from,
1153     'hashref'   => {},
1154     'extra_sql' => $extra_sql,
1155   );
1156 }
1157
1158 # If the associated cust_pkg is 'on hold'
1159 # and the associated pkg_svc has the provision_hold flag
1160 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1161 # then removes hold from pkg
1162 # returns $error or '' on success,
1163 # does not indicate if pkg status was changed
1164 sub _check_provision_hold {
1165   my $self = shift;
1166
1167   # check status of cust_pkg
1168   my $cust_pkg = $self->cust_pkg;
1169   return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1170
1171   # check flag on this svc
1172   # small false laziness with $self->pkg_svc
1173   # to avoid looking up cust_pkg twice
1174   my $pkg_svc  = qsearchs( 'pkg_svc', {
1175     'svcpart' => $self->svcpart,
1176     'pkgpart' => $cust_pkg->pkgpart,
1177   });
1178   return '' unless $pkg_svc->provision_hold;
1179
1180   # check for any others available with that flag
1181   return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1182
1183   # conditions met, remove hold
1184   return $cust_pkg->unsuspend;
1185 }
1186
1187 sub _upgrade_data {
1188   my $class = shift;
1189
1190   # fix missing (deleted by mistake) svc_x records
1191   warn "searching for missing svc_x records...\n";
1192   my %search = (
1193     'table'     => 'cust_svc',
1194     'select'    => 'cust_svc.*',
1195     'addl_from' => ' LEFT JOIN ( ' .
1196       join(' UNION ',
1197         map { "SELECT svcnum FROM $_" }
1198         FS::part_svc->svc_tables
1199       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1200     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1201   );
1202   my @svcs = qsearch(\%search);
1203   warn "found ".scalar(@svcs)."\n";
1204
1205   local $FS::Record::nowarn_classload = 1; # for h_svc_
1206   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1207
1208   my %h_search = (
1209     'hashref'  => { history_action => 'delete' },
1210     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1211   );
1212   foreach my $cust_svc (@svcs) {
1213     my $svcnum = $cust_svc->svcnum;
1214     my $svcdb = $cust_svc->part_svc->svcdb;
1215     $h_search{'hashref'}{'svcnum'} = $svcnum;
1216     $h_search{'table'} = "h_$svcdb";
1217     my $h_svc_x = qsearchs(\%h_search)
1218       or next;
1219     my $class = "FS::$svcdb";
1220     my $new_svc_x = $class->new({ $h_svc_x->hash });
1221     my $error = $new_svc_x->insert;
1222     warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1223       if $error;
1224   }
1225
1226   '';
1227 }
1228
1229 =back
1230
1231 =head1 BUGS
1232
1233 Behaviour of changing the svcpart of cust_svc records is undefined and should
1234 possibly be prohibited, and pkg_svc records are not checked.
1235
1236 pkg_svc records are not checked in general (here).
1237
1238 Deleting this record doesn't check or delete the svc_* record associated
1239 with this record.
1240
1241 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1242 a DBI database handle is not yet implemented.
1243
1244 =head1 SEE ALSO
1245
1246 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1247 schema.html from the base documentation
1248
1249 =cut
1250
1251 1;
1252