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