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