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 $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 543                                FROM radacct
 544                                WHERE UserName = ?
 545                                  AND $str2time AcctStartTime) >= ?
 546                                  AND $str2time AcctStopTime ) <  ?
 547                                  AND $str2time AcctStopTime ) > 0
 548                                  AND AcctStopTime IS NOT NULL"
 549     ) or die $dbh->errstr;
 550     $sth->execute($username, $start, $end) or die $sth->errstr;
 551     my $regular = $sth->fetchrow_arrayref->[0];
 552
 553     warn "$mes finding open sessions which start in the range\n"
 554       if $DEBUG;
 555
 556     # count session start->range end
 557     $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
 558                 FROM radacct
 559                 WHERE UserName = ?
 560                   AND $str2time AcctStartTime ) >= ?
 561                   AND $str2time AcctStartTime ) <  ?
 562                   AND ( ? - $str2time AcctStartTime ) ) < 86400
 563                   AND (    $str2time AcctStopTime ) = 0
 564                                     OR AcctStopTime IS NULL )";
 565     $sth = $dbh->prepare($query) or die $dbh->errstr;
 566     $sth->execute($end, $username, $start, $end, $end)
 567       or die $sth->errstr. " executing query $query";
 568     my $start_during = $sth->fetchrow_arrayref->[0];
 569
 570     warn "$mes finding closed sessions which start before the range but stop during\n"
 571       if $DEBUG;
 572
 573     #count range start->session end
 574     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
 575                             FROM radacct
 576                             WHERE UserName = ?
 577                               AND $str2time AcctStartTime ) < ?
 578                               AND $str2time AcctStopTime  ) >= ?
 579                               AND $str2time AcctStopTime  ) <  ?
 580                               AND $str2time AcctStopTime ) > 0
 581                               AND AcctStopTime IS NOT NULL"
 582     ) or die $dbh->errstr;
 583     $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
 584     my $end_during = $sth->fetchrow_arrayref->[0];
 585
 586     warn "$mes finding closed sessions which start before the range but stop after\n"
 587       if $DEBUG;
 588
 589     # count range start->range end
 590     # don't count open sessions anymore (probably missing stop record)
 591     $sth = $dbh->prepare("SELECT COUNT(*)
 592                             FROM radacct
 593                             WHERE UserName = ?
 594                               AND $str2time AcctStartTime ) < ?
 595                               AND ( $str2time AcctStopTime ) >= ?
 596                                                                   )"
 597                               #      OR AcctStopTime =  0
 598                               #      OR AcctStopTime IS NULL       )"
 599     ) or die $dbh->errstr;
 600     $sth->execute($username, $start, $end ) or die $sth->errstr;
 601     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 602
 603     $seconds += $regular + $end_during + $start_during + $entire_range;
 604
 605     warn "$mes done finding sessions\n"
 606       if $DEBUG;
 607
 608   }
 609
 610   $seconds;
 611
 612 }
 613
 614 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 615
 616 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 617 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 618 for records where B<svcdb> is not "svc_acct".
 619
 620 =cut
 621
 622 #note: implementation here, POD in FS::svc_acct
 623 #(false laziness w/seconds_since_sqlradacct above)
 624 sub attribute_since_sqlradacct {
 625   my($self, $start, $end, $attrib) = @_;
 626
 627   my $mes = "$me attribute_since_sqlradacct:";
 628
 629   my $svc_x = $self->svc_x;
 630
 631   my @part_export = $self->part_svc->part_export_usage;
 632   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 633       " service definition"
 634     unless @part_export;
 635     #or return undef;
 636
 637   my $sum = 0;
 638
 639   foreach my $part_export ( @part_export ) {
 640
 641     next if $part_export->option('ignore_accounting');
 642
 643     warn "$mes connecting to sqlradius database\n"
 644       if $DEBUG;
 645
 646     my $dbh = DBI->connect( map { $part_export->option($_) }
 647                             qw(datasrc username password)    )
 648       or die "can't connect to sqlradius database: ". $DBI::errstr;
 649
 650     warn "$mes connected to sqlradius database\n"
 651       if $DEBUG;
 652
 653     #select a unix time conversion function based on database type
 654     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 655
 656     my $username = $part_export->export_username($svc_x);
 657
 658     warn "$mes SUMing $attrib sessions\n"
 659       if $DEBUG;
 660
 661     my $sth = $dbh->prepare("SELECT SUM($attrib)
 662                                FROM radacct
 663                                WHERE UserName = ?
 664                                  AND $str2time AcctStopTime ) >= ?
 665                                  AND $str2time AcctStopTime ) <  ?
 666                                  AND AcctStopTime IS NOT NULL"
 667     ) or die $dbh->errstr;
 668     $sth->execute($username, $start, $end) or die $sth->errstr;
 669
 670     my $row = $sth->fetchrow_arrayref;
 671     $sum += $row->[0] if defined($row->[0]);
 672
 673     warn "$mes done SUMing sessions\n"
 674       if $DEBUG;
 675
 676   }
 677
 678   $sum;
 679
 680 }
 681
 682 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 683
 684 See L<FS::svc_acct/get_session_history>.  Equivalent to
 685 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 686 records where B<svcdb> is not "svc_acct".
 687
 688 =cut
 689
 690 sub get_session_history {
 691   my($self, $start, $end, $attrib) = @_;
 692
 693   #$attrib ???
 694
 695   my @part_export = $self->part_svc->part_export_usage;
 696   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 697       " service definition"
 698     unless @part_export;
 699     #or return undef;
 700
 701   my @sessions = ();
 702
 703   foreach my $part_export ( @part_export ) {
 704     push @sessions,
 705       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
 706   }
 707
 708   @sessions;
 709
 710 }
 711
 712 =item get_cdrs_for_update
 713
 714 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
 715 objects (see L<FS::cdr>) associated with this service.
 716
 717 CDRs are associated with svc_phone services via svc_phone.phonenum
 718
 719 =cut
 720
 721 sub get_cdrs_for_update {
 722   my $self = shift;
 723   $self->get_cdrs( 'freesidestatus' => '',
 724                    'for_update'     => 1,
 725                    @_,
 726                  );
 727 }
 728
 729 sub get_cdrs {
 730   my($self, %options) = @_;
 731
 732   my @fields = ( 'charged_party' );
 733   push @fields, 'src' unless $options{'disable_src'};
 734
 735   my $for_update = $options{'for_update'} ? 'FOR UPDATE' : '';
 736
 737   my %hash = ();
 738   $hash{'freesidestatus'} = $options{'freesidestatus'}
 739     if exists($options{'freesidestatus'});
 740
 741   #CDRs are associated with svc_phone services via svc_phone.phonenum
 742
 743   #return () unless $self->svc_x->isa('FS::svc_phone');
 744   return () unless $self->part_svc->svcdb eq 'svc_phone';
 745   my $number = $self->svc_x->phonenum;
 746
 747   my $prefix = $options{'default_prefix'};
 748
 749   my @orwhere =  map " $_ = '$number'        ", @fields;
 750   push @orwhere, map " $_ = '$prefix$number' ", @fields
 751     if length($prefix);
 752   if ( $prefix =~ /^\+(\d+)$/ ) {
 753     push @orwhere, map " $_ = '$1$number' ", @fields
 754   }
 755
 756   my @where = ( ' ( '. join(' OR ', @orwhere ). ' ) ' );
 757
 758   if ( $options{'begin'} ) {
 759     push @where, 'startdate >= '. $options{'begin'};
 760   }
 761   if ( $options{'end'} ) {
 762     push @where, 'startdate < '.  $options{'end'};
 763   }
 764
 765   my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where );
 766
 767   my @cdrs =
 768     qsearch( {
 769       'table'      => 'cdr',
 770       'hashref'    => \%hash,
 771       'extra_sql'  => $extra_sql,
 772       'order_by'   => "ORDER BY startdate $for_update",
 773     } );
 774
 775   @cdrs;
 776 }
 777
 778 =back
 779
 780 =head1 BUGS
 781
 782 Behaviour of changing the svcpart of cust_svc records is undefined and should
 783 possibly be prohibited, and pkg_svc records are not checked.
 784
 785 pkg_svc records are not checked in general (here).
 786
 787 Deleting this record doesn't check or delete the svc_* record associated
 788 with this record.
 789
 790 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
 791 a DBI database handle is not yet implemented.
 792
 793 =head1 SEE ALSO
 794
 795 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 796 schema.html from the base documentation
 797
 798 =cut
 799
 800 1;
 801