FS/FS/cust_svc.pm

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