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