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