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
 592
 593 Returns a list consisting of:
 594 - The name of this service (from part_svc)
 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
 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 $svc_x = $self->svc_x
 617     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 618
 619   $self->$method($svc_x);
 620 }
 621
 622 sub svc_label      { shift->_svc_label('label',      @_); }
 623 sub svc_label_long { shift->_svc_label('label_long', @_); }
 624
 625 sub _svc_label {
 626   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 627
 628   (
 629     $self->part_svc->svc,
 630     $svc_x->$method(@_),
 631     $self->part_svc->svcdb,
 632     $self->svcnum
 633   );
 634
 635 }
 636
 637 =item export_links
 638
 639 Returns a listref of html elements associated with this service's exports.
 640
 641 =cut
 642
 643 sub export_links {
 644   my $self = shift;
 645   my $svc_x = $self->svc_x
 646     or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
 647
 648   $svc_x->export_links;
 649 }
 650
 651 =item export_getsettings
 652
 653 Returns two hashrefs of settings associated with this service's exports.
 654
 655 =cut
 656
 657 sub export_getsettings {
 658   my $self = shift;
 659   my $svc_x = $self->svc_x
 660     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 661
 662   $svc_x->export_getsettings;
 663 }
 664
 665
 666 =item svc_x
 667
 668 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 669 FS::svc_domain object, etc.)
 670
 671 =cut
 672
 673 sub svc_x {
 674   my $self = shift;
 675   my $svcdb = $self->part_svc->svcdb;
 676   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 677     $self->{'_svc_acct'};
 678   } else {
 679     require "FS/$svcdb.pm";
 680     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 681          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 682       if $DEBUG;
 683     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 684   }
 685 }
 686
 687 =item seconds_since TIMESTAMP
 688
 689 See L<FS::svc_acct/seconds_since>.  Equivalent to
 690 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 691 where B<svcdb> is not "svc_acct".
 692
 693 =cut
 694
 695 #internal session db deprecated (or at least on hold)
 696 sub seconds_since { 'internal session db deprecated'; };
 697 ##note: implementation here, POD in FS::svc_acct
 698 #sub seconds_since {
 699 #  my($self, $since) = @_;
 700 #  my $dbh = dbh;
 701 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 702 #                              WHERE svcnum = ?
 703 #                                AND login >= ?
 704 #                                AND logout IS NOT NULL'
 705 #  ) or die $dbh->errstr;
 706 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 707 #  $sth->fetchrow_arrayref->[0];
 708 #}
 709
 710 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 711
 712 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 713 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 714 for records where B<svcdb> is not "svc_acct".
 715
 716 =cut
 717
 718 #note: implementation here, POD in FS::svc_acct
 719 sub seconds_since_sqlradacct {
 720   my($self, $start, $end) = @_;
 721
 722   my $mes = "$me seconds_since_sqlradacct:";
 723
 724   my $svc_x = $self->svc_x;
 725
 726   my @part_export = $self->part_svc->part_export_usage;
 727   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 728       " service definition"
 729     unless @part_export;
 730     #or return undef;
 731
 732   my $seconds = 0;
 733   foreach my $part_export ( @part_export ) {
 734
 735     next if $part_export->option('ignore_accounting');
 736
 737     warn "$mes connecting to sqlradius database\n"
 738       if $DEBUG;
 739
 740     my $dbh = DBI->connect( map { $part_export->option($_) }
 741                             qw(datasrc username password)    )
 742       or die "can't connect to sqlradius database: ". $DBI::errstr;
 743
 744     warn "$mes connected to sqlradius database\n"
 745       if $DEBUG;
 746
 747     #select a unix time conversion function based on database type
 748     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 749     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 750
 751     my $username = $part_export->export_username($svc_x);
 752
 753     my $query;
 754
 755     warn "$mes finding closed sessions completely within the given range\n"
 756       if $DEBUG;
 757
 758     my $realm = '';
 759     my $realmparam = '';
 760     if ($part_export->option('process_single_realm')) {
 761       $realm = 'AND Realm = ?';
 762       $realmparam = $part_export->option('realm');
 763     }
 764
 765     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 766                                FROM radacct
 767                                WHERE UserName = ?
 768                                  $realm
 769                                  AND $str2time AcctStartTime $closing >= ?
 770                                  AND $str2time AcctStopTime  $closing <  ?
 771                                  AND $str2time AcctStopTime  $closing > 0
 772                                  AND AcctStopTime IS NOT NULL"
 773     ) or die $dbh->errstr;
 774     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 775       or die $sth->errstr;
 776     my $regular = $sth->fetchrow_arrayref->[0];
 777
 778     warn "$mes finding open sessions which start in the range\n"
 779       if $DEBUG;
 780
 781     # count session start->range end
 782     $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
 783                 FROM radacct
 784                 WHERE UserName = ?
 785                   $realm
 786                   AND $str2time AcctStartTime $closing >= ?
 787                   AND $str2time AcctStartTime $closing <  ?
 788                   AND ( ? - $str2time AcctStartTime $closing ) < 86400
 789                   AND (    $str2time AcctStopTime $closing = 0
 790                                     OR AcctStopTime IS NULL )";
 791     $sth = $dbh->prepare($query) or die $dbh->errstr;
 792     $sth->execute( $end,
 793                    $username,
 794                    ($realm ? $realmparam : ()),
 795                    $start,
 796                    $end,
 797                    $end )
 798       or die $sth->errstr. " executing query $query";
 799     my $start_during = $sth->fetchrow_arrayref->[0];
 800
 801     warn "$mes finding closed sessions which start before the range but stop during\n"
 802       if $DEBUG;
 803
 804     #count range start->session end
 805     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
 806                             FROM radacct
 807                             WHERE UserName = ?
 808                               $realm
 809                               AND $str2time AcctStartTime $closing < ?
 810                               AND $str2time AcctStopTime  $closing >= ?
 811                               AND $str2time AcctStopTime  $closing <  ?
 812                               AND $str2time AcctStopTime  $closing > 0
 813                               AND AcctStopTime IS NOT NULL"
 814     ) or die $dbh->errstr;
 815     $sth->execute( $start,
 816                    $username,
 817                    ($realm ? $realmparam : ()),
 818                    $start,
 819                    $start,
 820                    $end )
 821       or die $sth->errstr;
 822     my $end_during = $sth->fetchrow_arrayref->[0];
 823
 824     warn "$mes finding closed sessions which start before the range but stop after\n"
 825       if $DEBUG;
 826
 827     # count range start->range end
 828     # don't count open sessions anymore (probably missing stop record)
 829     $sth = $dbh->prepare("SELECT COUNT(*)
 830                             FROM radacct
 831                             WHERE UserName = ?
 832                               $realm
 833                               AND $str2time AcctStartTime $closing < ?
 834                               AND ( $str2time AcctStopTime $closing >= ?
 835                                                                   )"
 836                               #      OR AcctStopTime =  0
 837                               #      OR AcctStopTime IS NULL       )"
 838     ) or die $dbh->errstr;
 839     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 840       or die $sth->errstr;
 841     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 842
 843     $seconds += $regular + $end_during + $start_during + $entire_range;
 844
 845     warn "$mes done finding sessions\n"
 846       if $DEBUG;
 847
 848   }
 849
 850   $seconds;
 851
 852 }
 853
 854 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 855
 856 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 857 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 858 for records where B<svcdb> is not "svc_acct".
 859
 860 =cut
 861
 862 #note: implementation here, POD in FS::svc_acct
 863 #(false laziness w/seconds_since_sqlradacct above)
 864 sub attribute_since_sqlradacct {
 865   my($self, $start, $end, $attrib) = @_;
 866
 867   my $mes = "$me attribute_since_sqlradacct:";
 868
 869   my $svc_x = $self->svc_x;
 870
 871   my @part_export = $self->part_svc->part_export_usage;
 872   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 873       " service definition"
 874     unless @part_export;
 875     #or return undef;
 876
 877   my $sum = 0;
 878
 879   foreach my $part_export ( @part_export ) {
 880
 881     next if $part_export->option('ignore_accounting');
 882
 883     warn "$mes connecting to sqlradius database\n"
 884       if $DEBUG;
 885
 886     my $dbh = DBI->connect( map { $part_export->option($_) }
 887                             qw(datasrc username password)    )
 888       or die "can't connect to sqlradius database: ". $DBI::errstr;
 889
 890     warn "$mes connected to sqlradius database\n"
 891       if $DEBUG;
 892
 893     #select a unix time conversion function based on database type
 894     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 895     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 896
 897     my $username = $part_export->export_username($svc_x);
 898
 899     warn "$mes SUMing $attrib sessions\n"
 900       if $DEBUG;
 901
 902     my $realm = '';
 903     my $realmparam = '';
 904     if ($part_export->option('process_single_realm')) {
 905       $realm = 'AND Realm = ?';
 906       $realmparam = $part_export->option('realm');
 907     }
 908
 909     my $sth = $dbh->prepare("SELECT SUM($attrib)
 910                                FROM radacct
 911                                WHERE UserName = ?
 912                                  $realm
 913                                  AND $str2time AcctStopTime $closing >= ?
 914                                  AND $str2time AcctStopTime $closing <  ?
 915                                  AND AcctStopTime IS NOT NULL"
 916     ) or die $dbh->errstr;
 917     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 918       or die $sth->errstr;
 919
 920     my $row = $sth->fetchrow_arrayref;
 921     $sum += $row->[0] if defined($row->[0]);
 922
 923     warn "$mes done SUMing sessions\n"
 924       if $DEBUG;
 925
 926   }
 927
 928   $sum;
 929
 930 }
 931
 932 #note: implementation here, POD in FS::svc_acct
 933 # false laziness w/above
 934 sub attribute_last_sqlradacct {
 935   my($self, $attrib) = @_;
 936
 937   my $mes = "$me attribute_last_sqlradacct:";
 938
 939   my $svc_x = $self->svc_x;
 940
 941   my @part_export = $self->part_svc->part_export_usage;
 942   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 943       " service definition"
 944     unless @part_export;
 945     #or return undef;
 946
 947   my $value = '';
 948   my $AcctStartTime = 0;
 949
 950   foreach my $part_export ( @part_export ) {
 951
 952     next if $part_export->option('ignore_accounting');
 953
 954     warn "$mes connecting to sqlradius database\n"
 955       if $DEBUG;
 956
 957     my $dbh = DBI->connect( map { $part_export->option($_) }
 958                             qw(datasrc username password)    )
 959       or die "can't connect to sqlradius database: ". $DBI::errstr;
 960
 961     warn "$mes connected to sqlradius database\n"
 962       if $DEBUG;
 963
 964     #select a unix time conversion function based on database type
 965     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 966     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 967
 968     my $username = $part_export->export_username($svc_x);
 969
 970     warn "$mes finding most-recent $attrib\n"
 971       if $DEBUG;
 972
 973     my $realm = '';
 974     my $realmparam = '';
 975     if ($part_export->option('process_single_realm')) {
 976       $realm = 'AND Realm = ?';
 977       $realmparam = $part_export->option('realm');
 978     }
 979
 980     my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
 981                                FROM radacct
 982                                WHERE UserName = ?
 983                                  $realm
 984                                ORDER BY AcctStartTime DESC LIMIT 1
 985     ") or die $dbh->errstr;
 986     $sth->execute($username, ($realm ? $realmparam : ()) )
 987       or die $sth->errstr;
 988
 989     my $row = $sth->fetchrow_arrayref;
 990     if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
 991       $value = $row->[0];
 992       $AcctStartTime = $row->[1];
 993     }
 994
 995     warn "$mes done\n"
 996       if $DEBUG;
 997
 998   }
 999
1000   $value;
1001
1002 }
1003
1004 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1005
1006 See L<FS::svc_acct/get_session_history>.  Equivalent to
1007 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
1008 records where B<svcdb> is not "svc_acct".
1009
1010 =cut
1011
1012 sub get_session_history {
1013   my($self, $start, $end, $attrib) = @_;
1014
1015   #$attrib ???
1016
1017   my @part_export = $self->part_svc->part_export_usage;
1018   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1019       " service definition"
1020     unless @part_export;
1021     #or return undef;
1022
1023   my @sessions = ();
1024
1025   foreach my $part_export ( @part_export ) {
1026     push @sessions,
1027       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1028   }
1029
1030   @sessions;
1031
1032 }
1033
1034 =item tickets  [ STATUS ]
1035
1036 Returns an array of hashes representing the tickets linked to this service.
1037
1038 An optional status (or arrayref or hashref of statuses) may be specified.
1039
1040 =cut
1041
1042 sub tickets {
1043   my $self = shift;
1044   my $status = ( @_ && $_[0] ) ? shift : '';
1045
1046   my $conf = FS::Conf->new;
1047   my $num = $conf->config('cust_main-max_tickets') || 10;
1048   my @tickets = ();
1049
1050   if ( $conf->config('ticket_system') ) {
1051     unless ( $conf->config('ticket_system-custom_priority_field') ) {
1052
1053       @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1054                                                        $num,
1055                                                        undef,
1056                                                        $status,
1057                                                      )
1058                   };
1059
1060     } else {
1061
1062       foreach my $priority (
1063         $conf->config('ticket_system-custom_priority_field-values'), ''
1064       ) {
1065         last if scalar(@tickets) >= $num;
1066         push @tickets,
1067         @{ FS::TicketSystem->service_tickets( $self->svcnum,
1068                                               $num - scalar(@tickets),
1069                                               $priority,
1070                                               $status,
1071                                             )
1072          };
1073       }
1074     }
1075   }
1076   (@tickets);
1077 }
1078
1079
1080 =back
1081
1082 =head1 SUBROUTINES
1083
1084 =over 4
1085
1086 =item smart_search OPTION => VALUE ...
1087
1088 Accepts the option I<search>, the string to search for.  The string will
1089 be searched for as a username, email address, IP address, MAC address,
1090 phone number, and hardware serial number.  Unlike the I<smart_search> on
1091 customers, this always requires an exact match.
1092
1093 =cut
1094
1095 # though perhaps it should be fuzzy in some cases?
1096
1097 sub smart_search {
1098   my %param = __PACKAGE__->smart_search_param(@_);
1099   qsearch(\%param);
1100 }
1101
1102 sub smart_search_param {
1103   my $class = shift;
1104   my %opt = @_;
1105
1106   my $string = $opt{'search'};
1107   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1108
1109   my @or =
1110       map { my $table = $_;
1111             my $search_sql = "FS::$table"->search_sql($string);
1112             my $addl_from = "FS::$table"->search_sql_addl_from();
1113
1114             "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1115             "FROM $table $addl_from WHERE $search_sql";
1116           }
1117       FS::part_svc->svc_tables;
1118
1119   if ( $string =~ /^(\d+)$/ ) {
1120     unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1121   }
1122
1123   my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1124                   " ON (svc_all.svcnum = cust_svc.svcnum) ";
1125
1126   my @extra_sql;
1127
1128   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1129     'null_right' => 'View/link unlinked services'
1130   );
1131   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1132   #for agentnum
1133   $addl_from  .=  ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
1134                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1135                   ' LEFT JOIN part_svc  USING ( svcpart )';
1136
1137   (
1138     'table'     => 'cust_svc',
1139     'select'    => 'svc_all.svcnum AS svcnum, '.
1140                    'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1141                    'cust_svc.*',
1142     'addl_from' => $addl_from,
1143     'hashref'   => {},
1144     'extra_sql' => $extra_sql,
1145   );
1146 }
1147
1148 # If the associated cust_pkg is 'on hold'
1149 # and the associated pkg_svc has the provision_hold flag
1150 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1151 # then removes hold from pkg
1152 # returns $error or '' on success,
1153 # does not indicate if pkg status was changed
1154 sub _check_provision_hold {
1155   my $self = shift;
1156
1157   # check status of cust_pkg
1158   my $cust_pkg = $self->cust_pkg;
1159   return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1160
1161   # check flag on this svc
1162   # small false laziness with $self->pkg_svc
1163   # to avoid looking up cust_pkg twice
1164   my $pkg_svc  = qsearchs( 'pkg_svc', {
1165     'svcpart' => $self->svcpart,
1166     'pkgpart' => $cust_pkg->pkgpart,
1167   });
1168   return '' unless $pkg_svc->provision_hold;
1169
1170   # check for any others available with that flag
1171   return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1172
1173   # conditions met, remove hold
1174   return $cust_pkg->unsuspend;
1175 }
1176
1177 sub _upgrade_data {
1178   my $class = shift;
1179
1180   # fix missing (deleted by mistake) svc_x records
1181   warn "searching for missing svc_x records...\n";
1182   my %search = (
1183     'table'     => 'cust_svc',
1184     'select'    => 'cust_svc.*',
1185     'addl_from' => ' LEFT JOIN ( ' .
1186       join(' UNION ',
1187         map { "SELECT svcnum FROM $_" }
1188         FS::part_svc->svc_tables
1189       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1190     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1191   );
1192   my @svcs = qsearch(\%search);
1193   warn "found ".scalar(@svcs)."\n";
1194
1195   local $FS::Record::nowarn_classload = 1; # for h_svc_
1196   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1197
1198   my %h_search = (
1199     'hashref'  => { history_action => 'delete' },
1200     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1201   );
1202   foreach my $cust_svc (@svcs) {
1203     my $svcnum = $cust_svc->svcnum;
1204     my $svcdb = $cust_svc->part_svc->svcdb;
1205     $h_search{'hashref'}{'svcnum'} = $svcnum;
1206     $h_search{'table'} = "h_$svcdb";
1207     my $h_svc_x = qsearchs(\%h_search)
1208       or next;
1209     my $class = "FS::$svcdb";
1210     my $new_svc_x = $class->new({ $h_svc_x->hash });
1211     my $error = $new_svc_x->insert;
1212     warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1213       if $error;
1214   }
1215
1216   '';
1217 }
1218
1219 =back
1220
1221 =head1 BUGS
1222
1223 Behaviour of changing the svcpart of cust_svc records is undefined and should
1224 possibly be prohibited, and pkg_svc records are not checked.
1225
1226 pkg_svc records are not checked in general (here).
1227
1228 Deleting this record doesn't check or delete the svc_* record associated
1229 with this record.
1230
1231 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1232 a DBI database handle is not yet implemented.
1233
1234 =head1 SEE ALSO
1235
1236 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1237 schema.html from the base documentation
1238
1239 =cut
1240
1241 1;
1242