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::part_svc_link;
  15 use FS::domain_record;
  16 use FS::part_export;
  17 use FS::cdr;
  18 use FS::UI::Web;
  19
  20 #most FS::svc_ classes are autoloaded in svc_x emthod
  21 use FS::svc_acct;  #this one is used in the cache stuff
  22
  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     #part_svc_link rules (only make sense in pkgpart context, and
 436     # skipping this when ignore_quantity is set DTRT when we're "forcing"
 437     # an implicit change here (location change triggered pkgpart change,
 438     # ->overlimit, bulk customer service changes)
 439     foreach my $part_svc_link ( $self->part_svc_link(
 440                                   link_type   => 'cust_svc_provision_restrict',
 441                                 )
 442     ) {
 443       return $part_svc_link->dst_svc. ' must be provisioned before '.
 444              $part_svc_link->src_svc
 445         unless qsearchs({
 446           'table'    => 'cust_svc',
 447           'hashref'  => { 'pkgnum'  => $self->pkgnum,
 448                           'svcpart' => $part_svc_link->dst_svcpart,
 449                         },
 450           'order_by' => 'LIMIT 1',
 451         });
 452     }
 453
 454   }
 455
 456   $self->SUPER::check;
 457 }
 458
 459 =item check_part_svc_link_unprovision
 460
 461 Checks service dependency unprovision rules for this service.
 462
 463 If there is an error, returns the error, otherwise returns false.
 464
 465 =cut
 466
 467 sub check_part_svc_link_unprovision {
 468   my $self = shift;
 469
 470   foreach my $part_svc_link ( $self->part_svc_link(
 471                                 link_type   => 'cust_svc_unprovision_restrict',
 472                               )
 473   ) {
 474     return $part_svc_link->dst_svc. ' must be unprovisioned before '.
 475            $part_svc_link->src_svc
 476       if qsearchs({
 477         'table'    => 'cust_svc',
 478         'hashref'  => { 'pkgnum'  => $self->pkgnum,
 479                         'svcpart' => $part_svc_link->dst_svcpart,
 480                       },
 481         'order_by' => 'LIMIT 1',
 482       });
 483   }
 484
 485   '';
 486 }
 487
 488 =item part_svc_link
 489
 490 Returns the service dependencies (see L<FS::part_svc_link>) for the given
 491 search options, taking into account this service definition as source and
 492 this customer's agent.
 493
 494 Available options are any field in part_svc_link.  Typically used options are
 495 link_type.
 496
 497 =cut
 498
 499 sub part_svc_link {
 500   my $self = shift;
 501   my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
 502   FS::part_svc_link->by_agentnum($agentnum, src_svcpart=>$self->svcpart, @_);
 503 }
 504
 505 =item display_svcnum
 506
 507 Returns the displayed service number for this service: agent_svcid if it has a
 508 value, svcnum otherwise
 509
 510 =cut
 511
 512 sub display_svcnum {
 513   my $self = shift;
 514   $self->agent_svcid || $self->svcnum;
 515 }
 516
 517 =item part_svc
 518
 519 Returns the definition for this service, as a FS::part_svc object (see
 520 L<FS::part_svc>).
 521
 522 =cut
 523
 524 sub part_svc {
 525   my $self = shift;
 526   $self->{'_svcpart'}
 527     ? $self->{'_svcpart'}
 528     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 529 }
 530
 531 =item cust_pkg
 532
 533 Returns the package this service belongs to, as a FS::cust_pkg object (see
 534 L<FS::cust_pkg>).
 535
 536 =item pkg_svc
 537
 538 Returns the pkg_svc record for for this service, if applicable.
 539
 540 =cut
 541
 542 sub pkg_svc {
 543   my $self = shift;
 544   my $cust_pkg = $self->cust_pkg;
 545   return undef unless $cust_pkg;
 546
 547   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 548                          'pkgpart' => $cust_pkg->pkgpart,
 549                        }
 550           );
 551 }
 552
 553 =item date_inserted
 554
 555 Returns the date this service was inserted.
 556
 557 =cut
 558
 559 sub date_inserted {
 560   my $self = shift;
 561   $self->h_date('insert');
 562 }
 563
 564 =item pkg_cancel_date
 565
 566 Returns the date this service's package was canceled.  This normally only
 567 exists for a service that's been preserved through cancellation with the
 568 part_pkg.preserve flag.
 569
 570 =cut
 571
 572 sub pkg_cancel_date {
 573   my $self = shift;
 574   my $cust_pkg = $self->cust_pkg or return;
 575   return $cust_pkg->getfield('cancel') || '';
 576 }
 577
 578 =item label
 579
 580 Returns a list consisting of:
 581 - The name of this service (from part_svc)
 582 - A meaningful identifier (username, domain, or mail alias)
 583 - The table name (i.e. svc_domain) for this service
 584 - svcnum
 585
 586 Usage example:
 587
 588   my($label, $value, $svcdb) = $cust_svc->label;
 589
 590 =item label_long
 591
 592 Like the B<label> method, except the second item in the list ("meaningful
 593 identifier") may be longer - typically, a full name is included.
 594
 595 =cut
 596
 597 sub label      { shift->_label('svc_label',      @_); }
 598 sub label_long { shift->_label('svc_label_long', @_); }
 599
 600 sub _label {
 601   my $self = shift;
 602   my $method = shift;
 603   my $svc_x = $self->svc_x
 604     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 605
 606   $self->$method($svc_x);
 607 }
 608
 609 sub svc_label      { shift->_svc_label('label',      @_); }
 610 sub svc_label_long { shift->_svc_label('label_long', @_); }
 611
 612 sub _svc_label {
 613   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 614
 615   (
 616     $self->part_svc->svc,
 617     $svc_x->$method(@_),
 618     $self->part_svc->svcdb,
 619     $self->svcnum
 620   );
 621
 622 }
 623
 624 =item export_links
 625
 626 Returns a listref of html elements associated with this service's exports.
 627
 628 =cut
 629
 630 sub export_links {
 631   my $self = shift;
 632   my $svc_x = $self->svc_x
 633     or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
 634
 635   $svc_x->export_links;
 636 }
 637
 638 =item export_getsettings
 639
 640 Returns two hashrefs of settings associated with this service's exports.
 641
 642 =cut
 643
 644 sub export_getsettings {
 645   my $self = shift;
 646   my $svc_x = $self->svc_x
 647     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 648
 649   $svc_x->export_getsettings;
 650 }
 651
 652
 653 =item svc_x
 654
 655 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 656 FS::svc_domain object, etc.)
 657
 658 =cut
 659
 660 sub svc_x {
 661   my $self = shift;
 662   my $svcdb = $self->part_svc->svcdb;
 663   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 664     $self->{'_svc_acct'};
 665   } else {
 666     require "FS/$svcdb.pm";
 667     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 668          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 669       if $DEBUG;
 670     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 671   }
 672 }
 673
 674 =item seconds_since TIMESTAMP
 675
 676 See L<FS::svc_acct/seconds_since>.  Equivalent to
 677 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 678 where B<svcdb> is not "svc_acct".
 679
 680 =cut
 681
 682 #internal session db deprecated (or at least on hold)
 683 sub seconds_since { 'internal session db deprecated'; };
 684 ##note: implementation here, POD in FS::svc_acct
 685 #sub seconds_since {
 686 #  my($self, $since) = @_;
 687 #  my $dbh = dbh;
 688 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 689 #                              WHERE svcnum = ?
 690 #                                AND login >= ?
 691 #                                AND logout IS NOT NULL'
 692 #  ) or die $dbh->errstr;
 693 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 694 #  $sth->fetchrow_arrayref->[0];
 695 #}
 696
 697 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 698
 699 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 700 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 701 for records where B<svcdb> is not "svc_acct".
 702
 703 =cut
 704
 705 #note: implementation here, POD in FS::svc_acct
 706 sub seconds_since_sqlradacct {
 707   my($self, $start, $end) = @_;
 708
 709   my $mes = "$me seconds_since_sqlradacct:";
 710
 711   my $svc_x = $self->svc_x;
 712
 713   my @part_export = $self->part_svc->part_export_usage;
 714   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 715       " service definition"
 716     unless @part_export;
 717     #or return undef;
 718
 719   my $seconds = 0;
 720   foreach my $part_export ( @part_export ) {
 721
 722     next if $part_export->option('ignore_accounting');
 723
 724     warn "$mes connecting to sqlradius database\n"
 725       if $DEBUG;
 726
 727     my $dbh = DBI->connect( map { $part_export->option($_) }
 728                             qw(datasrc username password)    )
 729       or die "can't connect to sqlradius database: ". $DBI::errstr;
 730
 731     warn "$mes connected to sqlradius database\n"
 732       if $DEBUG;
 733
 734     #select a unix time conversion function based on database type
 735     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 736     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 737
 738     my $username = $part_export->export_username($svc_x);
 739
 740     my $query;
 741
 742     warn "$mes finding closed sessions completely within the given range\n"
 743       if $DEBUG;
 744
 745     my $realm = '';
 746     my $realmparam = '';
 747     if ($part_export->option('process_single_realm')) {
 748       $realm = 'AND Realm = ?';
 749       $realmparam = $part_export->option('realm');
 750     }
 751
 752     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 753                                FROM radacct
 754                                WHERE UserName = ?
 755                                  $realm
 756                                  AND $str2time AcctStartTime $closing >= ?
 757                                  AND $str2time AcctStopTime  $closing <  ?
 758                                  AND $str2time AcctStopTime  $closing > 0
 759                                  AND AcctStopTime IS NOT NULL"
 760     ) or die $dbh->errstr;
 761     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 762       or die $sth->errstr;
 763     my $regular = $sth->fetchrow_arrayref->[0];
 764
 765     warn "$mes finding open sessions which start in the range\n"
 766       if $DEBUG;
 767
 768     # count session start->range end
 769     $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
 770                 FROM radacct
 771                 WHERE UserName = ?
 772                   $realm
 773                   AND $str2time AcctStartTime $closing >= ?
 774                   AND $str2time AcctStartTime $closing <  ?
 775                   AND ( ? - $str2time AcctStartTime $closing ) < 86400
 776                   AND (    $str2time AcctStopTime $closing = 0
 777                                     OR AcctStopTime IS NULL )";
 778     $sth = $dbh->prepare($query) or die $dbh->errstr;
 779     $sth->execute( $end,
 780                    $username,
 781                    ($realm ? $realmparam : ()),
 782                    $start,
 783                    $end,
 784                    $end )
 785       or die $sth->errstr. " executing query $query";
 786     my $start_during = $sth->fetchrow_arrayref->[0];
 787
 788     warn "$mes finding closed sessions which start before the range but stop during\n"
 789       if $DEBUG;
 790
 791     #count range start->session end
 792     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
 793                             FROM radacct
 794                             WHERE UserName = ?
 795                               $realm
 796                               AND $str2time AcctStartTime $closing < ?
 797                               AND $str2time AcctStopTime  $closing >= ?
 798                               AND $str2time AcctStopTime  $closing <  ?
 799                               AND $str2time AcctStopTime  $closing > 0
 800                               AND AcctStopTime IS NOT NULL"
 801     ) or die $dbh->errstr;
 802     $sth->execute( $start,
 803                    $username,
 804                    ($realm ? $realmparam : ()),
 805                    $start,
 806                    $start,
 807                    $end )
 808       or die $sth->errstr;
 809     my $end_during = $sth->fetchrow_arrayref->[0];
 810
 811     warn "$mes finding closed sessions which start before the range but stop after\n"
 812       if $DEBUG;
 813
 814     # count range start->range end
 815     # don't count open sessions anymore (probably missing stop record)
 816     $sth = $dbh->prepare("SELECT COUNT(*)
 817                             FROM radacct
 818                             WHERE UserName = ?
 819                               $realm
 820                               AND $str2time AcctStartTime $closing < ?
 821                               AND ( $str2time AcctStopTime $closing >= ?
 822                                                                   )"
 823                               #      OR AcctStopTime =  0
 824                               #      OR AcctStopTime IS NULL       )"
 825     ) or die $dbh->errstr;
 826     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 827       or die $sth->errstr;
 828     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 829
 830     $seconds += $regular + $end_during + $start_during + $entire_range;
 831
 832     warn "$mes done finding sessions\n"
 833       if $DEBUG;
 834
 835   }
 836
 837   $seconds;
 838
 839 }
 840
 841 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 842
 843 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 844 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 845 for records where B<svcdb> is not "svc_acct".
 846
 847 =cut
 848
 849 #note: implementation here, POD in FS::svc_acct
 850 #(false laziness w/seconds_since_sqlradacct above)
 851 sub attribute_since_sqlradacct {
 852   my($self, $start, $end, $attrib) = @_;
 853
 854   my $mes = "$me attribute_since_sqlradacct:";
 855
 856   my $svc_x = $self->svc_x;
 857
 858   my @part_export = $self->part_svc->part_export_usage;
 859   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 860       " service definition"
 861     unless @part_export;
 862     #or return undef;
 863
 864   my $sum = 0;
 865
 866   foreach my $part_export ( @part_export ) {
 867
 868     next if $part_export->option('ignore_accounting');
 869
 870     warn "$mes connecting to sqlradius database\n"
 871       if $DEBUG;
 872
 873     my $dbh = DBI->connect( map { $part_export->option($_) }
 874                             qw(datasrc username password)    )
 875       or die "can't connect to sqlradius database: ". $DBI::errstr;
 876
 877     warn "$mes connected to sqlradius database\n"
 878       if $DEBUG;
 879
 880     #select a unix time conversion function based on database type
 881     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 882     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 883
 884     my $username = $part_export->export_username($svc_x);
 885
 886     warn "$mes SUMing $attrib sessions\n"
 887       if $DEBUG;
 888
 889     my $realm = '';
 890     my $realmparam = '';
 891     if ($part_export->option('process_single_realm')) {
 892       $realm = 'AND Realm = ?';
 893       $realmparam = $part_export->option('realm');
 894     }
 895
 896     my $sth = $dbh->prepare("SELECT SUM($attrib)
 897                                FROM radacct
 898                                WHERE UserName = ?
 899                                  $realm
 900                                  AND $str2time AcctStopTime $closing >= ?
 901                                  AND $str2time AcctStopTime $closing <  ?
 902                                  AND AcctStopTime IS NOT NULL"
 903     ) or die $dbh->errstr;
 904     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 905       or die $sth->errstr;
 906
 907     my $row = $sth->fetchrow_arrayref;
 908     $sum += $row->[0] if defined($row->[0]);
 909
 910     warn "$mes done SUMing sessions\n"
 911       if $DEBUG;
 912
 913   }
 914
 915   $sum;
 916
 917 }
 918
 919 #note: implementation here, POD in FS::svc_acct
 920 # false laziness w/above
 921 sub attribute_last_sqlradacct {
 922   my($self, $attrib) = @_;
 923
 924   my $mes = "$me attribute_last_sqlradacct:";
 925
 926   my $svc_x = $self->svc_x;
 927
 928   my @part_export = $self->part_svc->part_export_usage;
 929   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 930       " service definition"
 931     unless @part_export;
 932     #or return undef;
 933
 934   my $value = '';
 935   my $AcctStartTime = 0;
 936
 937   foreach my $part_export ( @part_export ) {
 938
 939     next if $part_export->option('ignore_accounting');
 940
 941     warn "$mes connecting to sqlradius database\n"
 942       if $DEBUG;
 943
 944     my $dbh = DBI->connect( map { $part_export->option($_) }
 945                             qw(datasrc username password)    )
 946       or die "can't connect to sqlradius database: ". $DBI::errstr;
 947
 948     warn "$mes connected to sqlradius database\n"
 949       if $DEBUG;
 950
 951     #select a unix time conversion function based on database type
 952     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 953     my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
 954
 955     my $username = $part_export->export_username($svc_x);
 956
 957     warn "$mes finding most-recent $attrib\n"
 958       if $DEBUG;
 959
 960     my $realm = '';
 961     my $realmparam = '';
 962     if ($part_export->option('process_single_realm')) {
 963       $realm = 'AND Realm = ?';
 964       $realmparam = $part_export->option('realm');
 965     }
 966
 967     my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
 968                                FROM radacct
 969                                WHERE UserName = ?
 970                                  $realm
 971                                ORDER BY AcctStartTime DESC LIMIT 1
 972     ") or die $dbh->errstr;
 973     $sth->execute($username, ($realm ? $realmparam : ()) )
 974       or die $sth->errstr;
 975
 976     my $row = $sth->fetchrow_arrayref;
 977     if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
 978       $value = $row->[0];
 979       $AcctStartTime = $row->[1];
 980     }
 981
 982     warn "$mes done\n"
 983       if $DEBUG;
 984
 985   }
 986
 987   $value;
 988
 989 }
 990
 991 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 992
 993 See L<FS::svc_acct/get_session_history>.  Equivalent to
 994 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 995 records where B<svcdb> is not "svc_acct".
 996
 997 =cut
 998
 999 sub get_session_history {
1000   my($self, $start, $end, $attrib) = @_;
1001
1002   #$attrib ???
1003
1004   my @part_export = $self->part_svc->part_export_usage;
1005   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1006       " service definition"
1007     unless @part_export;
1008     #or return undef;
1009
1010   my @sessions = ();
1011
1012   foreach my $part_export ( @part_export ) {
1013     push @sessions,
1014       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1015   }
1016
1017   @sessions;
1018
1019 }
1020
1021 =item tickets  [ STATUS ]
1022
1023 Returns an array of hashes representing the tickets linked to this service.
1024
1025 An optional status (or arrayref or hashref of statuses) may be specified.
1026
1027 =cut
1028
1029 sub tickets {
1030   my $self = shift;
1031   my $status = ( @_ && $_[0] ) ? shift : '';
1032
1033   my $conf = FS::Conf->new;
1034   my $num = $conf->config('cust_main-max_tickets') || 10;
1035   my @tickets = ();
1036
1037   if ( $conf->config('ticket_system') ) {
1038     unless ( $conf->config('ticket_system-custom_priority_field') ) {
1039
1040       @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1041                                                        $num,
1042                                                        undef,
1043                                                        $status,
1044                                                      )
1045                   };
1046
1047     } else {
1048
1049       foreach my $priority (
1050         $conf->config('ticket_system-custom_priority_field-values'), ''
1051       ) {
1052         last if scalar(@tickets) >= $num;
1053         push @tickets,
1054         @{ FS::TicketSystem->service_tickets( $self->svcnum,
1055                                               $num - scalar(@tickets),
1056                                               $priority,
1057                                               $status,
1058                                             )
1059          };
1060       }
1061     }
1062   }
1063   (@tickets);
1064 }
1065
1066 sub API_getinfo {
1067   my $self = shift;
1068   my $svc_x = $self->svc_x;
1069  +{ ( map { $_=>$self->$_ } $self->fields ),
1070     ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ),
1071   };
1072 }
1073
1074 =back
1075
1076 =head1 SUBROUTINES
1077
1078 =over 4
1079
1080 =item smart_search OPTION => VALUE ...
1081
1082 Accepts the option I<search>, the string to search for.  The string will
1083 be searched for as a username, email address, IP address, MAC address,
1084 phone number, and hardware serial number.  Unlike the I<smart_search> on
1085 customers, this always requires an exact match.
1086
1087 =cut
1088
1089 # though perhaps it should be fuzzy in some cases?
1090
1091 sub smart_search {
1092   my %param = __PACKAGE__->smart_search_param(@_);
1093   qsearch(\%param);
1094 }
1095
1096 sub smart_search_param {
1097   my $class = shift;
1098   my %opt = @_;
1099
1100   my $string = $opt{'search'};
1101   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1102
1103   my @or =
1104       map { my $table = $_;
1105             my $search_sql = "FS::$table"->search_sql($string);
1106
1107             "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1108             "FROM $table WHERE $search_sql";
1109           }
1110       FS::part_svc->svc_tables;
1111
1112   if ( $string =~ /^(\d+)$/ ) {
1113     unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1114   }
1115
1116   my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1117                   " ON (svc_all.svcnum = cust_svc.svcnum) ";
1118
1119   my @extra_sql;
1120
1121   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1122     'null_right' => 'View/link unlinked services'
1123   );
1124   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1125   #for agentnum
1126   $addl_from  .=  ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
1127                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1128                   ' LEFT JOIN part_svc  USING ( svcpart )';
1129
1130   (
1131     'table'     => 'cust_svc',
1132     'select'    => 'svc_all.svcnum AS svcnum, '.
1133                    'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1134                    'cust_svc.*',
1135     'addl_from' => $addl_from,
1136     'hashref'   => {},
1137     'extra_sql' => $extra_sql,
1138   );
1139 }
1140
1141 sub _upgrade_data {
1142   my $class = shift;
1143
1144   # fix missing (deleted by mistake) svc_x records
1145   warn "searching for missing svc_x records...\n";
1146   my %search = (
1147     'table'     => 'cust_svc',
1148     'select'    => 'cust_svc.*',
1149     'addl_from' => ' LEFT JOIN ( ' .
1150       join(' UNION ',
1151         map { "SELECT svcnum FROM $_" }
1152         FS::part_svc->svc_tables
1153       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1154     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1155   );
1156   my @svcs = qsearch(\%search);
1157   warn "found ".scalar(@svcs)."\n";
1158
1159   local $FS::Record::nowarn_classload = 1; # for h_svc_
1160   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1161
1162   my %h_search = (
1163     'hashref'  => { history_action => 'delete' },
1164     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1165   );
1166   foreach my $cust_svc (@svcs) {
1167     my $svcnum = $cust_svc->svcnum;
1168     my $svcdb = $cust_svc->part_svc->svcdb;
1169     $h_search{'hashref'}{'svcnum'} = $svcnum;
1170     $h_search{'table'} = "h_$svcdb";
1171     my $h_svc_x = qsearchs(\%h_search)
1172       or next;
1173     my $class = "FS::$svcdb";
1174     my $new_svc_x = $class->new({ $h_svc_x->hash });
1175     my $error = $new_svc_x->insert;
1176     warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1177       if $error;
1178   }
1179
1180   '';
1181 }
1182
1183 =back
1184
1185 =head1 BUGS
1186
1187 Behaviour of changing the svcpart of cust_svc records is undefined and should
1188 possibly be prohibited, and pkg_svc records are not checked.
1189
1190 pkg_svc records are not checked in general (here).
1191
1192 Deleting this record doesn't check or delete the svc_* record associated
1193 with this record.
1194
1195 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1196 a DBI database handle is not yet implemented.
1197
1198 =head1 SEE ALSO
1199
1200 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1201 schema.html from the base documentation
1202
1203 =cut
1204
1205 1;
1206