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   #my $error = $new->SUPER::replace($old, @_);
 299   my $error = $new->SUPER::replace($old);
 300   if ( $error ) {
 301     $dbh->rollback if $oldAutoCommit;
 302     return $error if $error;
 303   }
 304
 305   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 306   ''; #no error
 307
 308 }
 309
 310 =item check
 311
 312 Checks all fields to make sure this is a valid service.  If there is an error,
 313 returns the error, otherwise returns false.  Called by the insert and
 314 replace methods.
 315
 316 =cut
 317
 318 sub check {
 319   my $self = shift;
 320
 321   my $error =
 322     $self->ut_numbern('svcnum')
 323     || $self->ut_numbern('pkgnum')
 324     || $self->ut_number('svcpart')
 325     || $self->ut_numbern('agent_svcid')
 326     || $self->ut_numbern('overlimit')
 327   ;
 328   return $error if $error;
 329
 330   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 331   return "Unknown svcpart" unless $part_svc;
 332
 333   if ( $self->pkgnum ) {
 334     my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 335     return "Unknown pkgnum" unless $cust_pkg;
 336     ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
 337     return "No svcpart ". $self->svcpart.
 338            " services in pkgpart ". $cust_pkg->pkgpart
 339       unless $part_svc || $ignore_quantity;
 340     return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
 341            " services for pkgnum ". $self->pkgnum
 342       if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ;
 343   }
 344
 345   $self->SUPER::check;
 346 }
 347
 348 =item display_svcnum
 349
 350 Returns the displayed service number for this service: agent_svcid if it has a
 351 value, svcnum otherwise
 352
 353 =cut
 354
 355 sub display_svcnum {
 356   my $self = shift;
 357   $self->agent_svcid || $self->svcnum;
 358 }
 359
 360 =item part_svc
 361
 362 Returns the definition for this service, as a FS::part_svc object (see
 363 L<FS::part_svc>).
 364
 365 =cut
 366
 367 sub part_svc {
 368   my $self = shift;
 369   $self->{'_svcpart'}
 370     ? $self->{'_svcpart'}
 371     : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 372 }
 373
 374 =item cust_pkg
 375
 376 Returns the package this service belongs to, as a FS::cust_pkg object (see
 377 L<FS::cust_pkg>).
 378
 379 =cut
 380
 381 sub cust_pkg {
 382   my $self = shift;
 383   qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
 384 }
 385
 386 =item pkg_svc
 387
 388 Returns the pkg_svc record for for this service, if applicable.
 389
 390 =cut
 391
 392 sub pkg_svc {
 393   my $self = shift;
 394   my $cust_pkg = $self->cust_pkg;
 395   return undef unless $cust_pkg;
 396
 397   qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
 398                          'pkgpart' => $cust_pkg->pkgpart,
 399                        }
 400           );
 401 }
 402
 403 =item date_inserted
 404
 405 Returns the date this service was inserted.
 406
 407 =cut
 408
 409 sub date_inserted {
 410   my $self = shift;
 411   $self->h_date('insert');
 412 }
 413
 414 =item pkg_cancel_date
 415
 416 Returns the date this service's package was canceled.  This normally only
 417 exists for a service that's been preserved through cancellation with the
 418 part_pkg.preserve flag.
 419
 420 =cut
 421
 422 sub pkg_cancel_date {
 423   my $self = shift;
 424   my $cust_pkg = $self->cust_pkg or return;
 425   return $cust_pkg->getfield('cancel') || '';
 426 }
 427
 428 =item label
 429
 430 Returns a list consisting of:
 431 - The name of this service (from part_svc)
 432 - A meaningful identifier (username, domain, or mail alias)
 433 - The table name (i.e. svc_domain) for this service
 434 - svcnum
 435
 436 Usage example:
 437
 438   my($label, $value, $svcdb) = $cust_svc->label;
 439
 440 =item label_long
 441
 442 Like the B<label> method, except the second item in the list ("meaningful
 443 identifier") may be longer - typically, a full name is included.
 444
 445 =cut
 446
 447 sub label      { shift->_label('svc_label',      @_); }
 448 sub label_long { shift->_label('svc_label_long', @_); }
 449
 450 sub _label {
 451   my $self = shift;
 452   my $method = shift;
 453   my $svc_x = $self->svc_x
 454     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 455
 456   $self->$method($svc_x);
 457 }
 458
 459 sub svc_label      { shift->_svc_label('label',      @_); }
 460 sub svc_label_long { shift->_svc_label('label_long', @_); }
 461
 462 sub _svc_label {
 463   my( $self, $method, $svc_x ) = ( shift, shift, shift );
 464
 465   (
 466     $self->part_svc->svc,
 467     $svc_x->$method(@_),
 468     $self->part_svc->svcdb,
 469     $self->svcnum
 470   );
 471
 472 }
 473
 474 =item export_links
 475
 476 Returns a listref of html elements associated with this service's exports.
 477
 478 =cut
 479
 480 sub export_links {
 481   my $self = shift;
 482   my $svc_x = $self->svc_x
 483     or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
 484
 485   $svc_x->export_links;
 486 }
 487
 488 =item export_getsettings
 489
 490 Returns two hashrefs of settings associated with this service's exports.
 491
 492 =cut
 493
 494 sub export_getsettings {
 495   my $self = shift;
 496   my $svc_x = $self->svc_x
 497     or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
 498
 499   $svc_x->export_getsettings;
 500 }
 501
 502
 503 =item svc_x
 504
 505 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
 506 FS::svc_domain object, etc.)
 507
 508 =cut
 509
 510 sub svc_x {
 511   my $self = shift;
 512   my $svcdb = $self->part_svc->svcdb;
 513   if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
 514     $self->{'_svc_acct'};
 515   } else {
 516     require "FS/$svcdb.pm";
 517     warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
 518          ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
 519       if $DEBUG;
 520     qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
 521   }
 522 }
 523
 524 =item seconds_since TIMESTAMP
 525
 526 See L<FS::svc_acct/seconds_since>.  Equivalent to
 527 $cust_svc->svc_x->seconds_since, but more efficient.  Meaningless for records
 528 where B<svcdb> is not "svc_acct".
 529
 530 =cut
 531
 532 #internal session db deprecated (or at least on hold)
 533 sub seconds_since { 'internal session db deprecated'; };
 534 ##note: implementation here, POD in FS::svc_acct
 535 #sub seconds_since {
 536 #  my($self, $since) = @_;
 537 #  my $dbh = dbh;
 538 #  my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
 539 #                              WHERE svcnum = ?
 540 #                                AND login >= ?
 541 #                                AND logout IS NOT NULL'
 542 #  ) or die $dbh->errstr;
 543 #  $sth->execute($self->svcnum, $since) or die $sth->errstr;
 544 #  $sth->fetchrow_arrayref->[0];
 545 #}
 546
 547 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
 548
 549 See L<FS::svc_acct/seconds_since_sqlradacct>.  Equivalent to
 550 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient.  Meaningless
 551 for records where B<svcdb> is not "svc_acct".
 552
 553 =cut
 554
 555 #note: implementation here, POD in FS::svc_acct
 556 sub seconds_since_sqlradacct {
 557   my($self, $start, $end) = @_;
 558
 559   my $mes = "$me seconds_since_sqlradacct:";
 560
 561   my $svc_x = $self->svc_x;
 562
 563   my @part_export = $self->part_svc->part_export_usage;
 564   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 565       " service definition"
 566     unless @part_export;
 567     #or return undef;
 568
 569   my $seconds = 0;
 570   foreach my $part_export ( @part_export ) {
 571
 572     next if $part_export->option('ignore_accounting');
 573
 574     warn "$mes connecting to sqlradius database\n"
 575       if $DEBUG;
 576
 577     my $dbh = DBI->connect( map { $part_export->option($_) }
 578                             qw(datasrc username password)    )
 579       or die "can't connect to sqlradius database: ". $DBI::errstr;
 580
 581     warn "$mes connected to sqlradius database\n"
 582       if $DEBUG;
 583
 584     #select a unix time conversion function based on database type
 585     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 586
 587     my $username = $part_export->export_username($svc_x);
 588
 589     my $query;
 590
 591     warn "$mes finding closed sessions completely within the given range\n"
 592       if $DEBUG;
 593
 594     my $realm = '';
 595     my $realmparam = '';
 596     if ($part_export->option('process_single_realm')) {
 597       $realm = 'AND Realm = ?';
 598       $realmparam = $part_export->option('realm');
 599     }
 600
 601     my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
 602                                FROM radacct
 603                                WHERE UserName = ?
 604                                  $realm
 605                                  AND $str2time AcctStartTime) >= ?
 606                                  AND $str2time AcctStopTime ) <  ?
 607                                  AND $str2time AcctStopTime ) > 0
 608                                  AND AcctStopTime IS NOT NULL"
 609     ) or die $dbh->errstr;
 610     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 611       or die $sth->errstr;
 612     my $regular = $sth->fetchrow_arrayref->[0];
 613
 614     warn "$mes finding open sessions which start in the range\n"
 615       if $DEBUG;
 616
 617     # count session start->range end
 618     $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
 619                 FROM radacct
 620                 WHERE UserName = ?
 621                   $realm
 622                   AND $str2time AcctStartTime ) >= ?
 623                   AND $str2time AcctStartTime ) <  ?
 624                   AND ( ? - $str2time AcctStartTime ) ) < 86400
 625                   AND (    $str2time AcctStopTime ) = 0
 626                                     OR AcctStopTime IS NULL )";
 627     $sth = $dbh->prepare($query) or die $dbh->errstr;
 628     $sth->execute( $end,
 629                    $username,
 630                    ($realm ? $realmparam : ()),
 631                    $start,
 632                    $end,
 633                    $end )
 634       or die $sth->errstr. " executing query $query";
 635     my $start_during = $sth->fetchrow_arrayref->[0];
 636
 637     warn "$mes finding closed sessions which start before the range but stop during\n"
 638       if $DEBUG;
 639
 640     #count range start->session end
 641     $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
 642                             FROM radacct
 643                             WHERE UserName = ?
 644                               $realm
 645                               AND $str2time AcctStartTime ) < ?
 646                               AND $str2time AcctStopTime  ) >= ?
 647                               AND $str2time AcctStopTime  ) <  ?
 648                               AND $str2time AcctStopTime ) > 0
 649                               AND AcctStopTime IS NOT NULL"
 650     ) or die $dbh->errstr;
 651     $sth->execute( $start,
 652                    $username,
 653                    ($realm ? $realmparam : ()),
 654                    $start,
 655                    $start,
 656                    $end )
 657       or die $sth->errstr;
 658     my $end_during = $sth->fetchrow_arrayref->[0];
 659
 660     warn "$mes finding closed sessions which start before the range but stop after\n"
 661       if $DEBUG;
 662
 663     # count range start->range end
 664     # don't count open sessions anymore (probably missing stop record)
 665     $sth = $dbh->prepare("SELECT COUNT(*)
 666                             FROM radacct
 667                             WHERE UserName = ?
 668                               $realm
 669                               AND $str2time AcctStartTime ) < ?
 670                               AND ( $str2time AcctStopTime ) >= ?
 671                                                                   )"
 672                               #      OR AcctStopTime =  0
 673                               #      OR AcctStopTime IS NULL       )"
 674     ) or die $dbh->errstr;
 675     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
 676       or die $sth->errstr;
 677     my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
 678
 679     $seconds += $regular + $end_during + $start_during + $entire_range;
 680
 681     warn "$mes done finding sessions\n"
 682       if $DEBUG;
 683
 684   }
 685
 686   $seconds;
 687
 688 }
 689
 690 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
 691
 692 See L<FS::svc_acct/attribute_since_sqlradacct>.  Equivalent to
 693 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.  Meaningless
 694 for records where B<svcdb> is not "svc_acct".
 695
 696 =cut
 697
 698 #note: implementation here, POD in FS::svc_acct
 699 #(false laziness w/seconds_since_sqlradacct above)
 700 sub attribute_since_sqlradacct {
 701   my($self, $start, $end, $attrib) = @_;
 702
 703   my $mes = "$me attribute_since_sqlradacct:";
 704
 705   my $svc_x = $self->svc_x;
 706
 707   my @part_export = $self->part_svc->part_export_usage;
 708   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 709       " service definition"
 710     unless @part_export;
 711     #or return undef;
 712
 713   my $sum = 0;
 714
 715   foreach my $part_export ( @part_export ) {
 716
 717     next if $part_export->option('ignore_accounting');
 718
 719     warn "$mes connecting to sqlradius database\n"
 720       if $DEBUG;
 721
 722     my $dbh = DBI->connect( map { $part_export->option($_) }
 723                             qw(datasrc username password)    )
 724       or die "can't connect to sqlradius database: ". $DBI::errstr;
 725
 726     warn "$mes connected to sqlradius database\n"
 727       if $DEBUG;
 728
 729     #select a unix time conversion function based on database type
 730     my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 731
 732     my $username = $part_export->export_username($svc_x);
 733
 734     warn "$mes SUMing $attrib sessions\n"
 735       if $DEBUG;
 736
 737     my $realm = '';
 738     my $realmparam = '';
 739     if ($part_export->option('process_single_realm')) {
 740       $realm = 'AND Realm = ?';
 741       $realmparam = $part_export->option('realm');
 742     }
 743
 744     my $sth = $dbh->prepare("SELECT SUM($attrib)
 745                                FROM radacct
 746                                WHERE UserName = ?
 747                                  $realm
 748                                  AND $str2time AcctStopTime ) >= ?
 749                                  AND $str2time AcctStopTime ) <  ?
 750                                  AND AcctStopTime IS NOT NULL"
 751     ) or die $dbh->errstr;
 752     $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
 753       or die $sth->errstr;
 754
 755     my $row = $sth->fetchrow_arrayref;
 756     $sum += $row->[0] if defined($row->[0]);
 757
 758     warn "$mes done SUMing sessions\n"
 759       if $DEBUG;
 760
 761   }
 762
 763   $sum;
 764
 765 }
 766
 767 =item get_session_history TIMESTAMP_START TIMESTAMP_END
 768
 769 See L<FS::svc_acct/get_session_history>.  Equivalent to
 770 $cust_svc->svc_x->get_session_history, but more efficient.  Meaningless for
 771 records where B<svcdb> is not "svc_acct".
 772
 773 =cut
 774
 775 sub get_session_history {
 776   my($self, $start, $end, $attrib) = @_;
 777
 778   #$attrib ???
 779
 780   my @part_export = $self->part_svc->part_export_usage;
 781   die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
 782       " service definition"
 783     unless @part_export;
 784     #or return undef;
 785
 786   my @sessions = ();
 787
 788   foreach my $part_export ( @part_export ) {
 789     push @sessions,
 790       @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
 791   }
 792
 793   @sessions;
 794
 795 }
 796
 797 =item tickets
 798
 799 Returns an array of hashes representing the tickets linked to this service.
 800
 801 =cut
 802
 803 sub tickets {
 804   my $self = shift;
 805
 806   my $conf = FS::Conf->new;
 807   my $num = $conf->config('cust_main-max_tickets') || 10;
 808   my @tickets = ();
 809
 810   if ( $conf->config('ticket_system') ) {
 811     unless ( $conf->config('ticket_system-custom_priority_field') ) {
 812
 813       @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) };
 814
 815     } else {
 816
 817       foreach my $priority (
 818         $conf->config('ticket_system-custom_priority_field-values'), ''
 819       ) {
 820         last if scalar(@tickets) >= $num;
 821         push @tickets,
 822         @{ FS::TicketSystem->service_tickets( $self->svcnum,
 823             $num - scalar(@tickets),
 824             $priority,
 825           )
 826         };
 827       }
 828     }
 829   }
 830   (@tickets);
 831 }
 832
 833
 834 =back
 835
 836 =head1 SUBROUTINES
 837
 838 =over 4
 839
 840 =item smart_search OPTION => VALUE ...
 841
 842 Accepts the option I<search>, the string to search for.  The string will
 843 be searched for as a username, email address, IP address, MAC address,
 844 phone number, and hardware serial number.  Unlike the I<smart_search> on
 845 customers, this always requires an exact match.
 846
 847 =cut
 848
 849 # though perhaps it should be fuzzy in some cases?
 850
 851 sub smart_search {
 852   my %param = __PACKAGE__->smart_search_param(@_);
 853   qsearch(\%param);
 854 }
 855
 856 sub smart_search_param {
 857   my $class = shift;
 858   my %opt = @_;
 859
 860   my $string = $opt{'search'};
 861   $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
 862
 863   my @or =
 864       map { my $table = $_;
 865             my $search_sql = "FS::$table"->search_sql($string);
 866             " ( svcdb = '$table'
 867                 AND 0 < ( SELECT COUNT(*) FROM $table
 868                             WHERE $table.svcnum = cust_svc.svcnum
 869                               AND $search_sql
 870                         )
 871               ) ";
 872           }
 873       FS::part_svc->svc_tables;
 874
 875   if ( $string =~ /^(\d+)$/ ) {
 876     unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
 877   }
 878
 879   my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
 880
 881   push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
 882     'null_right' => 'View/link unlinked services'
 883   );
 884   my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
 885   #for agentnum
 886   my $addl_from = ' LEFT JOIN cust_pkg  USING ( pkgnum  )'.
 887                   FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
 888                   ' LEFT JOIN part_svc  USING ( svcpart )';
 889
 890   (
 891     'table'     => 'cust_svc',
 892     'addl_from' => $addl_from,
 893     'hashref'   => {},
 894     'extra_sql' => $extra_sql,
 895   );
 896 }
 897
 898 sub _upgrade_data {
 899   my $class = shift;
 900
 901   # fix missing (deleted by mistake) svc_x records
 902   warn "searching for missing svc_x records...\n";
 903   my %search = (
 904     'table'     => 'cust_svc',
 905     'select'    => 'cust_svc.*',
 906     'addl_from' => ' LEFT JOIN ( ' .
 907       join(' UNION ',
 908         map { "SELECT svcnum FROM $_" }
 909         FS::part_svc->svc_tables
 910       ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
 911     'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
 912   );
 913   my @svcs = qsearch(\%search);
 914   warn "found ".scalar(@svcs)."\n";
 915
 916   local $FS::Record::nowarn_classload = 1; # for h_svc_
 917   local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
 918
 919   my %h_search = (
 920     'hashref'  => { history_action => 'delete' },
 921     'order_by' => ' ORDER BY history_date DESC LIMIT 1',
 922   );
 923   foreach my $cust_svc (@svcs) {
 924     my $svcnum = $cust_svc->svcnum;
 925     my $svcdb = $cust_svc->part_svc->svcdb;
 926     $h_search{'hashref'}{'svcnum'} = $svcnum;
 927     $h_search{'table'} = "h_$svcdb";
 928     my $h_svc_x = qsearchs(\%h_search)
 929       or next;
 930     my $class = "FS::$svcdb";
 931     my $new_svc_x = $class->new({ $h_svc_x->hash });
 932     my $error = $new_svc_x->insert;
 933     warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
 934       if $error;
 935   }
 936
 937   '';
 938 }
 939
 940 =back
 941
 942 =head1 BUGS
 943
 944 Behaviour of changing the svcpart of cust_svc records is undefined and should
 945 possibly be prohibited, and pkg_svc records are not checked.
 946
 947 pkg_svc records are not checked in general (here).
 948
 949 Deleting this record doesn't check or delete the svc_* record associated
 950 with this record.
 951
 952 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
 953 a DBI database handle is not yet implemented.
 954
 955 =head1 SEE ALSO
 956
 957 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
 958 schema.html from the base documentation
 959
 960 =cut
 961
 962 1;
 963