FS/FS/cust_svc.pm

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