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
 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
 660     my $username = $part_export->export_username($svc_x);
 661
 662     my $query;
 663
 664     warn "$mes finding closed sessions completely within the given range\n"
 665       if $DEBUG;
 666
 667     my $realm = '';
 668     my $realmparam = '';
 669     if ($part_export->option('process_single_realm')) {
 670       $realm = 'AND Realm = ?';
 671       $realmparam = $part_export->option('realm');
 672     }
 673
 674     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 675                                FROM radacct
 676                                WHERE UserName = ?
 677                                  $realm
 678                                  AND $str2time AcctStartTime) >= ?
 679                                  AND $str2time AcctStopTime ) <  ?
 680                                  AND $str2time AcctStopTime ) > 0
 681                                  AND AcctStopTime IS NOT NULL"
 682     ) or die $dbh->errstr;
 683     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 684       or die $sth->errstr;
 685     my $regular = $sth->fetchrow_arrayref->[0];
 686
 687     warn "$mes finding open sessions which start in the range\n"
 688       if $DEBUG;
 689
 690     # count session start->range end
 691     $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
 692                 FROM radacct
 693                 WHERE UserName = ?
 694                   $realm
 695                   AND $str2time AcctStartTime ) >= ?
 696                   AND $str2time AcctStartTime ) <  ?
 697                   AND ( ? - $str2time AcctStartTime ) ) < 86400
 698                   AND (    $str2time AcctStopTime ) = 0
 699                                     OR AcctStopTime IS NULL )";
 700     $sth = $dbh->prepare($query) or die $dbh->errstr;
 701     $sth->execute( $end,
 702                    $username,
 703                    ($realm ? $realmparam : ()),
 704                    $start,
 705                    $end,
 706                    $end )
 707       or die $sth->errstr. " executing query $query";
 708     my $start_during = $sth->fetchrow_arrayref->[0];
 709
 710     warn "$mes finding closed sessions which start before the range but stop during\n"
 711       if $DEBUG;
 712
 713     #count range start->session end
 714     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
 715                             FROM radacct
 716                             WHERE UserName = ?
 717                               $realm
 718                               AND $str2time AcctStartTime ) < ?
 719                               AND $str2time AcctStopTime  ) >= ?
 720                               AND $str2time AcctStopTime  ) <  ?
 721                               AND $str2time AcctStopTime ) > 0
 722                               AND AcctStopTime IS NOT NULL"
 723     ) or die $dbh->errstr;
 724     $sth->execute( $start,
 725                    $username,
 726                    ($realm ? $realmparam : ()),
 727                    $start,
 728                    $start,
 729                    $end )
 730       or die $sth->errstr;
 731     my $end_during = $sth->fetchrow_arrayref->[0];
 732
 733     warn "$mes finding closed sessions which start before the range but stop after\n"
 734       if $DEBUG;
 735
 736     # count range start->range end
 737     # don't count open sessions anymore (probably missing stop record)
 738     $sth = $dbh->prepare("SELECT COUNT(*)
 739                             FROM radacct
 740                             WHERE UserName = ?
 741                               $realm
 742                               AND $str2time AcctStartTime ) < ?
 743                               AND ( $str2time AcctStopTime ) >= ?
 744                                                                   )"
 745                               #      OR AcctStopTime =  0
 746                               #      OR AcctStopTime IS NULL       )"
 747     ) or die $dbh->errstr;
 748     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 749       or die $sth->errstr;
 750     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 751
 752     $seconds += $regular + $end_during + $start_during + $entire_range;
 753
 754     warn "$mes done finding sessions\n"
 755       if $DEBUG;
 756
 757   }
 758
 759   $seconds;
 760
 761 }
 762
 763 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 764
 765 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 766 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 767 for records where B<svcdb> is not "svc_acct".
 768
 769 =cut
 770
 771 #note: implementation here, POD in FS::svc_acct
 772 #(false laziness w/seconds_since_sqlradacct above)
 773 sub attribute_since_sqlradacct {
 774   my($self, $start, $end, $attrib) = @_;
 775
 776   my $mes = "$me attribute_since_sqlradacct:";
 777
 778   my $svc_x = $self->svc_x;
 779
 780   my @part_export = $self->part_svc->part_export_usage;
 781   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 782       " service definition"
 783     unless @part_export;
 784     #or return undef;
 785
 786   my $sum = 0;
 787
 788   foreach my $part_export ( @part_export ) {
 789
 790     next if $part_export->option('ignore_accounting');
 791
 792     warn "$mes connecting to sqlradius database\n"
 793       if $DEBUG;
 794
 795     my $dbh = DBI->connect( map { $part_export->option($_) }
 796                             qw(datasrc username password)    )
 797       or die "can't connect to sqlradius database: ". $DBI::errstr;
 798
 799     warn "$mes connected to sqlradius database\n"
 800       if $DEBUG;
 801
 802     #select a unix time conversion function based on database type
 803     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 804
 805     my $username = $part_export->export_username($svc_x);
 806
 807     warn "$mes SUMing $attrib sessions\n"
 808       if $DEBUG;
 809
 810     my $realm = '';
 811     my $realmparam = '';
 812     if ($part_export->option('process_single_realm')) {
 813       $realm = 'AND Realm = ?';
 814       $realmparam = $part_export->option('realm');
 815     }
 816
 817     my $sth = $dbh->prepare("SELECT SUM($attrib)
 818                                FROM radacct
 819                                WHERE UserName = ?
 820                                  $realm
 821                                  AND $str2time AcctStopTime ) >= ?
 822                                  AND $str2time AcctStopTime ) <  ?
 823                                  AND AcctStopTime IS NOT NULL"
 824     ) or die $dbh->errstr;
 825     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 826       or die $sth->errstr;
 827
 828     my $row = $sth->fetchrow_arrayref;
 829     $sum += $row->[0] if defined($row->[0]);
 830
 831     warn "$mes done SUMing sessions\n"
 832       if $DEBUG;
 833
 834   }
 835
 836   $sum;
 837
 838 }
 839
 840 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 841
 842 See L<FS::svc_acct/get_session_history>.  Equivalent to
 843 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 844 records where B<svcdb> is not "svc_acct".
 845
 846 =cut
 847
 848 sub get_session_history {
 849   my($self, $start, $end, $attrib) = @_;
 850
 851   #$attrib ???
 852
 853   my @part_export = $self->part_svc->part_export_usage;
 854   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 855       " service definition"
 856     unless @part_export;
 857     #or return undef;
 858
 859   my @sessions = ();
 860
 861   foreach my $part_export ( @part_export ) {
 862     push @sessions,
 863       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
 864   }
 865
 866   @sessions;
 867
 868 }
 869
 870 =item tickets  [ STATUS ]
 871
 872 Returns an array of hashes representing the tickets linked to this service.
 873
 874 An optional status (or arrayref or hashref of statuses) may be specified.
 875
 876 =cut
 877
 878 sub tickets {
 879   my $self = shift;
 880   my $status = ( @_ && $_[0] ) ? shift : '';
 881
 882   my $conf = FS::Conf->new;
 883   my $num = $conf->config('cust_main-max_tickets') || 10;
 884   my @tickets = ();
 885
 886   if ( $conf->config('ticket_system') ) {
 887     unless ( $conf->config('ticket_system-custom_priority_field') ) {
 888
 889       @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
 890                                                        $num,
 891                                                        undef,
 892                                                        $status,
 893                                                      )
 894                   };
 895
 896     } else {
 897
 898       foreach my $priority (
 899         $conf->config('ticket_system-custom_priority_field-values'), ''
 900       ) {
 901         last if scalar(@tickets) >= $num;
 902         push @tickets,
 903         @{ FS::TicketSystem->service_tickets( $self->svcnum,
 904                                               $num - scalar(@tickets),
 905                                               $priority,
 906                                               $status,
 907                                             )
 908          };
 909       }
 910     }
 911   }
 912   (@tickets);
 913 }
 914
 915
 916 =back
 917
 918 =head1 SUBROUTINES
 919
 920 =over 4
 921
 922 =item smart_search OPTION => VALUE ...
 923
 924 Accepts the option I<search>, the string to search for.  The string will
 925 be searched for as a username, email address, IP address, MAC address,
 926 phone number, and hardware serial number.  Unlike the I<smart_search> on
 927 customers, this always requires an exact match.
 928
 929 =cut
 930
 931 # though perhaps it should be fuzzy in some cases?
 932
 933 sub smart_search {
 934   my %param = __PACKAGE__->smart_search_param(@_);
 935   qsearch(\%param);
 936 }
 937
 938 sub smart_search_param {
 939   my $class = shift;
 940   my %opt = @_;
 941
 942   my $string = $opt{'search'};
 943   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
 944
 945   my @or =
 946       map { my $table = $_;
 947             my $search_sql = "FS::$table"->search_sql($string);
 948
 949             "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
 950             "FROM $table WHERE $search_sql";
 951           }
 952       FS::part_svc->svc_tables;
 953
 954   if ( $string =~ /^(\d+)$/ ) {
 955     unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
 956   }
 957
 958   my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
 959                   " ON (svc_all.svcnum = cust_svc.svcnum) ";
 960
 961   my @extra_sql;
 962
 963   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
 964     'null_right' => 'View/link unlinked services'
 965   );
 966   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
 967   #for agentnum
 968   $addl_from  .=  ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
 969                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
 970                   ' LEFT JOIN part_svc  USING ( svcpart )';
 971
 972   (
 973     'table'     => 'cust_svc',
 974     'select'    => 'svc_all.svcnum AS svcnum, '.
 975                    'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
 976                    'cust_svc.*',
 977     'addl_from' => $addl_from,
 978     'hashref'   => {},
 979     'extra_sql' => $extra_sql,
 980   );
 981 }
 982
 983 sub _upgrade_data {
 984   my $class = shift;
 985
 986   # fix missing (deleted by mistake) svc_x records
 987   warn "searching for missing svc_x records...\n";
 988   my %search = (
 989     'table'     => 'cust_svc',
 990     'select'    => 'cust_svc.*',
 991     'addl_from' => ' LEFT JOIN ( ' .
 992       join(' UNION ',
 993         map { "SELECT svcnum FROM $_" }
 994         FS::part_svc->svc_tables
 995       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
 996     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
 997   );
 998   my @svcs = qsearch(\%search);
 999   warn "found ".scalar(@svcs)."\n";
1000
1001   local $FS::Record::nowarn_classload = 1; # for h_svc_
1002   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1003
1004   my %h_search = (
1005     'hashref'  => { history_action => 'delete' },
1006     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1007   );
1008   foreach my $cust_svc (@svcs) {
1009     my $svcnum = $cust_svc->svcnum;
1010     my $svcdb = $cust_svc->part_svc->svcdb;
1011     $h_search{'hashref'}{'svcnum'} = $svcnum;
1012     $h_search{'table'} = "h_$svcdb";
1013     my $h_svc_x = qsearchs(\%h_search)
1014       or next;
1015     my $class = "FS::$svcdb";
1016     my $new_svc_x = $class->new({ $h_svc_x->hash });
1017     my $error = $new_svc_x->insert;
1018     warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1019       if $error;
1020   }
1021
1022   '';
1023 }
1024
1025 =back
1026
1027 =head1 BUGS
1028
1029 Behaviour of changing the svcpart of cust_svc records is undefined and should
1030 possibly be prohibited, and pkg_svc records are not checked.
1031
1032 pkg_svc records are not checked in general (here).
1033
1034 Deleting this record doesn't check or delete the svc_* record associated
1035 with this record.
1036
1037 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1038 a DBI database handle is not yet implemented.
1039
1040 =head1 SEE ALSO
1041
1042 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1043 schema.html from the base documentation
1044
1045 =cut
1046
1047 1;
1048