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