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