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;
 317     return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
 318            " services for pkgnum ". $self->pkgnum
 319       if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
 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   my $identifier = $svc_x->$method(@_);
 443   $identifier = '['.$self->agent_svcid.']'. $identifier if $self->agent_svcid;
 444
 445   (
 446     $self->part_svc->svc,
 447     $identifier,
 448     $self->part_svc->svcdb,
 449     $self->svcnum
 450   );
 451
 452 }
 453
 454 =item export_links
 455
 456 Returns a listref of html elements associated with this service's exports.
 457
 458 =cut
 459
 460 sub export_links {
 461   my $self = shift;
 462   my $svc_x = $self->svc_x
 463     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 464
 465   $svc_x->export_links;
 466 }
 467
 468 =item export_getsettings
 469
 470 Returns two hashrefs of settings associated with this service's exports.
 471
 472 =cut
 473
 474 sub export_getsettings {
 475   my $self = shift;
 476   my $svc_x = $self->svc_x
 477     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 478
 479   $svc_x->export_getsettings;
 480 }
 481
 482
 483 =item svc_x
 484
 485 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 486 FS::svc_domain object, etc.)
 487
 488 =cut
 489
 490 sub svc_x {
 491   my $self = shift;
 492   my $svcdb = $self->part_svc->svcdb;
 493   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 494     $self->{'_svc_acct'};
 495   } else {
 496     require "FS/$svcdb.pm";
 497     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 498          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 499       if $DEBUG;
 500     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 501   }
 502 }
 503
 504 =item seconds_since TIMESTAMP
 505
 506 See L<FS::svc_acct/seconds_since>.  Equivalent to
 507 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 508 where B<svcdb> is not "svc_acct".
 509
 510 =cut
 511
 512 #internal session db deprecated (or at least on hold)
 513 sub seconds_since { 'internal session db deprecated'; };
 514 ##note: implementation here, POD in FS::svc_acct
 515 #sub seconds_since {
 516 #  my($self, $since) = @_;
 517 #  my $dbh = dbh;
 518 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 519 #                              WHERE svcnum = ?
 520 #                                AND login >= ?
 521 #                                AND logout IS NOT NULL'
 522 #  ) or die $dbh->errstr;
 523 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 524 #  $sth->fetchrow_arrayref->[0];
 525 #}
 526
 527 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 528
 529 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 530 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 531 for records where B<svcdb> is not "svc_acct".
 532
 533 =cut
 534
 535 #note: implementation here, POD in FS::svc_acct
 536 sub seconds_since_sqlradacct {
 537   my($self, $start, $end) = @_;
 538
 539   my $mes = "$me seconds_since_sqlradacct:";
 540
 541   my $svc_x = $self->svc_x;
 542
 543   my @part_export = $self->part_svc->part_export_usage;
 544   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 545       " service definition"
 546     unless @part_export;
 547     #or return undef;
 548
 549   my $seconds = 0;
 550   foreach my $part_export ( @part_export ) {
 551
 552     next if $part_export->option('ignore_accounting');
 553
 554     warn "$mes connecting to sqlradius database\n"
 555       if $DEBUG;
 556
 557     my $dbh = DBI->connect( map { $part_export->option($_) }
 558                             qw(datasrc username password)    )
 559       or die "can't connect to sqlradius database: ". $DBI::errstr;
 560
 561     warn "$mes connected to sqlradius database\n"
 562       if $DEBUG;
 563
 564     #select a unix time conversion function based on database type
 565     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 566
 567     my $username = $part_export->export_username($svc_x);
 568
 569     my $query;
 570
 571     warn "$mes finding closed sessions completely within the given range\n"
 572       if $DEBUG;
 573
 574     my $realm = '';
 575     my $realmparam = '';
 576     if ($part_export->option('process_single_realm')) {
 577       $realm = 'AND Realm = ?';
 578       $realmparam = $part_export->option('realm');
 579     }
 580
 581     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 582                                FROM radacct
 583                                WHERE UserName = ?
 584                                  $realm
 585                                  AND $str2time AcctStartTime) >= ?
 586                                  AND $str2time AcctStopTime ) <  ?
 587                                  AND $str2time AcctStopTime ) > 0
 588                                  AND AcctStopTime IS NOT NULL"
 589     ) or die $dbh->errstr;
 590     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 591       or die $sth->errstr;
 592     my $regular = $sth->fetchrow_arrayref->[0];
 593
 594     warn "$mes finding open sessions which start in the range\n"
 595       if $DEBUG;
 596
 597     # count session start->range end
 598     $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
 599                 FROM radacct
 600                 WHERE UserName = ?
 601                   $realm
 602                   AND $str2time AcctStartTime ) >= ?
 603                   AND $str2time AcctStartTime ) <  ?
 604                   AND ( ? - $str2time AcctStartTime ) ) < 86400
 605                   AND (    $str2time AcctStopTime ) = 0
 606                                     OR AcctStopTime IS NULL )";
 607     $sth = $dbh->prepare($query) or die $dbh->errstr;
 608     $sth->execute( $end,
 609                    $username,
 610                    ($realm ? $realmparam : ()),
 611                    $start,
 612                    $end,
 613                    $end )
 614       or die $sth->errstr. " executing query $query";
 615     my $start_during = $sth->fetchrow_arrayref->[0];
 616
 617     warn "$mes finding closed sessions which start before the range but stop during\n"
 618       if $DEBUG;
 619
 620     #count range start->session end
 621     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
 622                             FROM radacct
 623                             WHERE UserName = ?
 624                               $realm
 625                               AND $str2time AcctStartTime ) < ?
 626                               AND $str2time AcctStopTime  ) >= ?
 627                               AND $str2time AcctStopTime  ) <  ?
 628                               AND $str2time AcctStopTime ) > 0
 629                               AND AcctStopTime IS NOT NULL"
 630     ) or die $dbh->errstr;
 631     $sth->execute( $start,
 632                    $username,
 633                    ($realm ? $realmparam : ()),
 634                    $start,
 635                    $start,
 636                    $end )
 637       or die $sth->errstr;
 638     my $end_during = $sth->fetchrow_arrayref->[0];
 639
 640     warn "$mes finding closed sessions which start before the range but stop after\n"
 641       if $DEBUG;
 642
 643     # count range start->range end
 644     # don't count open sessions anymore (probably missing stop record)
 645     $sth = $dbh->prepare("SELECT COUNT(*)
 646                             FROM radacct
 647                             WHERE UserName = ?
 648                               $realm
 649                               AND $str2time AcctStartTime ) < ?
 650                               AND ( $str2time AcctStopTime ) >= ?
 651                                                                   )"
 652                               #      OR AcctStopTime =  0
 653                               #      OR AcctStopTime IS NULL       )"
 654     ) or die $dbh->errstr;
 655     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 656       or die $sth->errstr;
 657     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 658
 659     $seconds += $regular + $end_during + $start_during + $entire_range;
 660
 661     warn "$mes done finding sessions\n"
 662       if $DEBUG;
 663
 664   }
 665
 666   $seconds;
 667
 668 }
 669
 670 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 671
 672 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 673 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 674 for records where B<svcdb> is not "svc_acct".
 675
 676 =cut
 677
 678 #note: implementation here, POD in FS::svc_acct
 679 #(false laziness w/seconds_since_sqlradacct above)
 680 sub attribute_since_sqlradacct {
 681   my($self, $start, $end, $attrib) = @_;
 682
 683   my $mes = "$me attribute_since_sqlradacct:";
 684
 685   my $svc_x = $self->svc_x;
 686
 687   my @part_export = $self->part_svc->part_export_usage;
 688   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 689       " service definition"
 690     unless @part_export;
 691     #or return undef;
 692
 693   my $sum = 0;
 694
 695   foreach my $part_export ( @part_export ) {
 696
 697     next if $part_export->option('ignore_accounting');
 698
 699     warn "$mes connecting to sqlradius database\n"
 700       if $DEBUG;
 701
 702     my $dbh = DBI->connect( map { $part_export->option($_) }
 703                             qw(datasrc username password)    )
 704       or die "can't connect to sqlradius database: ". $DBI::errstr;
 705
 706     warn "$mes connected to sqlradius database\n"
 707       if $DEBUG;
 708
 709     #select a unix time conversion function based on database type
 710     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 711
 712     my $username = $part_export->export_username($svc_x);
 713
 714     warn "$mes SUMing $attrib sessions\n"
 715       if $DEBUG;
 716
 717     my $realm = '';
 718     my $realmparam = '';
 719     if ($part_export->option('process_single_realm')) {
 720       $realm = 'AND Realm = ?';
 721       $realmparam = $part_export->option('realm');
 722     }
 723
 724     my $sth = $dbh->prepare("SELECT SUM($attrib)
 725                                FROM radacct
 726                                WHERE UserName = ?
 727                                  $realm
 728                                  AND $str2time AcctStopTime ) >= ?
 729                                  AND $str2time AcctStopTime ) <  ?
 730                                  AND AcctStopTime IS NOT NULL"
 731     ) or die $dbh->errstr;
 732     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 733       or die $sth->errstr;
 734
 735     my $row = $sth->fetchrow_arrayref;
 736     $sum += $row->[0] if defined($row->[0]);
 737
 738     warn "$mes done SUMing sessions\n"
 739       if $DEBUG;
 740
 741   }
 742
 743   $sum;
 744
 745 }
 746
 747 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 748
 749 See L<FS::svc_acct/get_session_history>.  Equivalent to
 750 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 751 records where B<svcdb> is not "svc_acct".
 752
 753 =cut
 754
 755 sub get_session_history {
 756   my($self, $start, $end, $attrib) = @_;
 757
 758   #$attrib ???
 759
 760   my @part_export = $self->part_svc->part_export_usage;
 761   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 762       " service definition"
 763     unless @part_export;
 764     #or return undef;
 765
 766   my @sessions = ();
 767
 768   foreach my $part_export ( @part_export ) {
 769     push @sessions,
 770       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
 771   }
 772
 773   @sessions;
 774
 775 }
 776
 777 =back
 778
 779 =head1 SUBROUTINES
 780
 781 =over 4
 782
 783 =item smart_search OPTION => VALUE ...
 784
 785 Accepts the option I<search>, the string to search for.  The string will
 786 be searched for as a username, email address, IP address, MAC address,
 787 phone number, and hardware serial number.  Unlike the I<smart_search> on
 788 customers, this always requires an exact match.
 789
 790 =cut
 791
 792 # though perhaps it should be fuzzy in some cases?
 793
 794 sub smart_search {
 795   my %param = __PACKAGE__->smart_search_param(@_);
 796   qsearch(\%param);
 797 }
 798
 799 sub smart_search_param {
 800   my $class = shift;
 801   my %opt = @_;
 802
 803   my $string = $opt{'search'};
 804   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
 805
 806   my @or =
 807       map { my $table = $_;
 808             my $search_sql = "FS::$table"->search_sql($string);
 809             " ( svcdb = '$table'
 810                 AND 0 < ( SELECT COUNT(*) FROM $table
 811                             WHERE $table.svcnum = cust_svc.svcnum
 812                               AND $search_sql
 813                         )
 814               ) ";
 815           }
 816       FS::part_svc->svc_tables;
 817
 818   if ( $string =~ /^(\d+)$/ ) {
 819     unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
 820   }
 821
 822   my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
 823
 824   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
 825     'null_right' => 'View/link unlinked services'
 826   );
 827   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
 828   #for agentnum
 829   my $addl_from = ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
 830                   ' LEFT JOIN cust_main USING ( custnum )'.
 831                   ' LEFT JOIN part_svc  USING ( svcpart )';
 832
 833   (
 834     'table'     => 'cust_svc',
 835     'addl_from' => $addl_from,
 836     'hashref'   => {},
 837     'extra_sql' => $extra_sql,
 838   );
 839 }
 840
 841 =back
 842
 843 =head1 BUGS
 844
 845 Behaviour of changing the svcpart of cust_svc records is undefined and should
 846 possibly be prohibited, and pkg_svc records are not checked.
 847
 848 pkg_svc records are not checked in general (here).
 849
 850 Deleting this record doesn't check or delete the svc_* record associated
 851 with this record.
 852
 853 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
 854 a DBI database handle is not yet implemented.
 855
 856 =head1 SEE ALSO
 857
 858 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 859 schema.html from the base documentation
 860
 861 =cut
 862
 863 1;
 864