FS/FS/cust_svc.pm

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