FS/FS/cust_svc.pm

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