4 use vars qw( @ISA $DEBUG $me $ignore_quantity $conf $ticket_system );
6 #use Scalar::Util qw( blessed );
7 use List::Util qw( max );
9 use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing );
14 use FS::domain_record;
18 use FS::export_cust_svc;
20 #most FS::svc_ classes are autoloaded in svc_x emthod
21 use FS::svc_acct; #this one is used in the cache stuff
23 @ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
30 #ask FS::UID to run this stuff for us later
31 FS::UID->install_callback( sub {
33 $ticket_system = $conf->config('ticket_system')
36 our $cache_enabled = 0;
39 my( $self, $hashref ) = @_;
40 if ( $cache_enabled && $hashref->{'svc'} ) {
41 $self->{'_svcpart'} = FS::part_svc->new($hashref);
47 my ( $hashref, $cache ) = @_;
48 if ( $hashref->{'username'} ) {
49 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
51 if ( $hashref->{'svc'} ) {
52 $self->{'_svcpart'} = FS::part_svc->new($hashref);
58 FS::cust_svc - Object method for cust_svc objects
64 $record = new FS::cust_svc \%hash
65 $record = new FS::cust_svc { 'column' => 'value' };
67 $error = $record->insert;
69 $error = $new_record->replace($old_record);
71 $error = $record->delete;
73 $error = $record->check;
75 ($label, $value) = $record->label;
79 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
80 The following fields are currently supported:
84 =item svcnum - primary key (assigned automatically for new services)
86 =item pkgnum - Package (see L<FS::cust_pkg>)
88 =item svcpart - Service definition (see L<FS::part_svc>)
90 =item agent_svcid - Optional legacy service ID
92 =item overlimit - date the service exceeded its usage limit
102 Creates a new service. To add the refund to the database, see L<"insert">.
103 Services are normally created by creating FS::svc_ objects (see
104 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
108 sub table { 'cust_svc'; }
112 Adds this service to the database. If there is an error, returns the error,
113 otherwise returns false.
120 local $SIG{HUP} = 'IGNORE';
121 local $SIG{INT} = 'IGNORE';
122 local $SIG{QUIT} = 'IGNORE';
123 local $SIG{TERM} = 'IGNORE';
124 local $SIG{TSTP} = 'IGNORE';
125 local $SIG{PIPE} = 'IGNORE';
127 my $oldAutoCommit = $FS::UID::AutoCommit;
128 local $FS::UID::AutoCommit = 0;
131 my $error = $self->SUPER::insert;
133 #check if this releases a hold (see FS::pkg_svc provision_hold)
134 $error ||= $self->_check_provision_hold;
137 $dbh->rollback if $oldAutoCommit;
138 return $error if $error
141 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
148 Deletes this service from the database. If there is an error, returns the
149 error, otherwise returns false. Note that this only removes the cust_svc
150 record - you should probably use the B<cancel> method instead.
159 my $cust_pkg = $self->cust_pkg;
160 my $custnum = $cust_pkg->custnum if $cust_pkg;
162 local $SIG{HUP} = 'IGNORE';
163 local $SIG{INT} = 'IGNORE';
164 local $SIG{QUIT} = 'IGNORE';
165 local $SIG{TERM} = 'IGNORE';
166 local $SIG{TSTP} = 'IGNORE';
167 local $SIG{PIPE} = 'IGNORE';
169 my $oldAutoCommit = $FS::UID::AutoCommit;
170 local $FS::UID::AutoCommit = 0;
173 # delete associated export_cust_svc
174 foreach my $export_cust_svc (
175 qsearch('export_cust_svc',{ 'svcnum' => $self->svcnum })
177 my $error = $export_cust_svc->delete;
179 $dbh->rollback if $oldAutoCommit;
184 my $error = $self->SUPER::delete;
186 $dbh->rollback if $oldAutoCommit;
190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
192 if ( $ticket_system eq 'RT_Internal' ) {
193 unless ( $rt_session ) {
194 FS::TicketSystem->init;
195 $rt_session = FS::TicketSystem->session;
197 my $links = RT::Links->new($rt_session->{CurrentUser});
198 my $svcnum = $self->svcnum;
199 $links->Limit(FIELD => 'Target',
200 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
201 while ( my $l = $links->Next ) {
204 # re-link to point to the customer instead
206 $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
209 ($val, $msg) = $l->Delete;
211 # can't do anything useful on error
212 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
219 Cancels the relevant service by calling the B<cancel> method of the associated
220 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
221 deleting the FS::svc_XXX record and then deleting this record.
223 If there is an error, returns the error, otherwise returns false.
230 local $SIG{HUP} = 'IGNORE';
231 local $SIG{INT} = 'IGNORE';
232 local $SIG{QUIT} = 'IGNORE';
233 local $SIG{TERM} = 'IGNORE';
234 local $SIG{TSTP} = 'IGNORE';
235 local $SIG{PIPE} = 'IGNORE';
237 my $oldAutoCommit = $FS::UID::AutoCommit;
238 local $FS::UID::AutoCommit = 0;
241 my $part_svc = $self->part_svc;
243 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
244 $dbh->rollback if $oldAutoCommit;
245 return "Illegal svcdb value in part_svc!";
248 require "FS/$svcdb.pm";
250 my $svc = $self->svc_x;
252 if ( %opt && $opt{'date'} ) {
253 my $error = $svc->expire($opt{'date'});
255 $dbh->rollback if $oldAutoCommit;
256 return "Error expiring service: $error";
259 my $error = $svc->cancel;
261 $dbh->rollback if $oldAutoCommit;
262 return "Error canceling service: $error";
264 $error = $svc->delete; #this deletes this cust_svc record as well
266 $dbh->rollback if $oldAutoCommit;
267 return "Error deleting service: $error";
274 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
275 "; deleting cust_svc only\n";
277 my $error = $self->delete;
279 $dbh->rollback if $oldAutoCommit;
280 return "Error deleting cust_svc: $error";
285 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
291 =item overlimit [ ACTION ]
293 Retrieves or sets the overlimit date. If ACTION is absent, return
294 the present value of overlimit. If ACTION is present, it can
295 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
296 is set to the current time if it is not already set. The 'unsuspend' value
297 causes the time to be cleared.
299 If there is an error on setting, returns the error, otherwise returns false.
305 my $action = shift or return $self->getfield('overlimit');
307 local $SIG{HUP} = 'IGNORE';
308 local $SIG{INT} = 'IGNORE';
309 local $SIG{QUIT} = 'IGNORE';
310 local $SIG{TERM} = 'IGNORE';
311 local $SIG{TSTP} = 'IGNORE';
312 local $SIG{PIPE} = 'IGNORE';
314 my $oldAutoCommit = $FS::UID::AutoCommit;
315 local $FS::UID::AutoCommit = 0;
318 if ( $action eq 'suspend' ) {
319 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
320 }elsif ( $action eq 'unsuspend' ) {
321 $self->setfield('overlimit', '');
323 die "unexpected action value: $action";
326 local $ignore_quantity = 1;
327 my $error = $self->replace;
329 $dbh->rollback if $oldAutoCommit;
330 return "Error setting overlimit: $error";
333 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
339 =item replace OLD_RECORD
341 Replaces the OLD_RECORD with this one in the database. If there is an error,
342 returns the error, otherwise returns false.
349 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
351 # : $new->replace_old;
352 my ( $new, $old ) = ( shift, shift );
353 $old = $new->replace_old unless defined($old);
355 local $SIG{HUP} = 'IGNORE';
356 local $SIG{INT} = 'IGNORE';
357 local $SIG{QUIT} = 'IGNORE';
358 local $SIG{TERM} = 'IGNORE';
359 local $SIG{TSTP} = 'IGNORE';
360 local $SIG{PIPE} = 'IGNORE';
362 my $oldAutoCommit = $FS::UID::AutoCommit;
363 local $FS::UID::AutoCommit = 0;
366 if ( $new->svcpart != $old->svcpart ) {
367 my $svc_x = $new->svc_x;
368 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
369 local($FS::Record::nowarn_identical) = 1;
370 my $error = $new_svc_x->replace($svc_x);
372 $dbh->rollback if $oldAutoCommit;
373 return $error if $error;
377 # #trigger a re-export on pkgnum changes?
378 # # (of prepaid packages), for Expiration RADIUS attribute
379 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
380 # my $svc_x = $new->svc_x;
381 # local($FS::Record::nowarn_identical) = 1;
382 # my $error = $svc_x->export('replace');
384 # $dbh->rollback if $oldAutoCommit;
385 # return $error if $error;
389 #trigger a pkg_change export on pkgnum changes
390 if ( $new->pkgnum != $old->pkgnum ) {
391 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
396 $dbh->rollback if $oldAutoCommit;
397 return $error if $error;
399 } # if pkgnum is changing
401 #my $error = $new->SUPER::replace($old, @_);
402 my $error = $new->SUPER::replace($old);
404 #trigger a relocate export on location changes (NENA2 and Northern 911 export)
405 my $old_pkg = $old->cust_pkg;
406 my $new_pkg = $new->cust_pkg;
407 if ( $old_pkg && $new_pkg && $new_pkg->locationnum != $old_pkg->locationnum ) {
408 my $svc_x = $new->svc_x;
409 if ( $svc_x->locationnum ) {
410 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
411 # in this case, set the service location to be the same as the new
413 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
414 # and replace it, which triggers a relocate export so we don't
416 $error ||= $svc_x->replace;
418 # the service already has a different location from its package
422 # the service doesn't have a locationnum (either isn't of a type
423 # that has the locationnum field, or the locationnum is null and
424 # defaults to cust_pkg->locationnum)
425 # so just trigger the export here
426 $error ||= $new->svc_x->export('relocate',
427 $new->cust_pkg->cust_location,
428 $old->cust_pkg->cust_location,
430 } # if ($svc_x->locationnum)
431 } # if this is a location change
433 #check if this releases a hold (see FS::pkg_svc provision_hold)
434 $error ||= $new->_check_provision_hold;
437 $dbh->rollback if $oldAutoCommit;
438 return $error if $error
441 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
448 Checks all fields to make sure this is a valid service. If there is an error,
449 returns the error, otherwise returns false. Called by the insert and
458 $self->ut_numbern('svcnum')
459 || $self->ut_numbern('pkgnum')
460 || $self->ut_number('svcpart')
461 || $self->ut_numbern('agent_svcid')
462 || $self->ut_numbern('overlimit')
464 return $error if $error;
466 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
467 return "Unknown svcpart" unless $part_svc;
469 if ( $self->pkgnum && ! $ignore_quantity ) {
471 #slightly inefficient since ->pkg_svc will also look it up, but fixing
472 # a much larger perf problem and have bigger fish to fry
473 my $cust_pkg = $self->cust_pkg;
475 my $pkg_svc = $self->pkg_svc
476 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
477 'pkgpart' => $cust_pkg->pkgpart,
481 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
482 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
483 my $addon_pkg_svc = qsearchs('pkg_svc', {
484 pkgpart => $part_pkg_link->dst_pkgpart,
485 svcpart => $self->svcpart,
487 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
491 #better error message? UI shouldn't get here
492 return "No svcpart ". $self->svcpart.
493 " services in pkgpart ". $cust_pkg->pkgpart
494 unless $pkg_svc->quantity > 0;
496 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
498 #false laziness w/cust_pkg->part_svc
499 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
503 #better error message? again, UI shouldn't get here
504 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
505 " services for pkgnum ". $self->pkgnum
515 Returns the displayed service number for this service: agent_svcid if it has a
516 value, svcnum otherwise
522 $self->agent_svcid || $self->svcnum;
527 Returns the definition for this service, as a FS::part_svc object (see
534 return $self->{_svcpart} if $self->{_svcpart};
535 cluck 'cust_svc->part_svc called' if $DEBUG;
536 qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
541 Returns the package this service belongs to, as a FS::cust_pkg object (see
548 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
553 Returns the pkg_svc record for for this service, if applicable.
559 my $cust_pkg = $self->cust_pkg;
560 return undef unless $cust_pkg;
562 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
563 'pkgpart' => $cust_pkg->pkgpart,
570 Returns the date this service was inserted.
576 $self->h_date('insert');
579 =item pkg_cancel_date
581 Returns the date this service's package was canceled. This normally only
582 exists for a service that's been preserved through cancellation with the
583 part_pkg.preserve flag.
587 sub pkg_cancel_date {
589 my $cust_pkg = $self->cust_pkg or return;
590 return $cust_pkg->getfield('cancel') || '';
593 =item label [ LOCALE ]
595 Returns a list consisting of:
596 - The name of this service (from part_svc), optionally localized
597 - A meaningful identifier (username, domain, or mail alias)
598 - The table name (i.e. svc_domain) for this service
603 my($label, $value, $svcdb) = $cust_svc->label;
605 =item label_long [ LOCALE ]
607 Like the B<label> method, except the second item in the list ("meaningful
608 identifier") may be longer - typically, a full name is included.
612 sub label { shift->_label('svc_label', @_); }
613 sub label_long { shift->_label('svc_label_long', @_); }
619 my $svc_x = $self->svc_x
620 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
622 $self->$method($svc_x, undef, undef, $locale);
625 # svc_label(_long) takes three arguments: end date, start date, locale
626 # and FS::svc_*::label methods must accept those also, if they even care
628 sub svc_label { shift->_svc_label('label', @_); }
629 sub svc_label_long { shift->_svc_label('label_long', @_); }
632 my( $self, $method, $svc_x ) = ( shift, shift, shift );
633 my ($end, $start, $locale) = @_;
636 $self->part_svc->svc_locale($locale),
638 $self->part_svc->svcdb,
646 Returns a listref of html elements associated with this service's exports.
652 my $svc_x = $self->svc_x
653 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
655 $svc_x->export_links;
658 =item export_getsettings
660 Returns two hashrefs of settings associated with this service's exports.
664 sub export_getsettings {
666 my $svc_x = $self->svc_x
667 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
669 $svc_x->export_getsettings;
675 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
676 FS::svc_domain object, etc.)
682 my $svcdb = $self->part_svc->svcdb;
683 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
684 $self->{'_svc_acct'};
686 require "FS/$svcdb.pm";
687 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
688 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
690 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
694 =item seconds_since TIMESTAMP
696 See L<FS::svc_acct/seconds_since>. Equivalent to
697 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
698 where B<svcdb> is not "svc_acct".
702 #internal session db deprecated (or at least on hold)
703 sub seconds_since { 'internal session db deprecated'; };
704 ##note: implementation here, POD in FS::svc_acct
706 # my($self, $since) = @_;
708 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
711 # AND logout IS NOT NULL'
712 # ) or die $dbh->errstr;
713 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
714 # $sth->fetchrow_arrayref->[0];
717 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
719 Equivalent to $cust_svc->svc_x->seconds_since_sqlradacct, but
720 more efficient. Meaningless for records where B<svcdb> is not
721 svc_acct or svc_broadband.
725 sub seconds_since_sqlradacct {
726 my($self, $start, $end) = @_;
728 my $mes = "$me seconds_since_sqlradacct:";
730 my $svc_x = $self->svc_x;
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"
739 foreach my $part_export ( @part_export ) {
741 next if $part_export->option('ignore_accounting');
743 warn "$mes connecting to sqlradius database\n"
746 my $dbh = DBI->connect( map { $part_export->option($_) }
747 qw(datasrc username password) )
748 or die "can't connect to sqlradius database: ". $DBI::errstr;
750 warn "$mes connected to sqlradius database\n"
753 #select a unix time conversion function based on database type
754 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
755 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
757 my $username = $part_export->export_username($svc_x);
761 warn "$mes finding closed sessions completely within the given range\n"
766 if ($part_export->option('process_single_realm')) {
767 $realm = 'AND Realm = ?';
768 $realmparam = $part_export->option('realm');
771 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
775 AND $str2time AcctStartTime $closing >= ?
776 AND $str2time AcctStopTime $closing < ?
777 AND $str2time AcctStopTime $closing > 0
778 AND AcctStopTime IS NOT NULL"
779 ) or die $dbh->errstr;
780 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
782 my $regular = $sth->fetchrow_arrayref->[0];
784 warn "$mes finding open sessions which start in the range\n"
787 # count session start->range end
788 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
792 AND $str2time AcctStartTime $closing >= ?
793 AND $str2time AcctStartTime $closing < ?
794 AND ( ? - $str2time AcctStartTime $closing ) < 86400
795 AND ( $str2time AcctStopTime $closing = 0
796 OR AcctStopTime IS NULL )";
797 $sth = $dbh->prepare($query) or die $dbh->errstr;
800 ($realm ? $realmparam : ()),
804 or die $sth->errstr. " executing query $query";
805 my $start_during = $sth->fetchrow_arrayref->[0];
807 warn "$mes finding closed sessions which start before the range but stop during\n"
810 #count range start->session end
811 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
815 AND $str2time AcctStartTime $closing < ?
816 AND $str2time AcctStopTime $closing >= ?
817 AND $str2time AcctStopTime $closing < ?
818 AND $str2time AcctStopTime $closing > 0
819 AND AcctStopTime IS NOT NULL"
820 ) or die $dbh->errstr;
821 $sth->execute( $start,
823 ($realm ? $realmparam : ()),
828 my $end_during = $sth->fetchrow_arrayref->[0];
830 warn "$mes finding closed sessions which start before the range but stop after\n"
833 # count range start->range end
834 # don't count open sessions anymore (probably missing stop record)
835 $sth = $dbh->prepare("SELECT COUNT(*)
839 AND $str2time AcctStartTime $closing < ?
840 AND ( $str2time AcctStopTime $closing >= ?
842 # OR AcctStopTime = 0
843 # OR AcctStopTime IS NULL )"
844 ) or die $dbh->errstr;
845 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
847 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
849 $seconds += $regular + $end_during + $start_during + $entire_range;
851 warn "$mes done finding sessions\n"
860 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
862 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
863 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.
864 Meaningless for records where B<svcdb> is not svc_acct or svc_broadband.
868 #(false laziness w/seconds_since_sqlradacct above)
869 sub attribute_since_sqlradacct {
870 my($self, $start, $end, $attrib) = @_;
872 my $mes = "$me attribute_since_sqlradacct:";
874 my $svc_x = $self->svc_x;
876 my @part_export = $self->part_svc->part_export_usage;
877 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
878 " service definition"
884 foreach my $part_export ( @part_export ) {
886 next if $part_export->option('ignore_accounting');
888 warn "$mes connecting to sqlradius database\n"
891 my $dbh = DBI->connect( map { $part_export->option($_) }
892 qw(datasrc username password) )
893 or die "can't connect to sqlradius database: ". $DBI::errstr;
895 warn "$mes connected to sqlradius database\n"
898 #select a unix time conversion function based on database type
899 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
900 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
902 my $username = $part_export->export_username($svc_x);
904 warn "$mes SUMing $attrib sessions\n"
909 if ($part_export->option('process_single_realm')) {
910 $realm = 'AND Realm = ?';
911 $realmparam = $part_export->option('realm');
914 my $sth = $dbh->prepare("SELECT SUM($attrib)
918 AND $str2time AcctStopTime $closing >= ?
919 AND $str2time AcctStopTime $closing < ?
920 AND AcctStopTime IS NOT NULL"
921 ) or die $dbh->errstr;
922 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
925 my $row = $sth->fetchrow_arrayref;
926 $sum += $row->[0] if defined($row->[0]);
928 warn "$mes done SUMing sessions\n"
937 #note: implementation here, POD in FS::svc_acct
938 # false laziness w/above
939 sub attribute_last_sqlradacct {
940 my($self, $attrib) = @_;
942 my $mes = "$me attribute_last_sqlradacct:";
944 my $svc_x = $self->svc_x;
946 my @part_export = $self->part_svc->part_export_usage;
947 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
948 " service definition"
953 my $AcctStartTime = 0;
955 foreach my $part_export ( @part_export ) {
957 next if $part_export->option('ignore_accounting');
959 warn "$mes connecting to sqlradius database\n"
962 my $dbh = DBI->connect( map { $part_export->option($_) }
963 qw(datasrc username password) )
964 or die "can't connect to sqlradius database: ". $DBI::errstr;
966 warn "$mes connected to sqlradius database\n"
969 #select a unix time conversion function based on database type
970 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
971 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
973 my $username = $part_export->export_username($svc_x);
975 warn "$mes finding most-recent $attrib\n"
980 if ($part_export->option('process_single_realm')) {
981 $realm = 'AND Realm = ?';
982 $realmparam = $part_export->option('realm');
985 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
989 ORDER BY AcctStartTime DESC LIMIT 1
990 ") or die $dbh->errstr;
991 $sth->execute($username, ($realm ? $realmparam : ()) )
994 my $row = $sth->fetchrow_arrayref;
995 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
997 $AcctStartTime = $row->[1];
1009 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1011 See L<FS::svc_acct/get_session_history>. Equivalent to
1012 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1013 records where B<svcdb> is not "svc_acct".
1017 sub get_session_history {
1018 my($self, $start, $end, $attrib) = @_;
1022 my @part_export = $self->part_svc->part_export_usage;
1023 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1024 " service definition"
1025 unless @part_export;
1030 foreach my $part_export ( @part_export ) {
1032 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1039 =item tickets [ STATUS ]
1041 Returns an array of hashes representing the tickets linked to this service.
1043 An optional status (or arrayref or hashref of statuses) may be specified.
1049 my $status = ( @_ && $_[0] ) ? shift : '';
1051 my $conf = FS::Conf->new;
1052 my $num = $conf->config('cust_main-max_tickets') || 10;
1055 if ( $conf->config('ticket_system') ) {
1056 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1058 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1067 foreach my $priority (
1068 $conf->config('ticket_system-custom_priority_field-values'), ''
1070 last if scalar(@tickets) >= $num;
1072 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1073 $num - scalar(@tickets),
1086 my $svc_x = $self->svc_x;
1087 +{ ( map { $_=>$self->$_ } $self->fields ),
1088 ( map { $_=>$svc_x->$_ } $svc_x->fields ),
1098 =item smart_search OPTION => VALUE ...
1100 Accepts the option I<search>, the string to search for. The string will
1101 be searched for as a username, email address, IP address, MAC address,
1102 phone number, and hardware serial number. Unlike the I<smart_search> on
1103 customers, this always requires an exact match.
1107 # though perhaps it should be fuzzy in some cases?
1110 my %param = __PACKAGE__->smart_search_param(@_);
1114 sub smart_search_param {
1118 my $string = $opt{'search'};
1119 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1122 map { my $table = $_;
1123 my $search_sql = "FS::$table"->search_sql($string);
1124 my $addl_from = "FS::$table"->search_sql_addl_from();
1126 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1127 "FROM $table $addl_from WHERE $search_sql";
1129 FS::part_svc->svc_tables;
1131 if ( $string =~ /^(\d+)$/ ) {
1132 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1135 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1136 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1140 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1141 'null_right' => 'View/link unlinked services'
1143 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1145 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1146 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1147 ' LEFT JOIN part_svc USING ( svcpart )';
1150 'table' => 'cust_svc',
1151 'select' => 'svc_all.svcnum AS svcnum, '.
1152 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1154 'addl_from' => $addl_from,
1156 'extra_sql' => $extra_sql,
1160 # If the associated cust_pkg is 'on hold'
1161 # and the associated pkg_svc has the provision_hold flag
1162 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1163 # then removes hold from pkg
1164 # returns $error or '' on success,
1165 # does not indicate if pkg status was changed
1166 sub _check_provision_hold {
1169 # check status of cust_pkg
1170 my $cust_pkg = $self->cust_pkg;
1171 return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1173 # check flag on this svc
1174 # small false laziness with $self->pkg_svc
1175 # to avoid looking up cust_pkg twice
1176 my $pkg_svc = qsearchs( 'pkg_svc', {
1177 'svcpart' => $self->svcpart,
1178 'pkgpart' => $cust_pkg->pkgpart,
1180 return '' unless $pkg_svc->provision_hold;
1182 # check for any others available with that flag
1183 return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1185 # conditions met, remove hold
1186 return $cust_pkg->unsuspend;
1192 # fix missing (deleted by mistake) svc_x records
1193 warn "searching for missing svc_x records...\n";
1195 'table' => 'cust_svc',
1196 'select' => 'cust_svc.*',
1197 'addl_from' => ' LEFT JOIN ( ' .
1199 map { "SELECT svcnum FROM $_" }
1200 FS::part_svc->svc_tables
1201 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1202 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1204 my @svcs = qsearch(\%search);
1205 warn "found ".scalar(@svcs)."\n";
1207 local $FS::Record::nowarn_classload = 1; # for h_svc_
1208 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1211 'hashref' => { history_action => 'delete' },
1212 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1214 foreach my $cust_svc (@svcs) {
1215 my $svcnum = $cust_svc->svcnum;
1216 my $svcdb = $cust_svc->part_svc->svcdb;
1217 $h_search{'hashref'}{'svcnum'} = $svcnum;
1218 $h_search{'table'} = "h_$svcdb";
1219 my $h_svc_x = qsearchs(\%h_search)
1221 my $class = "FS::$svcdb";
1222 my $new_svc_x = $class->new({ $h_svc_x->hash });
1223 my $error = $new_svc_x->insert;
1224 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1235 Behaviour of changing the svcpart of cust_svc records is undefined and should
1236 possibly be prohibited, and pkg_svc records are not checked.
1238 pkg_svc records are not checked in general (here).
1240 Deleting this record doesn't check or delete the svc_* record associated
1243 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1244 a DBI database handle is not yet implemented.
1248 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1249 schema.html from the base documentation