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