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