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