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