FS/FS/cust_svc.pm

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