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