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
 312     return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
 313            " services for pkgnum ". $self->pkgnum
 314       if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
 315   }
 316
 317   $self->SUPER::check;
 318 }
 319
 320 =item part_svc
 321
 322 Returns the definition for this service, as a FS::part_svc object (see
 323 L<FS::part_svc>).
 324
 325 =cut
 326
 327 sub part_svc {
 328   my $self = shift;
 329   $self->{'_svcpart'}
 330     ? $self->{'_svcpart'}
 331     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 332 }
 333
 334 =item cust_pkg
 335
 336 Returns the package this service belongs to, as a FS::cust_pkg object (see
 337 L<FS::cust_pkg>).
 338
 339 =cut
 340
 341 sub cust_pkg {
 342   my $self = shift;
 343   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 344 }
 345
 346 =item pkg_svc
 347
 348 Returns the pkg_svc record for for this service, if applicable.
 349
 350 =cut
 351
 352 sub pkg_svc {
 353   my $self = shift;
 354   my $cust_pkg = $self->cust_pkg;
 355   return undef unless $cust_pkg;
 356
 357   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 358                          'pkgpart' => $cust_pkg->pkgpart,
 359                        }
 360           );
 361 }
 362
 363 =item date_inserted
 364
 365 Returns the date this service was inserted.
 366
 367 =cut
 368
 369 sub date_inserted {
 370   my $self = shift;
 371   $self->h_date('insert');
 372 }
 373
 374 =item pkg_cancel_date
 375
 376 Returns the date this service's package was canceled.  This normally only
 377 exists for a service that's been preserved through cancellation with the
 378 part_pkg.preserve flag.
 379
 380 =cut
 381
 382 sub pkg_cancel_date {
 383   my $self = shift;
 384   my $cust_pkg = $self->cust_pkg or return;
 385   return $cust_pkg->getfield('cancel') || '';
 386 }
 387
 388 =item label
 389
 390 Returns a list consisting of:
 391 - The name of this service (from part_svc)
 392 - A meaningful identifier (username, domain, or mail alias)
 393 - The table name (i.e. svc_domain) for this service
 394 - svcnum
 395
 396 Usage example:
 397
 398   my($label, $value, $svcdb) = $cust_svc->label;
 399
 400 =item label_long
 401
 402 Like the B<label> method, except the second item in the list ("meaningful
 403 identifier") may be longer - typically, a full name is included.
 404
 405 =cut
 406
 407 sub label      { shift->_label('svc_label',      @_); }
 408 sub label_long { shift->_label('svc_label_long', @_); }
 409
 410 sub _label {
 411   my $self = shift;
 412   my $method = shift;
 413   my $svc_x = $self->svc_x
 414     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 415
 416   $self->$method($svc_x);
 417 }
 418
 419 sub svc_label      { shift->_svc_label('label',      @_); }
 420 sub svc_label_long { shift->_svc_label('label_long', @_); }
 421
 422 sub _svc_label {
 423   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 424
 425   (
 426     $self->part_svc->svc,
 427     $svc_x->$method(@_),
 428     $self->part_svc->svcdb,
 429     $self->svcnum
 430   );
 431
 432 }
 433
 434 =item export_links
 435
 436 Returns a listref of html elements associated with this service's exports.
 437
 438 =cut
 439
 440 sub export_links {
 441   my $self = shift;
 442   my $svc_x = $self->svc_x
 443     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 444
 445   $svc_x->export_links;
 446 }
 447
 448 =item export_getsettings
 449
 450 Returns two hashrefs of settings associated with this service's exports.
 451
 452 =cut
 453
 454 sub export_getsettings {
 455   my $self = shift;
 456   my $svc_x = $self->svc_x
 457     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 458
 459   $svc_x->export_getsettings;
 460 }
 461
 462
 463 =item svc_x
 464
 465 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 466 FS::svc_domain object, etc.)
 467
 468 =cut
 469
 470 sub svc_x {
 471   my $self = shift;
 472   my $svcdb = $self->part_svc->svcdb;
 473   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 474     $self->{'_svc_acct'};
 475   } else {
 476     require "FS/$svcdb.pm";
 477     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 478          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 479       if $DEBUG;
 480     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 481   }
 482 }
 483
 484 =item seconds_since TIMESTAMP
 485
 486 See L<FS::svc_acct/seconds_since>.  Equivalent to
 487 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 488 where B<svcdb> is not "svc_acct".
 489
 490 =cut
 491
 492 #internal session db deprecated (or at least on hold)
 493 sub seconds_since { 'internal session db deprecated'; };
 494 ##note: implementation here, POD in FS::svc_acct
 495 #sub seconds_since {
 496 #  my($self, $since) = @_;
 497 #  my $dbh = dbh;
 498 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 499 #                              WHERE svcnum = ?
 500 #                                AND login >= ?
 501 #                                AND logout IS NOT NULL'
 502 #  ) or die $dbh->errstr;
 503 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 504 #  $sth->fetchrow_arrayref->[0];
 505 #}
 506
 507 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 508
 509 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 510 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 511 for records where B<svcdb> is not "svc_acct".
 512
 513 =cut
 514
 515 #note: implementation here, POD in FS::svc_acct
 516 sub seconds_since_sqlradacct {
 517   my($self, $start, $end) = @_;
 518
 519   my $mes = "$me seconds_since_sqlradacct:";
 520
 521   my $svc_x = $self->svc_x;
 522
 523   my @part_export = $self->part_svc->part_export_usage;
 524   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 525       " service definition"
 526     unless @part_export;
 527     #or return undef;
 528
 529   my $seconds = 0;
 530   foreach my $part_export ( @part_export ) {
 531
 532     next if $part_export->option('ignore_accounting');
 533
 534     warn "$mes connecting to sqlradius database\n"
 535       if $DEBUG;
 536
 537     my $dbh = DBI->connect( map { $part_export->option($_) }
 538                             qw(datasrc username password)    )
 539       or die "can't connect to sqlradius database: ". $DBI::errstr;
 540
 541     warn "$mes connected to sqlradius database\n"
 542       if $DEBUG;
 543
 544     #select a unix time conversion function based on database type
 545     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 546
 547     my $username = $part_export->export_username($svc_x);
 548
 549     my $query;
 550
 551     warn "$mes finding closed sessions completely within the given range\n"
 552       if $DEBUG;
 553
 554     my $realm = '';
 555     my $realmparam = '';
 556     if ($part_export->option('process_single_realm')) {
 557       $realm = 'AND Realm = ?';
 558       $realmparam = $part_export->option('realm');
 559     }
 560
 561     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 562                                FROM radacct
 563                                WHERE UserName = ?
 564                                  $realm
 565                                  AND $str2time AcctStartTime) >= ?
 566                                  AND $str2time AcctStopTime ) <  ?
 567                                  AND $str2time AcctStopTime ) > 0
 568                                  AND AcctStopTime IS NOT NULL"
 569     ) or die $dbh->errstr;
 570     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 571       or die $sth->errstr;
 572     my $regular = $sth->fetchrow_arrayref->[0];
 573
 574     warn "$mes finding open sessions which start in the range\n"
 575       if $DEBUG;
 576
 577     # count session start->range end
 578     $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
 579                 FROM radacct
 580                 WHERE UserName = ?
 581                   $realm
 582                   AND $str2time AcctStartTime ) >= ?
 583                   AND $str2time AcctStartTime ) <  ?
 584                   AND ( ? - $str2time AcctStartTime ) ) < 86400
 585                   AND (    $str2time AcctStopTime ) = 0
 586                                     OR AcctStopTime IS NULL )";
 587     $sth = $dbh->prepare($query) or die $dbh->errstr;
 588     $sth->execute( $end,
 589                    $username,
 590                    ($realm ? $realmparam : ()),
 591                    $start,
 592                    $end,
 593                    $end )
 594       or die $sth->errstr. " executing query $query";
 595     my $start_during = $sth->fetchrow_arrayref->[0];
 596
 597     warn "$mes finding closed sessions which start before the range but stop during\n"
 598       if $DEBUG;
 599
 600     #count range start->session end
 601     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
 602                             FROM radacct
 603                             WHERE UserName = ?
 604                               $realm
 605                               AND $str2time AcctStartTime ) < ?
 606                               AND $str2time AcctStopTime  ) >= ?
 607                               AND $str2time AcctStopTime  ) <  ?
 608                               AND $str2time AcctStopTime ) > 0
 609                               AND AcctStopTime IS NOT NULL"
 610     ) or die $dbh->errstr;
 611     $sth->execute( $start,
 612                    $username,
 613                    ($realm ? $realmparam : ()),
 614                    $start,
 615                    $start,
 616                    $end )
 617       or die $sth->errstr;
 618     my $end_during = $sth->fetchrow_arrayref->[0];
 619
 620     warn "$mes finding closed sessions which start before the range but stop after\n"
 621       if $DEBUG;
 622
 623     # count range start->range end
 624     # don't count open sessions anymore (probably missing stop record)
 625     $sth = $dbh->prepare("SELECT COUNT(*)
 626                             FROM radacct
 627                             WHERE UserName = ?
 628                               $realm
 629                               AND $str2time AcctStartTime ) < ?
 630                               AND ( $str2time AcctStopTime ) >= ?
 631                                                                   )"
 632                               #      OR AcctStopTime =  0
 633                               #      OR AcctStopTime IS NULL       )"
 634     ) or die $dbh->errstr;
 635     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 636       or die $sth->errstr;
 637     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 638
 639     $seconds += $regular + $end_during + $start_during + $entire_range;
 640
 641     warn "$mes done finding sessions\n"
 642       if $DEBUG;
 643
 644   }
 645
 646   $seconds;
 647
 648 }
 649
 650 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 651
 652 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 653 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 654 for records where B<svcdb> is not "svc_acct".
 655
 656 =cut
 657
 658 #note: implementation here, POD in FS::svc_acct
 659 #(false laziness w/seconds_since_sqlradacct above)
 660 sub attribute_since_sqlradacct {
 661   my($self, $start, $end, $attrib) = @_;
 662
 663   my $mes = "$me attribute_since_sqlradacct:";
 664
 665   my $svc_x = $self->svc_x;
 666
 667   my @part_export = $self->part_svc->part_export_usage;
 668   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 669       " service definition"
 670     unless @part_export;
 671     #or return undef;
 672
 673   my $sum = 0;
 674
 675   foreach my $part_export ( @part_export ) {
 676
 677     next if $part_export->option('ignore_accounting');
 678
 679     warn "$mes connecting to sqlradius database\n"
 680       if $DEBUG;
 681
 682     my $dbh = DBI->connect( map { $part_export->option($_) }
 683                             qw(datasrc username password)    )
 684       or die "can't connect to sqlradius database: ". $DBI::errstr;
 685
 686     warn "$mes connected to sqlradius database\n"
 687       if $DEBUG;
 688
 689     #select a unix time conversion function based on database type
 690     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 691
 692     my $username = $part_export->export_username($svc_x);
 693
 694     warn "$mes SUMing $attrib sessions\n"
 695       if $DEBUG;
 696
 697     my $realm = '';
 698     my $realmparam = '';
 699     if ($part_export->option('process_single_realm')) {
 700       $realm = 'AND Realm = ?';
 701       $realmparam = $part_export->option('realm');
 702     }
 703
 704     my $sth = $dbh->prepare("SELECT SUM($attrib)
 705                                FROM radacct
 706                                WHERE UserName = ?
 707                                  $realm
 708                                  AND $str2time AcctStopTime ) >= ?
 709                                  AND $str2time AcctStopTime ) <  ?
 710                                  AND AcctStopTime IS NOT NULL"
 711     ) or die $dbh->errstr;
 712     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 713       or die $sth->errstr;
 714
 715     my $row = $sth->fetchrow_arrayref;
 716     $sum += $row->[0] if defined($row->[0]);
 717
 718     warn "$mes done SUMing sessions\n"
 719       if $DEBUG;
 720
 721   }
 722
 723   $sum;
 724
 725 }
 726
 727 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 728
 729 See L<FS::svc_acct/get_session_history>.  Equivalent to
 730 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 731 records where B<svcdb> is not "svc_acct".
 732
 733 =cut
 734
 735 sub get_session_history {
 736   my($self, $start, $end, $attrib) = @_;
 737
 738   #$attrib ???
 739
 740   my @part_export = $self->part_svc->part_export_usage;
 741   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 742       " service definition"
 743     unless @part_export;
 744     #or return undef;
 745
 746   my @sessions = ();
 747
 748   foreach my $part_export ( @part_export ) {
 749     push @sessions,
 750       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
 751   }
 752
 753   @sessions;
 754
 755 }
 756
 757 =back
 758
 759 =head1 BUGS
 760
 761 Behaviour of changing the svcpart of cust_svc records is undefined and should
 762 possibly be prohibited, and pkg_svc records are not checked.
 763
 764 pkg_svc records are not checked in general (here).
 765
 766 Deleting this record doesn't check or delete the svc_* record associated
 767 with this record.
 768
 769 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
 770 a DBI database handle is not yet implemented.
 771
 772 =head1 SEE ALSO
 773
 774 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 775 schema.html from the base documentation
 776
 777 =cut
 778
 779 1;
 780