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