FS/FS/cust_svc.pm

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