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