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