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