FS/FS/cust_svc.pm

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