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   #trigger a pkg_change export on pkgnum changes
 276   if ( $new->pkgnum != $old->pkgnum ) {
 277     my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
 278                                                   $old->cust_pkg,
 279                                    );
 280     if ( $error ) {
 281       $dbh->rollback if $oldAutoCommit;
 282       return $error if $error;
 283     }
 284   }
 285
 286   #my $error = $new->SUPER::replace($old, @_);
 287   my $error = $new->SUPER::replace($old);
 288   if ( $error ) {
 289     $dbh->rollback if $oldAutoCommit;
 290     return $error if $error;
 291   }
 292
 293   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 294   ''; #no error
 295
 296 }
 297
 298 =item check
 299
 300 Checks all fields to make sure this is a valid service.  If there is an error,
 301 returns the error, otherwise returns false.  Called by the insert and
 302 replace methods.
 303
 304 =cut
 305
 306 sub check {
 307   my $self = shift;
 308
 309   my $error =
 310     $self->ut_numbern('svcnum')
 311     || $self->ut_numbern('pkgnum')
 312     || $self->ut_number('svcpart')
 313     || $self->ut_numbern('agent_svcid')
 314     || $self->ut_numbern('overlimit')
 315   ;
 316   return $error if $error;
 317
 318   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 319   return "Unknown svcpart" unless $part_svc;
 320
 321   if ( $self->pkgnum && ! $ignore_quantity ) {
 322     my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 323     return "Unknown pkgnum" unless $cust_pkg;
 324     ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
 325     return "No svcpart ". $self->svcpart.
 326            " services in pkgpart ". $cust_pkg->pkgpart
 327       unless $part_svc || $ignore_quantity;
 328     return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
 329            " services for pkgnum ". $self->pkgnum
 330       if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ;
 331   }
 332
 333   $self->SUPER::check;
 334 }
 335
 336 =item display_svcnum
 337
 338 Returns the displayed service number for this service: agent_svcid if it has a
 339 value, svcnum otherwise
 340
 341 =cut
 342
 343 sub display_svcnum {
 344   my $self = shift;
 345   $self->agent_svcid || $self->svcnum;
 346 }
 347
 348 =item part_svc
 349
 350 Returns the definition for this service, as a FS::part_svc object (see
 351 L<FS::part_svc>).
 352
 353 =cut
 354
 355 sub part_svc {
 356   my $self = shift;
 357   $self->{'_svcpart'}
 358     ? $self->{'_svcpart'}
 359     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 360 }
 361
 362 =item cust_pkg
 363
 364 Returns the package this service belongs to, as a FS::cust_pkg object (see
 365 L<FS::cust_pkg>).
 366
 367 =cut
 368
 369 sub cust_pkg {
 370   my $self = shift;
 371   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 372 }
 373
 374 =item pkg_svc
 375
 376 Returns the pkg_svc record for for this service, if applicable.
 377
 378 =cut
 379
 380 sub pkg_svc {
 381   my $self = shift;
 382   my $cust_pkg = $self->cust_pkg;
 383   return undef unless $cust_pkg;
 384
 385   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 386                          'pkgpart' => $cust_pkg->pkgpart,
 387                        }
 388           );
 389 }
 390
 391 =item date_inserted
 392
 393 Returns the date this service was inserted.
 394
 395 =cut
 396
 397 sub date_inserted {
 398   my $self = shift;
 399   $self->h_date('insert');
 400 }
 401
 402 =item pkg_cancel_date
 403
 404 Returns the date this service's package was canceled.  This normally only
 405 exists for a service that's been preserved through cancellation with the
 406 part_pkg.preserve flag.
 407
 408 =cut
 409
 410 sub pkg_cancel_date {
 411   my $self = shift;
 412   my $cust_pkg = $self->cust_pkg or return;
 413   return $cust_pkg->getfield('cancel') || '';
 414 }
 415
 416 =item label
 417
 418 Returns a list consisting of:
 419 - The name of this service (from part_svc)
 420 - A meaningful identifier (username, domain, or mail alias)
 421 - The table name (i.e. svc_domain) for this service
 422 - svcnum
 423
 424 Usage example:
 425
 426   my($label, $value, $svcdb) = $cust_svc->label;
 427
 428 =item label_long
 429
 430 Like the B<label> method, except the second item in the list ("meaningful
 431 identifier") may be longer - typically, a full name is included.
 432
 433 =cut
 434
 435 sub label      { shift->_label('svc_label',      @_); }
 436 sub label_long { shift->_label('svc_label_long', @_); }
 437
 438 sub _label {
 439   my $self = shift;
 440   my $method = shift;
 441   my $svc_x = $self->svc_x
 442     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 443
 444   $self->$method($svc_x);
 445 }
 446
 447 sub svc_label      { shift->_svc_label('label',      @_); }
 448 sub svc_label_long { shift->_svc_label('label_long', @_); }
 449
 450 sub _svc_label {
 451   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 452
 453   (
 454     $self->part_svc->svc,
 455     $svc_x->$method(@_),
 456     $self->part_svc->svcdb,
 457     $self->svcnum
 458   );
 459
 460 }
 461
 462 =item export_links
 463
 464 Returns a listref of html elements associated with this service's exports.
 465
 466 =cut
 467
 468 sub export_links {
 469   my $self = shift;
 470   my $svc_x = $self->svc_x
 471     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 472
 473   $svc_x->export_links;
 474 }
 475
 476 =item export_getsettings
 477
 478 Returns two hashrefs of settings associated with this service's exports.
 479
 480 =cut
 481
 482 sub export_getsettings {
 483   my $self = shift;
 484   my $svc_x = $self->svc_x
 485     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 486
 487   $svc_x->export_getsettings;
 488 }
 489
 490
 491 =item svc_x
 492
 493 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 494 FS::svc_domain object, etc.)
 495
 496 =cut
 497
 498 sub svc_x {
 499   my $self = shift;
 500   my $svcdb = $self->part_svc->svcdb;
 501   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 502     $self->{'_svc_acct'};
 503   } else {
 504     require "FS/$svcdb.pm";
 505     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 506          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 507       if $DEBUG;
 508     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 509   }
 510 }
 511
 512 =item seconds_since TIMESTAMP
 513
 514 See L<FS::svc_acct/seconds_since>.  Equivalent to
 515 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 516 where B<svcdb> is not "svc_acct".
 517
 518 =cut
 519
 520 #internal session db deprecated (or at least on hold)
 521 sub seconds_since { 'internal session db deprecated'; };
 522 ##note: implementation here, POD in FS::svc_acct
 523 #sub seconds_since {
 524 #  my($self, $since) = @_;
 525 #  my $dbh = dbh;
 526 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 527 #                              WHERE svcnum = ?
 528 #                                AND login >= ?
 529 #                                AND logout IS NOT NULL'
 530 #  ) or die $dbh->errstr;
 531 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 532 #  $sth->fetchrow_arrayref->[0];
 533 #}
 534
 535 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 536
 537 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 538 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 539 for records where B<svcdb> is not "svc_acct".
 540
 541 =cut
 542
 543 #note: implementation here, POD in FS::svc_acct
 544 sub seconds_since_sqlradacct {
 545   my($self, $start, $end) = @_;
 546
 547   my $mes = "$me seconds_since_sqlradacct:";
 548
 549   my $svc_x = $self->svc_x;
 550
 551   my @part_export = $self->part_svc->part_export_usage;
 552   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 553       " service definition"
 554     unless @part_export;
 555     #or return undef;
 556
 557   my $seconds = 0;
 558   foreach my $part_export ( @part_export ) {
 559
 560     next if $part_export->option('ignore_accounting');
 561
 562     warn "$mes connecting to sqlradius database\n"
 563       if $DEBUG;
 564
 565     my $dbh = DBI->connect( map { $part_export->option($_) }
 566                             qw(datasrc username password)    )
 567       or die "can't connect to sqlradius database: ". $DBI::errstr;
 568
 569     warn "$mes connected to sqlradius database\n"
 570       if $DEBUG;
 571
 572     #select a unix time conversion function based on database type
 573     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 574
 575     my $username = $part_export->export_username($svc_x);
 576
 577     my $query;
 578
 579     warn "$mes finding closed sessions completely within the given range\n"
 580       if $DEBUG;
 581
 582     my $realm = '';
 583     my $realmparam = '';
 584     if ($part_export->option('process_single_realm')) {
 585       $realm = 'AND Realm = ?';
 586       $realmparam = $part_export->option('realm');
 587     }
 588
 589     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 590                                FROM radacct
 591                                WHERE UserName = ?
 592                                  $realm
 593                                  AND $str2time AcctStartTime) >= ?
 594                                  AND $str2time AcctStopTime ) <  ?
 595                                  AND $str2time AcctStopTime ) > 0
 596                                  AND AcctStopTime IS NOT NULL"
 597     ) or die $dbh->errstr;
 598     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 599       or die $sth->errstr;
 600     my $regular = $sth->fetchrow_arrayref->[0];
 601
 602     warn "$mes finding open sessions which start in the range\n"
 603       if $DEBUG;
 604
 605     # count session start->range end
 606     $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
 607                 FROM radacct
 608                 WHERE UserName = ?
 609                   $realm
 610                   AND $str2time AcctStartTime ) >= ?
 611                   AND $str2time AcctStartTime ) <  ?
 612                   AND ( ? - $str2time AcctStartTime ) ) < 86400
 613                   AND (    $str2time AcctStopTime ) = 0
 614                                     OR AcctStopTime IS NULL )";
 615     $sth = $dbh->prepare($query) or die $dbh->errstr;
 616     $sth->execute( $end,
 617                    $username,
 618                    ($realm ? $realmparam : ()),
 619                    $start,
 620                    $end,
 621                    $end )
 622       or die $sth->errstr. " executing query $query";
 623     my $start_during = $sth->fetchrow_arrayref->[0];
 624
 625     warn "$mes finding closed sessions which start before the range but stop during\n"
 626       if $DEBUG;
 627
 628     #count range start->session end
 629     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
 630                             FROM radacct
 631                             WHERE UserName = ?
 632                               $realm
 633                               AND $str2time AcctStartTime ) < ?
 634                               AND $str2time AcctStopTime  ) >= ?
 635                               AND $str2time AcctStopTime  ) <  ?
 636                               AND $str2time AcctStopTime ) > 0
 637                               AND AcctStopTime IS NOT NULL"
 638     ) or die $dbh->errstr;
 639     $sth->execute( $start,
 640                    $username,
 641                    ($realm ? $realmparam : ()),
 642                    $start,
 643                    $start,
 644                    $end )
 645       or die $sth->errstr;
 646     my $end_during = $sth->fetchrow_arrayref->[0];
 647
 648     warn "$mes finding closed sessions which start before the range but stop after\n"
 649       if $DEBUG;
 650
 651     # count range start->range end
 652     # don't count open sessions anymore (probably missing stop record)
 653     $sth = $dbh->prepare("SELECT COUNT(*)
 654                             FROM radacct
 655                             WHERE UserName = ?
 656                               $realm
 657                               AND $str2time AcctStartTime ) < ?
 658                               AND ( $str2time AcctStopTime ) >= ?
 659                                                                   )"
 660                               #      OR AcctStopTime =  0
 661                               #      OR AcctStopTime IS NULL       )"
 662     ) or die $dbh->errstr;
 663     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 664       or die $sth->errstr;
 665     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 666
 667     $seconds += $regular + $end_during + $start_during + $entire_range;
 668
 669     warn "$mes done finding sessions\n"
 670       if $DEBUG;
 671
 672   }
 673
 674   $seconds;
 675
 676 }
 677
 678 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 679
 680 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 681 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 682 for records where B<svcdb> is not "svc_acct".
 683
 684 =cut
 685
 686 #note: implementation here, POD in FS::svc_acct
 687 #(false laziness w/seconds_since_sqlradacct above)
 688 sub attribute_since_sqlradacct {
 689   my($self, $start, $end, $attrib) = @_;
 690
 691   my $mes = "$me attribute_since_sqlradacct:";
 692
 693   my $svc_x = $self->svc_x;
 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 $sum = 0;
 702
 703   foreach my $part_export ( @part_export ) {
 704
 705     next if $part_export->option('ignore_accounting');
 706
 707     warn "$mes connecting to sqlradius database\n"
 708       if $DEBUG;
 709
 710     my $dbh = DBI->connect( map { $part_export->option($_) }
 711                             qw(datasrc username password)    )
 712       or die "can't connect to sqlradius database: ". $DBI::errstr;
 713
 714     warn "$mes connected to sqlradius database\n"
 715       if $DEBUG;
 716
 717     #select a unix time conversion function based on database type
 718     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 719
 720     my $username = $part_export->export_username($svc_x);
 721
 722     warn "$mes SUMing $attrib sessions\n"
 723       if $DEBUG;
 724
 725     my $realm = '';
 726     my $realmparam = '';
 727     if ($part_export->option('process_single_realm')) {
 728       $realm = 'AND Realm = ?';
 729       $realmparam = $part_export->option('realm');
 730     }
 731
 732     my $sth = $dbh->prepare("SELECT SUM($attrib)
 733                                FROM radacct
 734                                WHERE UserName = ?
 735                                  $realm
 736                                  AND $str2time AcctStopTime ) >= ?
 737                                  AND $str2time AcctStopTime ) <  ?
 738                                  AND AcctStopTime IS NOT NULL"
 739     ) or die $dbh->errstr;
 740     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 741       or die $sth->errstr;
 742
 743     my $row = $sth->fetchrow_arrayref;
 744     $sum += $row->[0] if defined($row->[0]);
 745
 746     warn "$mes done SUMing sessions\n"
 747       if $DEBUG;
 748
 749   }
 750
 751   $sum;
 752
 753 }
 754
 755 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 756
 757 See L<FS::svc_acct/get_session_history>.  Equivalent to
 758 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 759 records where B<svcdb> is not "svc_acct".
 760
 761 =cut
 762
 763 sub get_session_history {
 764   my($self, $start, $end, $attrib) = @_;
 765
 766   #$attrib ???
 767
 768   my @part_export = $self->part_svc->part_export_usage;
 769   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 770       " service definition"
 771     unless @part_export;
 772     #or return undef;
 773
 774   my @sessions = ();
 775
 776   foreach my $part_export ( @part_export ) {
 777     push @sessions,
 778       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
 779   }
 780
 781   @sessions;
 782
 783 }
 784
 785 =back
 786
 787 =head1 SUBROUTINES
 788
 789 =over 4
 790
 791 =item smart_search OPTION => VALUE ...
 792
 793 Accepts the option I<search>, the string to search for.  The string will
 794 be searched for as a username, email address, IP address, MAC address,
 795 phone number, and hardware serial number.  Unlike the I<smart_search> on
 796 customers, this always requires an exact match.
 797
 798 =cut
 799
 800 # though perhaps it should be fuzzy in some cases?
 801
 802 sub smart_search {
 803   my %param = __PACKAGE__->smart_search_param(@_);
 804   qsearch(\%param);
 805 }
 806
 807 sub smart_search_param {
 808   my $class = shift;
 809   my %opt = @_;
 810
 811   my $string = $opt{'search'};
 812   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
 813
 814   my @or =
 815       map { my $table = $_;
 816             my $search_sql = "FS::$table"->search_sql($string);
 817             " ( svcdb = '$table'
 818                 AND 0 < ( SELECT COUNT(*) FROM $table
 819                             WHERE $table.svcnum = cust_svc.svcnum
 820                               AND $search_sql
 821                         )
 822               ) ";
 823           }
 824       FS::part_svc->svc_tables;
 825
 826   if ( $string =~ /^(\d+)$/ ) {
 827     unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
 828   }
 829
 830   my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
 831
 832   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
 833     'null_right' => 'View/link unlinked services'
 834   );
 835   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
 836   #for agentnum
 837   my $addl_from = ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
 838                   ' LEFT JOIN cust_main USING ( custnum )'.
 839                   ' LEFT JOIN part_svc  USING ( svcpart )';
 840
 841   (
 842     'table'     => 'cust_svc',
 843     'addl_from' => $addl_from,
 844     'hashref'   => {},
 845     'extra_sql' => $extra_sql,
 846   );
 847 }
 848
 849 =back
 850
 851 =head1 BUGS
 852
 853 Behaviour of changing the svcpart of cust_svc records is undefined and should
 854 possibly be prohibited, and pkg_svc records are not checked.
 855
 856 pkg_svc records are not checked in general (here).
 857
 858 Deleting this record doesn't check or delete the svc_* record associated
 859 with this record.
 860
 861 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
 862 a DBI database handle is not yet implemented.
 863
 864 =head1 SEE ALSO
 865
 866 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 867 schema.html from the base documentation
 868
 869 =cut
 870
 871 1;
 872