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 agent_svcid - Optional legacy service ID
  73
  74 =item overlimit - date the service exceeded its usage limit
  75
  76 =back
  77
  78 =head1 METHODS
  79
  80 =over 4
  81
  82 =item new HASHREF
  83
  84 Creates a new service.  To add the refund to the database, see L<"insert">.
  85 Services are normally created by creating FS::svc_ objects (see
  86 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
  87
  88 =cut
  89
  90 sub table { 'cust_svc'; }
  91
  92 =item insert
  93
  94 Adds this service to the database.  If there is an error, returns the error,
  95 otherwise returns false.
  96
  97 =item delete
  98
  99 Deletes this service from the database.  If there is an error, returns the
 100 error, otherwise returns false.  Note that this only removes the cust_svc
 101 record - you should probably use the B<cancel> method instead.
 102
 103 =item cancel
 104
 105 Cancels the relevant service by calling the B<cancel> method of the associated
 106 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
 107 deleting the FS::svc_XXX record and then deleting this record.
 108
 109 If there is an error, returns the error, otherwise returns false.
 110
 111 =cut
 112
 113 sub cancel {
 114   my($self,%opt) = @_;
 115
 116   local $SIG{HUP} = 'IGNORE';
 117   local $SIG{INT} = 'IGNORE';
 118   local $SIG{QUIT} = 'IGNORE';
 119   local $SIG{TERM} = 'IGNORE';
 120   local $SIG{TSTP} = 'IGNORE';
 121   local $SIG{PIPE} = 'IGNORE';
 122
 123   my $oldAutoCommit = $FS::UID::AutoCommit;
 124   local $FS::UID::AutoCommit = 0;
 125   my $dbh = dbh;
 126
 127   my $part_svc = $self->part_svc;
 128
 129   $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
 130     $dbh->rollback if $oldAutoCommit;
 131     return "Illegal svcdb value in part_svc!";
 132   };
 133   my $svcdb = $1;
 134   require "FS/$svcdb.pm";
 135
 136   my $svc = $self->svc_x;
 137   if ($svc) {
 138     if ( %opt && $opt{'date'} ) {
 139         my $error = $svc->expire($opt{'date'});
 140         if ( $error ) {
 141           $dbh->rollback if $oldAutoCommit;
 142           return "Error expiring service: $error";
 143         }
 144     } else {
 145         my $error = $svc->cancel;
 146         if ( $error ) {
 147           $dbh->rollback if $oldAutoCommit;
 148           return "Error canceling service: $error";
 149         }
 150         $error = $svc->delete; #this deletes this cust_svc record as well
 151         if ( $error ) {
 152           $dbh->rollback if $oldAutoCommit;
 153           return "Error deleting service: $error";
 154         }
 155     }
 156
 157   } elsif ( !%opt ) {
 158
 159     #huh?
 160     warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
 161          "; deleting cust_svc only\n";
 162
 163     my $error = $self->delete;
 164     if ( $error ) {
 165       $dbh->rollback if $oldAutoCommit;
 166       return "Error deleting cust_svc: $error";
 167     }
 168
 169   }
 170
 171   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 172
 173   ''; #no errors
 174
 175 }
 176
 177 =item overlimit [ ACTION ]
 178
 179 Retrieves or sets the overlimit date.  If ACTION is absent, return
 180 the present value of overlimit.  If ACTION is present, it can
 181 have the value 'suspend' or 'unsuspend'.  In the case of 'suspend' overlimit
 182 is set to the current time if it is not already set.  The 'unsuspend' value
 183 causes the time to be cleared.
 184
 185 If there is an error on setting, returns the error, otherwise returns false.
 186
 187 =cut
 188
 189 sub overlimit {
 190   my $self = shift;
 191   my $action = shift or return $self->getfield('overlimit');
 192
 193   local $SIG{HUP} = 'IGNORE';
 194   local $SIG{INT} = 'IGNORE';
 195   local $SIG{QUIT} = 'IGNORE';
 196   local $SIG{TERM} = 'IGNORE';
 197   local $SIG{TSTP} = 'IGNORE';
 198   local $SIG{PIPE} = 'IGNORE';
 199
 200   my $oldAutoCommit = $FS::UID::AutoCommit;
 201   local $FS::UID::AutoCommit = 0;
 202   my $dbh = dbh;
 203
 204   if ( $action eq 'suspend' ) {
 205     $self->setfield('overlimit', time) unless $self->getfield('overlimit');
 206   }elsif ( $action eq 'unsuspend' ) {
 207     $self->setfield('overlimit', '');
 208   }else{
 209     die "unexpected action value: $action";
 210   }
 211
 212   local $ignore_quantity = 1;
 213   my $error = $self->replace;
 214   if ( $error ) {
 215     $dbh->rollback if $oldAutoCommit;
 216     return "Error setting overlimit: $error";
 217   }
 218
 219   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 220
 221   ''; #no errors
 222
 223 }
 224
 225 =item replace OLD_RECORD
 226
 227 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 228 returns the error, otherwise returns false.
 229
 230 =cut
 231
 232 sub replace {
 233 #  my $new = shift;
 234 #
 235 #  my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
 236 #              ? shift
 237 #              : $new->replace_old;
 238   my ( $new, $old ) = ( shift, shift );
 239   $old = $new->replace_old unless defined($old);
 240
 241   local $SIG{HUP} = 'IGNORE';
 242   local $SIG{INT} = 'IGNORE';
 243   local $SIG{QUIT} = 'IGNORE';
 244   local $SIG{TERM} = 'IGNORE';
 245   local $SIG{TSTP} = 'IGNORE';
 246   local $SIG{PIPE} = 'IGNORE';
 247
 248   my $oldAutoCommit = $FS::UID::AutoCommit;
 249   local $FS::UID::AutoCommit = 0;
 250   my $dbh = dbh;
 251
 252   if ( $new->svcpart != $old->svcpart ) {
 253     my $svc_x = $new->svc_x;
 254     my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
 255     local($FS::Record::nowarn_identical) = 1;
 256     my $error = $new_svc_x->replace($svc_x);
 257     if ( $error ) {
 258       $dbh->rollback if $oldAutoCommit;
 259       return $error if $error;
 260     }
 261   }
 262
 263 #  #trigger a re-export on pkgnum changes?
 264 #  # (of prepaid packages), for Expiration RADIUS attribute
 265 #  if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
 266 #    my $svc_x = $new->svc_x;
 267 #    local($FS::Record::nowarn_identical) = 1;
 268 #    my $error = $svc_x->export('replace');
 269 #    if ( $error ) {
 270 #      $dbh->rollback if $oldAutoCommit;
 271 #      return $error if $error;
 272 #    }
 273 #  }
 274
 275   #my $error = $new->SUPER::replace($old, @_);
 276   my $error = $new->SUPER::replace($old);
 277   if ( $error ) {
 278     $dbh->rollback if $oldAutoCommit;
 279     return $error if $error;
 280   }
 281
 282   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 283   ''; #no error
 284
 285 }
 286
 287 =item check
 288
 289 Checks all fields to make sure this is a valid service.  If there is an error,
 290 returns the error, otherwise returns false.  Called by the insert and
 291 replace methods.
 292
 293 =cut
 294
 295 sub check {
 296   my $self = shift;
 297
 298   my $error =
 299     $self->ut_numbern('svcnum')
 300     || $self->ut_numbern('pkgnum')
 301     || $self->ut_number('svcpart')
 302     || $self->ut_numbern('agent_svcid')
 303     || $self->ut_numbern('overlimit')
 304   ;
 305   return $error if $error;
 306
 307   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 308   return "Unknown svcpart" unless $part_svc;
 309
 310   if ( $self->pkgnum ) {
 311     my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 312     return "Unknown pkgnum" unless $cust_pkg;
 313     ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
 314     return "No svcpart ". $self->svcpart.
 315            " services in pkgpart ". $cust_pkg->pkgpart
 316       unless $part_svc || $ignore_quantity;
 317     return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
 318            " services for pkgnum ". $self->pkgnum
 319       if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ;
 320   }
 321
 322   $self->SUPER::check;
 323 }
 324
 325 =item display_svcnum
 326
 327 Returns the displayed service number for this service: agent_svcid if it has a
 328 value, svcnum otherwise
 329
 330 =cut
 331
 332 sub display_svcnum {
 333   my $self = shift;
 334   $self->agent_svcid || $self->svcnum;
 335 }
 336
 337 =item part_svc
 338
 339 Returns the definition for this service, as a FS::part_svc object (see
 340 L<FS::part_svc>).
 341
 342 =cut
 343
 344 sub part_svc {
 345   my $self = shift;
 346   $self->{'_svcpart'}
 347     ? $self->{'_svcpart'}
 348     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 349 }
 350
 351 =item cust_pkg
 352
 353 Returns the package this service belongs to, as a FS::cust_pkg object (see
 354 L<FS::cust_pkg>).
 355
 356 =cut
 357
 358 sub cust_pkg {
 359   my $self = shift;
 360   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 361 }
 362
 363 =item pkg_svc
 364
 365 Returns the pkg_svc record for for this service, if applicable.
 366
 367 =cut
 368
 369 sub pkg_svc {
 370   my $self = shift;
 371   my $cust_pkg = $self->cust_pkg;
 372   return undef unless $cust_pkg;
 373
 374   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 375                          'pkgpart' => $cust_pkg->pkgpart,
 376                        }
 377           );
 378 }
 379
 380 =item date_inserted
 381
 382 Returns the date this service was inserted.
 383
 384 =cut
 385
 386 sub date_inserted {
 387   my $self = shift;
 388   $self->h_date('insert');
 389 }
 390
 391 =item pkg_cancel_date
 392
 393 Returns the date this service's package was canceled.  This normally only
 394 exists for a service that's been preserved through cancellation with the
 395 part_pkg.preserve flag.
 396
 397 =cut
 398
 399 sub pkg_cancel_date {
 400   my $self = shift;
 401   my $cust_pkg = $self->cust_pkg or return;
 402   return $cust_pkg->getfield('cancel') || '';
 403 }
 404
 405 =item label
 406
 407 Returns a list consisting of:
 408 - The name of this service (from part_svc)
 409 - A meaningful identifier (username, domain, or mail alias)
 410 - The table name (i.e. svc_domain) for this service
 411 - svcnum
 412
 413 Usage example:
 414
 415   my($label, $value, $svcdb) = $cust_svc->label;
 416
 417 =item label_long
 418
 419 Like the B<label> method, except the second item in the list ("meaningful
 420 identifier") may be longer - typically, a full name is included.
 421
 422 =cut
 423
 424 sub label      { shift->_label('svc_label',      @_); }
 425 sub label_long { shift->_label('svc_label_long', @_); }
 426
 427 sub _label {
 428   my $self = shift;
 429   my $method = shift;
 430   my $svc_x = $self->svc_x
 431     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 432
 433   $self->$method($svc_x);
 434 }
 435
 436 sub svc_label      { shift->_svc_label('label',      @_); }
 437 sub svc_label_long { shift->_svc_label('label_long', @_); }
 438
 439 sub _svc_label {
 440   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 441
 442   (
 443     $self->part_svc->svc,
 444     $svc_x->$method(@_),
 445     $self->part_svc->svcdb,
 446     $self->svcnum
 447   );
 448
 449 }
 450
 451 =item export_links
 452
 453 Returns a listref of html elements associated with this service's exports.
 454
 455 =cut
 456
 457 sub export_links {
 458   my $self = shift;
 459   my $svc_x = $self->svc_x
 460     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 461
 462   $svc_x->export_links;
 463 }
 464
 465 =item export_getsettings
 466
 467 Returns two hashrefs of settings associated with this service's exports.
 468
 469 =cut
 470
 471 sub export_getsettings {
 472   my $self = shift;
 473   my $svc_x = $self->svc_x
 474     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 475
 476   $svc_x->export_getsettings;
 477 }
 478
 479
 480 =item svc_x
 481
 482 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 483 FS::svc_domain object, etc.)
 484
 485 =cut
 486
 487 sub svc_x {
 488   my $self = shift;
 489   my $svcdb = $self->part_svc->svcdb;
 490   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 491     $self->{'_svc_acct'};
 492   } else {
 493     require "FS/$svcdb.pm";
 494     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 495          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 496       if $DEBUG;
 497     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 498   }
 499 }
 500
 501 =item seconds_since TIMESTAMP
 502
 503 See L<FS::svc_acct/seconds_since>.  Equivalent to
 504 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 505 where B<svcdb> is not "svc_acct".
 506
 507 =cut
 508
 509 #internal session db deprecated (or at least on hold)
 510 sub seconds_since { 'internal session db deprecated'; };
 511 ##note: implementation here, POD in FS::svc_acct
 512 #sub seconds_since {
 513 #  my($self, $since) = @_;
 514 #  my $dbh = dbh;
 515 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 516 #                              WHERE svcnum = ?
 517 #                                AND login >= ?
 518 #                                AND logout IS NOT NULL'
 519 #  ) or die $dbh->errstr;
 520 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 521 #  $sth->fetchrow_arrayref->[0];
 522 #}
 523
 524 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 525
 526 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 527 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 528 for records where B<svcdb> is not "svc_acct".
 529
 530 =cut
 531
 532 #note: implementation here, POD in FS::svc_acct
 533 sub seconds_since_sqlradacct {
 534   my($self, $start, $end) = @_;
 535
 536   my $mes = "$me seconds_since_sqlradacct:";
 537
 538   my $svc_x = $self->svc_x;
 539
 540   my @part_export = $self->part_svc->part_export_usage;
 541   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 542       " service definition"
 543     unless @part_export;
 544     #or return undef;
 545
 546   my $seconds = 0;
 547   foreach my $part_export ( @part_export ) {
 548
 549     next if $part_export->option('ignore_accounting');
 550
 551     warn "$mes connecting to sqlradius database\n"
 552       if $DEBUG;
 553
 554     my $dbh = DBI->connect( map { $part_export->option($_) }
 555                             qw(datasrc username password)    )
 556       or die "can't connect to sqlradius database: ". $DBI::errstr;
 557
 558     warn "$mes connected to sqlradius database\n"
 559       if $DEBUG;
 560
 561     #select a unix time conversion function based on database type
 562     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 563
 564     my $username = $part_export->export_username($svc_x);
 565
 566     my $query;
 567
 568     warn "$mes finding closed sessions completely within the given range\n"
 569       if $DEBUG;
 570
 571     my $realm = '';
 572     my $realmparam = '';
 573     if ($part_export->option('process_single_realm')) {
 574       $realm = 'AND Realm = ?';
 575       $realmparam = $part_export->option('realm');
 576     }
 577
 578     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 579                                FROM radacct
 580                                WHERE UserName = ?
 581                                  $realm
 582                                  AND $str2time AcctStartTime) >= ?
 583                                  AND $str2time AcctStopTime ) <  ?
 584                                  AND $str2time AcctStopTime ) > 0
 585                                  AND AcctStopTime IS NOT NULL"
 586     ) or die $dbh->errstr;
 587     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 588       or die $sth->errstr;
 589     my $regular = $sth->fetchrow_arrayref->[0];
 590
 591     warn "$mes finding open sessions which start in the range\n"
 592       if $DEBUG;
 593
 594     # count session start->range end
 595     $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
 596                 FROM radacct
 597                 WHERE UserName = ?
 598                   $realm
 599                   AND $str2time AcctStartTime ) >= ?
 600                   AND $str2time AcctStartTime ) <  ?
 601                   AND ( ? - $str2time AcctStartTime ) ) < 86400
 602                   AND (    $str2time AcctStopTime ) = 0
 603                                     OR AcctStopTime IS NULL )";
 604     $sth = $dbh->prepare($query) or die $dbh->errstr;
 605     $sth->execute( $end,
 606                    $username,
 607                    ($realm ? $realmparam : ()),
 608                    $start,
 609                    $end,
 610                    $end )
 611       or die $sth->errstr. " executing query $query";
 612     my $start_during = $sth->fetchrow_arrayref->[0];
 613
 614     warn "$mes finding closed sessions which start before the range but stop during\n"
 615       if $DEBUG;
 616
 617     #count range start->session end
 618     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
 619                             FROM radacct
 620                             WHERE UserName = ?
 621                               $realm
 622                               AND $str2time AcctStartTime ) < ?
 623                               AND $str2time AcctStopTime  ) >= ?
 624                               AND $str2time AcctStopTime  ) <  ?
 625                               AND $str2time AcctStopTime ) > 0
 626                               AND AcctStopTime IS NOT NULL"
 627     ) or die $dbh->errstr;
 628     $sth->execute( $start,
 629                    $username,
 630                    ($realm ? $realmparam : ()),
 631                    $start,
 632                    $start,
 633                    $end )
 634       or die $sth->errstr;
 635     my $end_during = $sth->fetchrow_arrayref->[0];
 636
 637     warn "$mes finding closed sessions which start before the range but stop after\n"
 638       if $DEBUG;
 639
 640     # count range start->range end
 641     # don't count open sessions anymore (probably missing stop record)
 642     $sth = $dbh->prepare("SELECT COUNT(*)
 643                             FROM radacct
 644                             WHERE UserName = ?
 645                               $realm
 646                               AND $str2time AcctStartTime ) < ?
 647                               AND ( $str2time AcctStopTime ) >= ?
 648                                                                   )"
 649                               #      OR AcctStopTime =  0
 650                               #      OR AcctStopTime IS NULL       )"
 651     ) or die $dbh->errstr;
 652     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 653       or die $sth->errstr;
 654     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 655
 656     $seconds += $regular + $end_during + $start_during + $entire_range;
 657
 658     warn "$mes done finding sessions\n"
 659       if $DEBUG;
 660
 661   }
 662
 663   $seconds;
 664
 665 }
 666
 667 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 668
 669 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 670 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 671 for records where B<svcdb> is not "svc_acct".
 672
 673 =cut
 674
 675 #note: implementation here, POD in FS::svc_acct
 676 #(false laziness w/seconds_since_sqlradacct above)
 677 sub attribute_since_sqlradacct {
 678   my($self, $start, $end, $attrib) = @_;
 679
 680   my $mes = "$me attribute_since_sqlradacct:";
 681
 682   my $svc_x = $self->svc_x;
 683
 684   my @part_export = $self->part_svc->part_export_usage;
 685   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 686       " service definition"
 687     unless @part_export;
 688     #or return undef;
 689
 690   my $sum = 0;
 691
 692   foreach my $part_export ( @part_export ) {
 693
 694     next if $part_export->option('ignore_accounting');
 695
 696     warn "$mes connecting to sqlradius database\n"
 697       if $DEBUG;
 698
 699     my $dbh = DBI->connect( map { $part_export->option($_) }
 700                             qw(datasrc username password)    )
 701       or die "can't connect to sqlradius database: ". $DBI::errstr;
 702
 703     warn "$mes connected to sqlradius database\n"
 704       if $DEBUG;
 705
 706     #select a unix time conversion function based on database type
 707     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 708
 709     my $username = $part_export->export_username($svc_x);
 710
 711     warn "$mes SUMing $attrib sessions\n"
 712       if $DEBUG;
 713
 714     my $realm = '';
 715     my $realmparam = '';
 716     if ($part_export->option('process_single_realm')) {
 717       $realm = 'AND Realm = ?';
 718       $realmparam = $part_export->option('realm');
 719     }
 720
 721     my $sth = $dbh->prepare("SELECT SUM($attrib)
 722                                FROM radacct
 723                                WHERE UserName = ?
 724                                  $realm
 725                                  AND $str2time AcctStopTime ) >= ?
 726                                  AND $str2time AcctStopTime ) <  ?
 727                                  AND AcctStopTime IS NOT NULL"
 728     ) or die $dbh->errstr;
 729     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 730       or die $sth->errstr;
 731
 732     my $row = $sth->fetchrow_arrayref;
 733     $sum += $row->[0] if defined($row->[0]);
 734
 735     warn "$mes done SUMing sessions\n"
 736       if $DEBUG;
 737
 738   }
 739
 740   $sum;
 741
 742 }
 743
 744 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 745
 746 See L<FS::svc_acct/get_session_history>.  Equivalent to
 747 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 748 records where B<svcdb> is not "svc_acct".
 749
 750 =cut
 751
 752 sub get_session_history {
 753   my($self, $start, $end, $attrib) = @_;
 754
 755   #$attrib ???
 756
 757   my @part_export = $self->part_svc->part_export_usage;
 758   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 759       " service definition"
 760     unless @part_export;
 761     #or return undef;
 762
 763   my @sessions = ();
 764
 765   foreach my $part_export ( @part_export ) {
 766     push @sessions,
 767       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
 768   }
 769
 770   @sessions;
 771
 772 }
 773
 774 =back
 775
 776 =head1 SUBROUTINES
 777
 778 =over 4
 779
 780 =item smart_search OPTION => VALUE ...
 781
 782 Accepts the option I<search>, the string to search for.  The string will
 783 be searched for as a username, email address, IP address, MAC address,
 784 phone number, and hardware serial number.  Unlike the I<smart_search> on
 785 customers, this always requires an exact match.
 786
 787 =cut
 788
 789 # though perhaps it should be fuzzy in some cases?
 790
 791 sub smart_search {
 792   my %param = __PACKAGE__->smart_search_param(@_);
 793   qsearch(\%param);
 794 }
 795
 796 sub smart_search_param {
 797   my $class = shift;
 798   my %opt = @_;
 799
 800   my $string = $opt{'search'};
 801   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
 802
 803   my @or =
 804       map { my $table = $_;
 805             my $search_sql = "FS::$table"->search_sql($string);
 806             " ( svcdb = '$table'
 807                 AND 0 < ( SELECT COUNT(*) FROM $table
 808                             WHERE $table.svcnum = cust_svc.svcnum
 809                               AND $search_sql
 810                         )
 811               ) ";
 812           }
 813       FS::part_svc->svc_tables;
 814
 815   if ( $string =~ /^(\d+)$/ ) {
 816     unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
 817   }
 818
 819   my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
 820
 821   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
 822     'null_right' => 'View/link unlinked services'
 823   );
 824   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
 825   #for agentnum
 826   my $addl_from = ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
 827                   ' LEFT JOIN cust_main USING ( custnum )'.
 828                   ' LEFT JOIN part_svc  USING ( svcpart )';
 829
 830   (
 831     'table'     => 'cust_svc',
 832     'addl_from' => $addl_from,
 833     'hashref'   => {},
 834     'extra_sql' => $extra_sql,
 835   );
 836 }
 837
 838 =back
 839
 840 =head1 BUGS
 841
 842 Behaviour of changing the svcpart of cust_svc records is undefined and should
 843 possibly be prohibited, and pkg_svc records are not checked.
 844
 845 pkg_svc records are not checked in general (here).
 846
 847 Deleting this record doesn't check or delete the svc_* record associated
 848 with this record.
 849
 850 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
 851 a DBI database handle is not yet implemented.
 852
 853 =head1 SEE ALSO
 854
 855 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 856 schema.html from the base documentation
 857
 858 =cut
 859
 860 1;
 861