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;
21 #most FS::svc_ classes are autoloaded in svc_x emthod
22 use FS::svc_acct; #this one is used in the cache stuff
24 @ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
31 #ask FS::UID to run this stuff for us later
32 FS::UID->install_callback( sub {
34 $ticket_system = $conf->config('ticket_system')
37 our $cache_enabled = 0;
40 my( $self, $hashref ) = @_;
41 if ( $cache_enabled && $hashref->{'svc'} ) {
42 $self->{'_svcpart'} = FS::part_svc->new($hashref);
48 my ( $hashref, $cache ) = @_;
49 if ( $hashref->{'username'} ) {
50 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
52 if ( $hashref->{'svc'} ) {
53 $self->{'_svcpart'} = FS::part_svc->new($hashref);
59 FS::cust_svc - Object method for cust_svc objects
65 $record = new FS::cust_svc \%hash
66 $record = new FS::cust_svc { 'column' => 'value' };
68 $error = $record->insert;
70 $error = $new_record->replace($old_record);
72 $error = $record->delete;
74 $error = $record->check;
76 ($label, $value) = $record->label;
80 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
81 The following fields are currently supported:
85 =item svcnum - primary key (assigned automatically for new services)
87 =item pkgnum - Package (see L<FS::cust_pkg>)
89 =item svcpart - Service definition (see L<FS::part_svc>)
91 =item agent_svcid - Optional legacy service ID
93 =item overlimit - date the service exceeded its usage limit
103 Creates a new service. To add the refund to the database, see L<"insert">.
104 Services are normally created by creating FS::svc_ objects (see
105 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
109 sub table { 'cust_svc'; }
113 Adds this service to the database. If there is an error, returns the error,
114 otherwise returns false.
121 local $SIG{HUP} = 'IGNORE';
122 local $SIG{INT} = 'IGNORE';
123 local $SIG{QUIT} = 'IGNORE';
124 local $SIG{TERM} = 'IGNORE';
125 local $SIG{TSTP} = 'IGNORE';
126 local $SIG{PIPE} = 'IGNORE';
128 my $oldAutoCommit = $FS::UID::AutoCommit;
129 local $FS::UID::AutoCommit = 0;
132 my $error = $self->SUPER::insert;
134 #check if this releases a hold (see FS::pkg_svc provision_hold)
135 $error ||= $self->_check_provision_hold;
138 $dbh->rollback if $oldAutoCommit;
139 return $error if $error
142 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
149 Deletes this service from the database. If there is an error, returns the
150 error, otherwise returns false. Note that this only removes the cust_svc
151 record - you should probably use the B<cancel> method instead.
160 my $cust_pkg = $self->cust_pkg;
161 my $custnum = $cust_pkg->custnum if $cust_pkg;
163 local $SIG{HUP} = 'IGNORE';
164 local $SIG{INT} = 'IGNORE';
165 local $SIG{QUIT} = 'IGNORE';
166 local $SIG{TERM} = 'IGNORE';
167 local $SIG{TSTP} = 'IGNORE';
168 local $SIG{PIPE} = 'IGNORE';
170 my $oldAutoCommit = $FS::UID::AutoCommit;
171 local $FS::UID::AutoCommit = 0;
174 # delete associated export_cust_svc
175 foreach my $export_cust_svc (
176 qsearch('export_cust_svc',{ 'svcnum' => $self->svcnum })
178 my $error = $export_cust_svc->delete;
180 $dbh->rollback if $oldAutoCommit;
185 my $error = $self->SUPER::delete;
187 $dbh->rollback if $oldAutoCommit;
191 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
193 if ( $ticket_system eq 'RT_Internal' ) {
194 unless ( $rt_session ) {
195 FS::TicketSystem->init;
196 $rt_session = FS::TicketSystem->session;
198 my $links = RT::Links->new($rt_session->{CurrentUser});
199 my $svcnum = $self->svcnum;
200 $links->Limit(FIELD => 'Target',
201 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
202 while ( my $l = $links->Next ) {
205 # re-link to point to the customer instead
207 $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
210 ($val, $msg) = $l->Delete;
212 # can't do anything useful on error
213 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
220 Cancels the relevant service by calling the B<cancel> method of the associated
221 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
222 deleting the FS::svc_XXX record and then deleting this record.
224 If there is an error, returns the error, otherwise returns false.
231 local $SIG{HUP} = 'IGNORE';
232 local $SIG{INT} = 'IGNORE';
233 local $SIG{QUIT} = 'IGNORE';
234 local $SIG{TERM} = 'IGNORE';
235 local $SIG{TSTP} = 'IGNORE';
236 local $SIG{PIPE} = 'IGNORE';
238 my $oldAutoCommit = $FS::UID::AutoCommit;
239 local $FS::UID::AutoCommit = 0;
242 my $part_svc = $self->part_svc;
244 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
245 $dbh->rollback if $oldAutoCommit;
246 return "Illegal svcdb value in part_svc!";
249 require "FS/$svcdb.pm";
251 my $svc = $self->svc_x;
253 if ( %opt && $opt{'date'} ) {
254 my $error = $svc->expire($opt{'date'});
256 $dbh->rollback if $oldAutoCommit;
257 return "Error expiring service: $error";
260 my $error = $svc->cancel;
262 $dbh->rollback if $oldAutoCommit;
263 return "Error canceling service: $error";
265 $error = $svc->delete; #this deletes this cust_svc record as well
267 $dbh->rollback if $oldAutoCommit;
268 return "Error deleting service: $error";
275 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
276 "; deleting cust_svc only\n";
278 my $error = $self->delete;
280 $dbh->rollback if $oldAutoCommit;
281 return "Error deleting cust_svc: $error";
286 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
292 =item overlimit [ ACTION ]
294 Retrieves or sets the overlimit date. If ACTION is absent, return
295 the present value of overlimit. If ACTION is present, it can
296 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
297 is set to the current time if it is not already set. The 'unsuspend' value
298 causes the time to be cleared.
300 If there is an error on setting, returns the error, otherwise returns false.
306 my $action = shift or return $self->getfield('overlimit');
308 local $SIG{HUP} = 'IGNORE';
309 local $SIG{INT} = 'IGNORE';
310 local $SIG{QUIT} = 'IGNORE';
311 local $SIG{TERM} = 'IGNORE';
312 local $SIG{TSTP} = 'IGNORE';
313 local $SIG{PIPE} = 'IGNORE';
315 my $oldAutoCommit = $FS::UID::AutoCommit;
316 local $FS::UID::AutoCommit = 0;
319 if ( $action eq 'suspend' ) {
320 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
321 }elsif ( $action eq 'unsuspend' ) {
322 $self->setfield('overlimit', '');
324 die "unexpected action value: $action";
327 local $ignore_quantity = 1;
328 my $error = $self->replace;
330 $dbh->rollback if $oldAutoCommit;
331 return "Error setting overlimit: $error";
334 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
340 =item replace OLD_RECORD
342 Replaces the OLD_RECORD with this one in the database. If there is an error,
343 returns the error, otherwise returns false.
350 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
352 # : $new->replace_old;
353 my ( $new, $old ) = ( shift, shift );
354 $old = $new->replace_old unless defined($old);
356 local $SIG{HUP} = 'IGNORE';
357 local $SIG{INT} = 'IGNORE';
358 local $SIG{QUIT} = 'IGNORE';
359 local $SIG{TERM} = 'IGNORE';
360 local $SIG{TSTP} = 'IGNORE';
361 local $SIG{PIPE} = 'IGNORE';
363 my $oldAutoCommit = $FS::UID::AutoCommit;
364 local $FS::UID::AutoCommit = 0;
367 if ( $new->svcpart != $old->svcpart ) {
368 my $svc_x = $new->svc_x;
369 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
370 local($FS::Record::nowarn_identical) = 1;
371 my $error = $new_svc_x->replace($svc_x);
373 $dbh->rollback if $oldAutoCommit;
374 return $error if $error;
378 # #trigger a re-export on pkgnum changes?
379 # # (of prepaid packages), for Expiration RADIUS attribute
380 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
381 # my $svc_x = $new->svc_x;
382 # local($FS::Record::nowarn_identical) = 1;
383 # my $error = $svc_x->export('replace');
385 # $dbh->rollback if $oldAutoCommit;
386 # return $error if $error;
390 #trigger a pkg_change export on pkgnum changes
391 if ( $new->pkgnum != $old->pkgnum ) {
392 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
397 $dbh->rollback if $oldAutoCommit;
398 return $error if $error;
400 } # if pkgnum is changing
402 #my $error = $new->SUPER::replace($old, @_);
403 my $error = $new->SUPER::replace($old);
405 #trigger a relocate export on location changes (NENA2 and Northern 911 export)
406 my $old_pkg = $old->cust_pkg;
407 my $new_pkg = $new->cust_pkg;
408 if ( $old_pkg && $new_pkg && $new_pkg->locationnum != $old_pkg->locationnum ) {
409 my $svc_x = $new->svc_x;
410 if ( $svc_x->locationnum ) {
411 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
412 # in this case, set the service location to be the same as the new
414 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
415 # and replace it, which triggers a relocate export so we don't
417 $error ||= $svc_x->replace;
419 # the service already has a different location from its package
423 # the service doesn't have a locationnum (either isn't of a type
424 # that has the locationnum field, or the locationnum is null and
425 # defaults to cust_pkg->locationnum)
426 # so just trigger the export here
427 $error ||= $new->svc_x->export('relocate',
428 $new->cust_pkg->cust_location,
429 $old->cust_pkg->cust_location,
431 } # if ($svc_x->locationnum)
432 } # if this is a location change
434 #check if this releases a hold (see FS::pkg_svc provision_hold)
435 $error ||= $new->_check_provision_hold;
438 $dbh->rollback if $oldAutoCommit;
439 return $error if $error
442 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
449 Checks all fields to make sure this is a valid service. If there is an error,
450 returns the error, otherwise returns false. Called by the insert and
459 $self->ut_numbern('svcnum')
460 || $self->ut_numbern('pkgnum')
461 || $self->ut_number('svcpart')
462 || $self->ut_numbern('agent_svcid')
463 || $self->ut_numbern('overlimit')
465 return $error if $error;
467 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
468 return "Unknown svcpart" unless $part_svc;
470 if ( $self->pkgnum && ! $ignore_quantity ) {
472 #slightly inefficient since ->pkg_svc will also look it up, but fixing
473 # a much larger perf problem and have bigger fish to fry
474 my $cust_pkg = $self->cust_pkg;
476 my $pkg_svc = $self->pkg_svc
477 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
478 'pkgpart' => $cust_pkg->pkgpart,
482 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
483 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
484 my $addon_pkg_svc = qsearchs('pkg_svc', {
485 pkgpart => $part_pkg_link->dst_pkgpart,
486 svcpart => $self->svcpart,
488 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
492 #better error message? UI shouldn't get here
493 return "No svcpart ". $self->svcpart.
494 " services in pkgpart ". $cust_pkg->pkgpart
495 unless $pkg_svc->quantity > 0;
497 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
499 #false laziness w/cust_pkg->part_svc
500 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
504 #better error message? again, UI shouldn't get here
505 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
506 " services for pkgnum ". $self->pkgnum
516 Returns the displayed service number for this service: agent_svcid if it has a
517 value, svcnum otherwise
523 $self->agent_svcid || $self->svcnum;
528 Returns the definition for this service, as a FS::part_svc object (see
535 return $self->{_svcpart} if $self->{_svcpart};
536 cluck 'cust_svc->part_svc called' if $DEBUG;
537 qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
542 Returns the package this service belongs to, as a FS::cust_pkg object (see
549 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
554 Returns the pkg_svc record for for this service, if applicable.
560 my $cust_pkg = $self->cust_pkg;
561 return undef unless $cust_pkg;
563 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
564 'pkgpart' => $cust_pkg->pkgpart,
571 Returns the date this service was inserted.
577 $self->h_date('insert');
580 =item pkg_cancel_date
582 Returns the date this service's package was canceled. This normally only
583 exists for a service that's been preserved through cancellation with the
584 part_pkg.preserve flag.
588 sub pkg_cancel_date {
590 my $cust_pkg = $self->cust_pkg or return;
591 return $cust_pkg->getfield('cancel') || '';
594 =item label [ LOCALE ]
596 Returns a list consisting of:
597 - The name of this service (from part_svc), optionally localized
598 - A meaningful identifier (username, domain, or mail alias)
599 - The table name (i.e. svc_domain) for this service
604 my($label, $value, $svcdb) = $cust_svc->label;
606 =item label_long [ LOCALE ]
608 Like the B<label> method, except the second item in the list ("meaningful
609 identifier") may be longer - typically, a full name is included.
613 sub label { shift->_label('svc_label', @_); }
614 sub label_long { shift->_label('svc_label_long', @_); }
620 my $svc_x = $self->svc_x
621 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
623 $self->$method($svc_x, undef, undef, $locale);
626 # svc_label(_long) takes three arguments: end date, start date, locale
627 # and FS::svc_*::label methods must accept those also, if they even care
629 sub svc_label { shift->_svc_label('label', @_); }
630 sub svc_label_long { shift->_svc_label('label_long', @_); }
633 my( $self, $method, $svc_x ) = ( shift, shift, shift );
634 my ($end, $start, $locale) = @_;
637 $self->part_svc->svc_locale($locale),
639 $self->part_svc->svcdb,
647 Returns a listref of html elements associated with this service's exports.
653 my $svc_x = $self->svc_x
654 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
656 $svc_x->export_links;
659 =item export_getsettings
661 Returns two hashrefs of settings associated with this service's exports.
665 sub export_getsettings {
667 my $svc_x = $self->svc_x
668 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
670 $svc_x->export_getsettings;
676 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
677 FS::svc_domain object, etc.)
683 my $svcdb = $self->part_svc->svcdb;
684 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
685 $self->{'_svc_acct'};
687 require "FS/$svcdb.pm";
688 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
689 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
691 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
695 =item seconds_since TIMESTAMP
697 See L<FS::svc_acct/seconds_since>. Equivalent to
698 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
699 where B<svcdb> is not "svc_acct".
703 #internal session db deprecated (or at least on hold)
704 sub seconds_since { 'internal session db deprecated'; };
705 ##note: implementation here, POD in FS::svc_acct
707 # my($self, $since) = @_;
709 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
712 # AND logout IS NOT NULL'
713 # ) or die $dbh->errstr;
714 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
715 # $sth->fetchrow_arrayref->[0];
718 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
720 Equivalent to $cust_svc->svc_x->seconds_since_sqlradacct, but
721 more efficient. Meaningless for records where B<svcdb> is not
722 svc_acct or svc_broadband.
726 sub seconds_since_sqlradacct {
727 my($self, $start, $end) = @_;
729 my $mes = "$me seconds_since_sqlradacct:";
731 my $svc_x = $self->svc_x;
733 my @part_export = $self->part_svc->part_export_usage;
734 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
735 " service definition"
740 foreach my $part_export ( @part_export ) {
742 next if $part_export->option('ignore_accounting');
744 warn "$mes connecting to sqlradius database\n"
747 my $dbh = FS::DBI->connect( map { $part_export->option($_) }
748 qw(datasrc username password) )
749 or die "can't connect to sqlradius database: ". $FS::DBI::errstr;
751 warn "$mes connected to sqlradius database\n"
754 #select a unix time conversion function based on database type
755 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
756 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
758 my $username = $part_export->export_username($svc_x);
762 warn "$mes finding closed sessions completely within the given range\n"
767 if ($part_export->option('process_single_realm')) {
768 $realm = 'AND Realm = ?';
769 $realmparam = $part_export->option('realm');
772 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
776 AND $str2time AcctStartTime $closing >= ?
777 AND $str2time AcctStopTime $closing < ?
778 AND $str2time AcctStopTime $closing > 0
779 AND AcctStopTime IS NOT NULL"
780 ) or die $dbh->errstr;
781 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
783 my $regular = $sth->fetchrow_arrayref->[0];
785 warn "$mes finding open sessions which start in the range\n"
788 # count session start->range end
789 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
793 AND $str2time AcctStartTime $closing >= ?
794 AND $str2time AcctStartTime $closing < ?
795 AND ( ? - $str2time AcctStartTime $closing ) < 86400
796 AND ( $str2time AcctStopTime $closing = 0
797 OR AcctStopTime IS NULL )";
798 $sth = $dbh->prepare($query) or die $dbh->errstr;
801 ($realm ? $realmparam : ()),
805 or die $sth->errstr. " executing query $query";
806 my $start_during = $sth->fetchrow_arrayref->[0];
808 warn "$mes finding closed sessions which start before the range but stop during\n"
811 #count range start->session end
812 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
816 AND $str2time AcctStartTime $closing < ?
817 AND $str2time AcctStopTime $closing >= ?
818 AND $str2time AcctStopTime $closing < ?
819 AND $str2time AcctStopTime $closing > 0
820 AND AcctStopTime IS NOT NULL"
821 ) or die $dbh->errstr;
822 $sth->execute( $start,
824 ($realm ? $realmparam : ()),
829 my $end_during = $sth->fetchrow_arrayref->[0];
831 warn "$mes finding closed sessions which start before the range but stop after\n"
834 # count range start->range end
835 # don't count open sessions anymore (probably missing stop record)
836 $sth = $dbh->prepare("SELECT COUNT(*)
840 AND $str2time AcctStartTime $closing < ?
841 AND ( $str2time AcctStopTime $closing >= ?
843 # OR AcctStopTime = 0
844 # OR AcctStopTime IS NULL )"
845 ) or die $dbh->errstr;
846 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
848 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
850 $seconds += $regular + $end_during + $start_during + $entire_range;
852 warn "$mes done finding sessions\n"
861 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
863 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
864 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.
865 Meaningless for records where B<svcdb> is not svc_acct or svc_broadband.
869 #(false laziness w/seconds_since_sqlradacct above)
870 sub attribute_since_sqlradacct {
871 my($self, $start, $end, $attrib) = @_;
873 my $mes = "$me attribute_since_sqlradacct:";
875 my $svc_x = $self->svc_x;
877 my @part_export = $self->part_svc->part_export_usage;
878 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
879 " service definition"
885 foreach my $part_export ( @part_export ) {
887 next if $part_export->option('ignore_accounting');
889 warn "$mes connecting to sqlradius database\n"
892 my $dbh = FS::DBI->connect( map { $part_export->option($_) }
893 qw(datasrc username password) )
894 or die "can't connect to sqlradius database: ". $FS::DBI::errstr;
896 warn "$mes connected to sqlradius database\n"
899 #select a unix time conversion function based on database type
900 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
901 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
903 my $username = $part_export->export_username($svc_x);
905 warn "$mes SUMing $attrib sessions\n"
910 if ($part_export->option('process_single_realm')) {
911 $realm = 'AND Realm = ?';
912 $realmparam = $part_export->option('realm');
915 my $sth = $dbh->prepare("SELECT SUM($attrib)
919 AND $str2time AcctStopTime $closing >= ?
920 AND $str2time AcctStopTime $closing < ?
921 AND AcctStopTime IS NOT NULL"
922 ) or die $dbh->errstr;
923 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
926 my $row = $sth->fetchrow_arrayref;
927 $sum += $row->[0] if defined($row->[0]);
929 warn "$mes done SUMing sessions\n"
938 #note: implementation here, POD in FS::svc_acct
939 # false laziness w/above
940 sub attribute_last_sqlradacct {
941 my($self, $attrib) = @_;
943 my $mes = "$me attribute_last_sqlradacct:";
945 my $svc_x = $self->svc_x;
947 my @part_export = $self->part_svc->part_export_usage;
948 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
949 " service definition"
954 my $AcctStartTime = 0;
956 foreach my $part_export ( @part_export ) {
958 next if $part_export->option('ignore_accounting');
960 warn "$mes connecting to sqlradius database\n"
963 my $dbh = FS::DBI->connect( map { $part_export->option($_) }
964 qw(datasrc username password) )
965 or die "can't connect to sqlradius database: ". $FS::DBI::errstr;
967 warn "$mes connected to sqlradius database\n"
970 #select a unix time conversion function based on database type
971 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
972 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
974 my $username = $part_export->export_username($svc_x);
976 warn "$mes finding most-recent $attrib\n"
981 if ($part_export->option('process_single_realm')) {
982 $realm = 'AND Realm = ?';
983 $realmparam = $part_export->option('realm');
986 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
990 ORDER BY AcctStartTime DESC LIMIT 1
991 ") or die $dbh->errstr;
992 $sth->execute($username, ($realm ? $realmparam : ()) )
995 my $row = $sth->fetchrow_arrayref;
996 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
998 $AcctStartTime = $row->[1];
1010 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1012 See L<FS::svc_acct/get_session_history>. Equivalent to
1013 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1014 records where B<svcdb> is not "svc_acct".
1018 sub get_session_history {
1019 my($self, $start, $end, $attrib) = @_;
1023 my @part_export = $self->part_svc->part_export_usage;
1024 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1025 " service definition"
1026 unless @part_export;
1031 foreach my $part_export ( @part_export ) {
1033 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1040 =item tickets [ STATUS ]
1042 Returns an array of hashes representing the tickets linked to this service.
1044 An optional status (or arrayref or hashref of statuses) may be specified.
1050 my $status = ( @_ && $_[0] ) ? shift : '';
1052 my $conf = FS::Conf->new;
1053 my $num = $conf->config('cust_main-max_tickets') || 10;
1056 if ( $conf->config('ticket_system') ) {
1057 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1059 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1068 foreach my $priority (
1069 $conf->config('ticket_system-custom_priority_field-values'), ''
1071 last if scalar(@tickets) >= $num;
1073 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1074 $num - scalar(@tickets),
1087 my $svc_x = $self->svc_x;
1088 +{ ( map { $_=>$self->$_ } $self->fields ),
1089 ( map { $_=>$svc_x->$_ } $svc_x->fields ),
1099 =item smart_search OPTION => VALUE ...
1101 Accepts the option I<search>, the string to search for. The string will
1102 be searched for as a username, email address, IP address, MAC address,
1103 phone number, and hardware serial number. Unlike the I<smart_search> on
1104 customers, this always requires an exact match.
1108 # though perhaps it should be fuzzy in some cases?
1111 my %param = __PACKAGE__->smart_search_param(@_);
1115 sub smart_search_param {
1119 my $string = $opt{'search'};
1120 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1123 map { my $table = $_;
1124 my $search_sql = "FS::$table"->search_sql($string);
1125 my $addl_from = "FS::$table"->search_sql_addl_from();
1127 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1128 "FROM $table $addl_from WHERE $search_sql";
1130 FS::part_svc->svc_tables;
1132 if ( $string =~ /^(\d+)$/ ) {
1133 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1136 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1137 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1141 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1142 'null_right' => 'View/link unlinked services'
1144 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1146 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1147 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1148 ' LEFT JOIN part_svc USING ( svcpart )';
1151 'table' => 'cust_svc',
1152 'select' => 'svc_all.svcnum AS svcnum, '.
1153 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1155 'addl_from' => $addl_from,
1157 'extra_sql' => $extra_sql,
1161 # If the associated cust_pkg is 'on hold'
1162 # and the associated pkg_svc has the provision_hold flag
1163 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1164 # then removes hold from pkg
1165 # returns $error or '' on success,
1166 # does not indicate if pkg status was changed
1167 sub _check_provision_hold {
1170 # check status of cust_pkg
1171 my $cust_pkg = $self->cust_pkg;
1172 return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1174 # check flag on this svc
1175 # small false laziness with $self->pkg_svc
1176 # to avoid looking up cust_pkg twice
1177 my $pkg_svc = qsearchs( 'pkg_svc', {
1178 'svcpart' => $self->svcpart,
1179 'pkgpart' => $cust_pkg->pkgpart,
1181 return '' unless $pkg_svc->provision_hold;
1183 # check for any others available with that flag
1184 return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1186 # conditions met, remove hold
1187 return $cust_pkg->unsuspend;
1193 # fix missing (deleted by mistake) svc_x records
1194 warn "searching for missing svc_x records...\n";
1196 'table' => 'cust_svc',
1197 'select' => 'cust_svc.*',
1198 'addl_from' => ' LEFT JOIN ( ' .
1200 map { "SELECT svcnum FROM $_" }
1201 FS::part_svc->svc_tables
1202 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1203 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1205 my @svcs = qsearch(\%search);
1206 warn "found ".scalar(@svcs)."\n";
1208 local $FS::Record::nowarn_classload = 1; # for h_svc_
1209 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1212 'hashref' => { history_action => 'delete' },
1213 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1215 foreach my $cust_svc (@svcs) {
1216 my $svcnum = $cust_svc->svcnum;
1217 my $svcdb = $cust_svc->part_svc->svcdb;
1218 $h_search{'hashref'}{'svcnum'} = $svcnum;
1219 $h_search{'table'} = "h_$svcdb";
1220 my $h_svc_x = qsearchs(\%h_search)
1222 my $class = "FS::$svcdb";
1223 my $new_svc_x = $class->new({ $h_svc_x->hash });
1224 my $error = $new_svc_x->insert;
1225 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1236 Behaviour of changing the svcpart of cust_svc records is undefined and should
1237 possibly be prohibited, and pkg_svc records are not checked.
1239 pkg_svc records are not checked in general (here).
1241 Deleting this record doesn't check or delete the svc_* record associated
1244 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1245 a DBI database handle is not yet implemented.
1249 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1250 schema.html from the base documentation