FS/FS/cust_svc.pm

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