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