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