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