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