2 use base qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
5 use vars qw( $DEBUG $me $ignore_quantity $conf $ticket_system );
7 #use Scalar::Util qw( blessed );
8 use List::Util qw( max );
10 use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing );
14 use FS::part_svc_link;
15 use FS::domain_record;
19 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
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 foreach my $part_svc_link ( $self->part_svc_link(
191 link_type => 'cust_svc_unprovision_cascade',
194 foreach my $cust_svc ( qsearch( 'cust_svc', {
195 'pkgnum' => $self->pkgnum,
196 'svcpart' => $part_svc_link->dst_svcpart,
199 my $error = $cust_svc->svc_x->delete;
201 $dbh->rollback if $oldAutoCommit;
208 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
210 if ( $ticket_system eq 'RT_Internal' ) {
211 unless ( $rt_session ) {
212 FS::TicketSystem->init;
213 $rt_session = FS::TicketSystem->session;
215 my $links = RT::Links->new($rt_session->{CurrentUser});
216 my $svcnum = $self->svcnum;
217 $links->Limit(FIELD => 'Target',
218 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
219 while ( my $l = $links->Next ) {
222 # re-link to point to the customer instead
224 $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
227 ($val, $msg) = $l->Delete;
229 # can't do anything useful on error
230 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
240 Suspends the relevant service by calling the B<suspend> method of the associated
241 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object).
243 If there is an error, returns the error, otherwise returns false.
248 my( $self, %opt ) = @_;
250 $self->part_svc->svcdb =~ /^([\w\-]+)$/ or return 'Illegal part_svc.svcdb';
252 require "FS/$svcdb.pm";
254 my $svc = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } )
257 my $error = $svc->suspend;
258 return $error if $error;
260 if ( $opt{labels_arryref} ) {
261 my( $label, $value ) = $self->label;
262 push @{ $opt{labels_arrayref} }, "$label: $value";
271 Cancels the relevant service by calling the B<cancel> method of the associated
272 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
273 deleting the FS::svc_XXX record and then deleting this record.
275 If there is an error, returns the error, otherwise returns false.
282 local $SIG{HUP} = 'IGNORE';
283 local $SIG{INT} = 'IGNORE';
284 local $SIG{QUIT} = 'IGNORE';
285 local $SIG{TERM} = 'IGNORE';
286 local $SIG{TSTP} = 'IGNORE';
287 local $SIG{PIPE} = 'IGNORE';
289 my $oldAutoCommit = $FS::UID::AutoCommit;
290 local $FS::UID::AutoCommit = 0;
293 my $part_svc = $self->part_svc;
295 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
296 $dbh->rollback if $oldAutoCommit;
297 return "Illegal svcdb value in part_svc!";
300 require "FS/$svcdb.pm";
302 my $svc = $self->svc_x;
304 if ( %opt && $opt{'date'} ) {
305 my $error = $svc->expire($opt{'date'});
307 $dbh->rollback if $oldAutoCommit;
308 return "Error expiring service: $error";
311 my $error = $svc->cancel;
313 $dbh->rollback if $oldAutoCommit;
314 return "Error canceling service: $error";
316 $error = $svc->delete; #this deletes this cust_svc record as well
318 $dbh->rollback if $oldAutoCommit;
319 return "Error deleting service: $error";
326 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
327 "; deleting cust_svc only\n";
329 my $error = $self->delete;
331 $dbh->rollback if $oldAutoCommit;
332 return "Error deleting cust_svc: $error";
337 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
343 =item overlimit [ ACTION ]
345 Retrieves or sets the overlimit date. If ACTION is absent, return
346 the present value of overlimit. If ACTION is present, it can
347 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
348 is set to the current time if it is not already set. The 'unsuspend' value
349 causes the time to be cleared.
351 If there is an error on setting, returns the error, otherwise returns false.
357 my $action = shift or return $self->getfield('overlimit');
359 local $SIG{HUP} = 'IGNORE';
360 local $SIG{INT} = 'IGNORE';
361 local $SIG{QUIT} = 'IGNORE';
362 local $SIG{TERM} = 'IGNORE';
363 local $SIG{TSTP} = 'IGNORE';
364 local $SIG{PIPE} = 'IGNORE';
366 my $oldAutoCommit = $FS::UID::AutoCommit;
367 local $FS::UID::AutoCommit = 0;
370 if ( $action eq 'suspend' ) {
371 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
372 }elsif ( $action eq 'unsuspend' ) {
373 $self->setfield('overlimit', '');
375 die "unexpected action value: $action";
378 local $ignore_quantity = 1;
379 my $error = $self->replace;
381 $dbh->rollback if $oldAutoCommit;
382 return "Error setting overlimit: $error";
385 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
391 =item replace OLD_RECORD
393 Replaces the OLD_RECORD with this one in the database. If there is an error,
394 returns the error, otherwise returns false.
401 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
403 # : $new->replace_old;
404 my ( $new, $old ) = ( shift, shift );
405 $old = $new->replace_old unless defined($old);
407 local $SIG{HUP} = 'IGNORE';
408 local $SIG{INT} = 'IGNORE';
409 local $SIG{QUIT} = 'IGNORE';
410 local $SIG{TERM} = 'IGNORE';
411 local $SIG{TSTP} = 'IGNORE';
412 local $SIG{PIPE} = 'IGNORE';
414 my $oldAutoCommit = $FS::UID::AutoCommit;
415 local $FS::UID::AutoCommit = 0;
418 if ( $new->svcpart != $old->svcpart ) {
419 my $svc_x = $new->svc_x;
420 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
421 local($FS::Record::nowarn_identical) = 1;
422 my $error = $new_svc_x->replace($svc_x);
424 $dbh->rollback if $oldAutoCommit;
425 return $error if $error;
429 # #trigger a re-export on pkgnum changes?
430 # # (of prepaid packages), for Expiration RADIUS attribute
431 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
432 # my $svc_x = $new->svc_x;
433 # local($FS::Record::nowarn_identical) = 1;
434 # my $error = $svc_x->export('replace');
436 # $dbh->rollback if $oldAutoCommit;
437 # return $error if $error;
441 #trigger a pkg_change export on pkgnum changes
442 if ( $new->pkgnum != $old->pkgnum ) {
443 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
448 $dbh->rollback if $oldAutoCommit;
449 return $error if $error;
451 } # if pkgnum is changing
453 #my $error = $new->SUPER::replace($old, @_);
454 my $error = $new->SUPER::replace($old);
456 #trigger a relocate export on location changes (NENA2 and Northern 911 export)
457 my $old_pkg = $old->cust_pkg;
458 my $new_pkg = $new->cust_pkg;
459 if ( $old_pkg && $new_pkg && $new_pkg->locationnum != $old_pkg->locationnum ) {
460 my $svc_x = $new->svc_x;
461 if ( $svc_x->locationnum ) {
462 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
463 # in this case, set the service location to be the same as the new
465 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
466 # and replace it, which triggers a relocate export so we don't
468 $error ||= $svc_x->replace;
470 # the service already has a different location from its package
474 # the service doesn't have a locationnum (either isn't of a type
475 # that has the locationnum field, or the locationnum is null and
476 # defaults to cust_pkg->locationnum)
477 # so just trigger the export here
478 $error ||= $new->svc_x->export('relocate',
479 $new->cust_pkg->cust_location,
480 $old->cust_pkg->cust_location,
482 } # if ($svc_x->locationnum)
483 } # if this is a location change
485 #check if this releases a hold (see FS::pkg_svc provision_hold)
486 $error ||= $new->_check_provision_hold;
489 $dbh->rollback if $oldAutoCommit;
490 return $error if $error
493 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
500 Checks all fields to make sure this is a valid service. If there is an error,
501 returns the error, otherwise returns false. Called by the insert and
510 $self->ut_numbern('svcnum')
511 || $self->ut_numbern('pkgnum')
512 || $self->ut_number('svcpart')
513 || $self->ut_numbern('agent_svcid')
514 || $self->ut_numbern('overlimit')
516 return $error if $error;
518 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
519 return "Unknown svcpart" unless $part_svc;
521 if ( $self->pkgnum && ! $ignore_quantity ) {
523 #slightly inefficient since ->pkg_svc will also look it up, but fixing
524 # a much larger perf problem and have bigger fish to fry
525 my $cust_pkg = $self->cust_pkg;
527 my $pkg_svc = $self->pkg_svc
528 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
529 'pkgpart' => $cust_pkg->pkgpart,
533 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
534 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
535 my $addon_pkg_svc = qsearchs('pkg_svc', {
536 pkgpart => $part_pkg_link->dst_pkgpart,
537 svcpart => $self->svcpart,
539 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
543 #better error message? UI shouldn't get here
544 return "No svcpart ". $self->svcpart.
545 " services in pkgpart ". $cust_pkg->pkgpart
546 unless $pkg_svc->quantity > 0;
548 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
550 #false laziness w/cust_pkg->part_svc
551 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
555 #better error message? again, UI shouldn't get here
556 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
557 " services for pkgnum ". $self->pkgnum
560 #part_svc_link rules (only make sense in pkgpart context, and
561 # skipping this when ignore_quantity is set DTRT when we're "forcing"
562 # an implicit change here (location change triggered pkgpart change,
563 # ->overlimit, bulk customer service changes)
564 foreach my $part_svc_link ( $self->part_svc_link(
565 link_type => 'cust_svc_provision_restrict',
568 return $part_svc_link->dst_svc. ' must be provisioned before '.
569 $part_svc_link->src_svc
571 'table' => 'cust_svc',
572 'hashref' => { 'pkgnum' => $self->pkgnum,
573 'svcpart' => $part_svc_link->dst_svcpart,
575 'order_by' => 'LIMIT 1',
584 =item check_part_svc_link_unprovision
586 Checks service dependency unprovision rules for this service.
588 If there is an error, returns the error, otherwise returns false.
592 sub check_part_svc_link_unprovision {
595 foreach my $part_svc_link ( $self->part_svc_link(
596 link_type => 'cust_svc_unprovision_restrict',
599 return $part_svc_link->dst_svc. ' must be unprovisioned before '.
600 $part_svc_link->src_svc
602 'table' => 'cust_svc',
603 'hashref' => { 'pkgnum' => $self->pkgnum,
604 'svcpart' => $part_svc_link->dst_svcpart,
606 'order_by' => 'LIMIT 1',
615 Returns the service dependencies (see L<FS::part_svc_link>) for the given
616 search options, taking into account this service definition as source and
617 this customer's agent.
619 Available options are any field in part_svc_link. Typically used options are
626 my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
627 FS::part_svc_link->by_agentnum($agentnum,
628 src_svcpart=>$self->svcpart,
636 Returns the displayed service number for this service: agent_svcid if it has a
637 value, svcnum otherwise
643 $self->agent_svcid || $self->svcnum;
648 Returns the definition for this service, as a FS::part_svc object (see
655 return $self->{_svcpart} if $self->{_svcpart};
656 cluck 'cust_svc->part_svc called' if $DEBUG;
657 qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
662 Returns the package this service belongs to, as a FS::cust_pkg object (see
667 Returns the pkg_svc record for for this service, if applicable.
673 my $cust_pkg = $self->cust_pkg;
674 return undef unless $cust_pkg;
676 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
677 'pkgpart' => $cust_pkg->pkgpart,
684 Returns the date this service was inserted.
690 $self->h_date('insert');
693 =item pkg_cancel_date
695 Returns the date this service's package was canceled. This normally only
696 exists for a service that's been preserved through cancellation with the
697 part_pkg.preserve flag.
701 sub pkg_cancel_date {
703 my $cust_pkg = $self->cust_pkg or return;
704 return $cust_pkg->getfield('cancel') || '';
707 =item label [ LOCALE ]
709 Returns a list consisting of:
710 - The name of this service (from part_svc), optionally localized
711 - A meaningful identifier (username, domain, or mail alias)
712 - The table name (i.e. svc_domain) for this service
717 my($label, $value, $svcdb) = $cust_svc->label;
719 =item label_long [ LOCALE ]
721 Like the B<label> method, except the second item in the list ("meaningful
722 identifier") may be longer - typically, a full name is included.
726 sub label { shift->_label('svc_label', @_); }
727 sub label_long { shift->_label('svc_label_long', @_); }
733 my $svc_x = $self->svc_x
734 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
736 $self->$method($svc_x, undef, undef, $locale);
739 # svc_label(_long) takes three arguments: end date, start date, locale
740 # and FS::svc_*::label methods must accept those also, if they even care
742 sub svc_label { shift->_svc_label('label', @_); }
743 sub svc_label_long { shift->_svc_label('label_long', @_); }
746 my( $self, $method, $svc_x ) = ( shift, shift, shift );
747 my ($end, $start, $locale) = @_;
750 $self->part_svc->svc_locale($locale),
752 $self->part_svc->svcdb,
760 Returns a listref of html elements associated with this service's exports.
766 my $svc_x = $self->svc_x
767 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
769 $svc_x->export_links;
772 =item export_getsettings
774 Returns two hashrefs of settings associated with this service's exports.
778 sub export_getsettings {
780 my $svc_x = $self->svc_x
781 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
783 $svc_x->export_getsettings;
789 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
790 FS::svc_domain object, etc.)
796 my $svcdb = $self->part_svc->svcdb;
797 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
798 $self->{'_svc_acct'};
800 require "FS/$svcdb.pm";
801 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
802 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
804 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
808 =item seconds_since TIMESTAMP
810 See L<FS::svc_acct/seconds_since>. Equivalent to
811 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
812 where B<svcdb> is not "svc_acct".
816 #internal session db deprecated (or at least on hold)
817 sub seconds_since { 'internal session db deprecated'; };
818 ##note: implementation here, POD in FS::svc_acct
820 # my($self, $since) = @_;
822 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
825 # AND logout IS NOT NULL'
826 # ) or die $dbh->errstr;
827 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
828 # $sth->fetchrow_arrayref->[0];
831 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
833 Equivalent to $cust_svc->svc_x->seconds_since_sqlradacct, but
834 more efficient. Meaningless for records where B<svcdb> is not
835 svc_acct or svc_broadband.
839 sub seconds_since_sqlradacct {
840 my($self, $start, $end) = @_;
842 my $mes = "$me seconds_since_sqlradacct:";
844 my $svc_x = $self->svc_x;
846 my @part_export = $self->part_svc->part_export_usage;
847 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
848 " service definition"
853 foreach my $part_export ( @part_export ) {
855 next if $part_export->option('ignore_accounting');
857 warn "$mes connecting to sqlradius database\n"
860 my $dbh = DBI->connect( map { $part_export->option($_) }
861 qw(datasrc username password) )
862 or die "can't connect to sqlradius database: ". $DBI::errstr;
864 warn "$mes connected to sqlradius database\n"
867 #select a unix time conversion function based on database type
868 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
869 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
871 my $username = $part_export->export_username($svc_x);
875 warn "$mes finding closed sessions completely within the given range\n"
880 if ($part_export->option('process_single_realm')) {
881 $realm = 'AND Realm = ?';
882 $realmparam = $part_export->option('realm');
885 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
889 AND $str2time AcctStartTime $closing >= ?
890 AND $str2time AcctStopTime $closing < ?
891 AND $str2time AcctStopTime $closing > 0
892 AND AcctStopTime IS NOT NULL"
893 ) or die $dbh->errstr;
894 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
896 my $regular = $sth->fetchrow_arrayref->[0];
898 warn "$mes finding open sessions which start in the range\n"
901 # count session start->range end
902 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
906 AND $str2time AcctStartTime $closing >= ?
907 AND $str2time AcctStartTime $closing < ?
908 AND ( ? - $str2time AcctStartTime $closing ) < 86400
909 AND ( $str2time AcctStopTime $closing = 0
910 OR AcctStopTime IS NULL )";
911 $sth = $dbh->prepare($query) or die $dbh->errstr;
914 ($realm ? $realmparam : ()),
918 or die $sth->errstr. " executing query $query";
919 my $start_during = $sth->fetchrow_arrayref->[0];
921 warn "$mes finding closed sessions which start before the range but stop during\n"
924 #count range start->session end
925 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
929 AND $str2time AcctStartTime $closing < ?
930 AND $str2time AcctStopTime $closing >= ?
931 AND $str2time AcctStopTime $closing < ?
932 AND $str2time AcctStopTime $closing > 0
933 AND AcctStopTime IS NOT NULL"
934 ) or die $dbh->errstr;
935 $sth->execute( $start,
937 ($realm ? $realmparam : ()),
942 my $end_during = $sth->fetchrow_arrayref->[0];
944 warn "$mes finding closed sessions which start before the range but stop after\n"
947 # count range start->range end
948 # don't count open sessions anymore (probably missing stop record)
949 $sth = $dbh->prepare("SELECT COUNT(*)
953 AND $str2time AcctStartTime $closing < ?
954 AND ( $str2time AcctStopTime $closing >= ?
956 # OR AcctStopTime = 0
957 # OR AcctStopTime IS NULL )"
958 ) or die $dbh->errstr;
959 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
961 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
963 $seconds += $regular + $end_during + $start_during + $entire_range;
965 warn "$mes done finding sessions\n"
974 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
976 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
977 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.
978 Meaningless for records where B<svcdb> is not svc_acct or svc_broadband.
982 #(false laziness w/seconds_since_sqlradacct above)
983 sub attribute_since_sqlradacct {
984 my($self, $start, $end, $attrib) = @_;
986 my $mes = "$me attribute_since_sqlradacct:";
988 my $svc_x = $self->svc_x;
990 my @part_export = $self->part_svc->part_export_usage;
991 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
992 " service definition"
998 foreach my $part_export ( @part_export ) {
1000 next if $part_export->option('ignore_accounting');
1002 warn "$mes connecting to sqlradius database\n"
1005 my $dbh = DBI->connect( map { $part_export->option($_) }
1006 qw(datasrc username password) )
1007 or die "can't connect to sqlradius database: ". $DBI::errstr;
1009 warn "$mes connected to sqlradius database\n"
1012 #select a unix time conversion function based on database type
1013 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1014 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1016 my $username = $part_export->export_username($svc_x);
1018 warn "$mes SUMing $attrib sessions\n"
1022 my $realmparam = '';
1023 if ($part_export->option('process_single_realm')) {
1024 $realm = 'AND Realm = ?';
1025 $realmparam = $part_export->option('realm');
1028 my $sth = $dbh->prepare("SELECT SUM($attrib)
1032 AND $str2time AcctStopTime $closing >= ?
1033 AND $str2time AcctStopTime $closing < ?
1034 AND AcctStopTime IS NOT NULL"
1035 ) or die $dbh->errstr;
1036 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
1037 or die $sth->errstr;
1039 my $row = $sth->fetchrow_arrayref;
1040 $sum += $row->[0] if defined($row->[0]);
1042 warn "$mes done SUMing sessions\n"
1051 #note: implementation here, POD in FS::svc_acct
1052 # false laziness w/above
1053 sub attribute_last_sqlradacct {
1054 my($self, $attrib) = @_;
1056 my $mes = "$me attribute_last_sqlradacct:";
1058 my $svc_x = $self->svc_x;
1060 my @part_export = $self->part_svc->part_export_usage;
1061 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1062 " service definition"
1063 unless @part_export;
1067 my $AcctStartTime = 0;
1069 foreach my $part_export ( @part_export ) {
1071 next if $part_export->option('ignore_accounting');
1073 warn "$mes connecting to sqlradius database\n"
1076 my $dbh = DBI->connect( map { $part_export->option($_) }
1077 qw(datasrc username password) )
1078 or die "can't connect to sqlradius database: ". $DBI::errstr;
1080 warn "$mes connected to sqlradius database\n"
1083 #select a unix time conversion function based on database type
1084 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1085 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1087 my $username = $part_export->export_username($svc_x);
1089 warn "$mes finding most-recent $attrib\n"
1093 my $realmparam = '';
1094 if ($part_export->option('process_single_realm')) {
1095 $realm = 'AND Realm = ?';
1096 $realmparam = $part_export->option('realm');
1099 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1103 ORDER BY AcctStartTime DESC LIMIT 1
1104 ") or die $dbh->errstr;
1105 $sth->execute($username, ($realm ? $realmparam : ()) )
1106 or die $sth->errstr;
1108 my $row = $sth->fetchrow_arrayref;
1109 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1111 $AcctStartTime = $row->[1];
1123 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1125 See L<FS::svc_acct/get_session_history>. Equivalent to
1126 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1127 records where B<svcdb> is not "svc_acct".
1131 sub get_session_history {
1132 my($self, $start, $end, $attrib) = @_;
1136 my @part_export = $self->part_svc->part_export_usage;
1137 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1138 " service definition"
1139 unless @part_export;
1144 foreach my $part_export ( @part_export ) {
1146 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1153 =item tickets [ STATUS ]
1155 Returns an array of hashes representing the tickets linked to this service.
1157 An optional status (or arrayref or hashref of statuses) may be specified.
1163 my $status = ( @_ && $_[0] ) ? shift : '';
1165 my $conf = FS::Conf->new;
1166 my $num = $conf->config('cust_main-max_tickets') || 10;
1169 if ( $conf->config('ticket_system') ) {
1170 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1172 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1181 foreach my $priority (
1182 $conf->config('ticket_system-custom_priority_field-values'), ''
1184 last if scalar(@tickets) >= $num;
1186 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1187 $num - scalar(@tickets),
1200 my $svc_x = $self->svc_x;
1201 +{ ( map { $_=>$self->$_ } $self->fields ),
1202 ( map { $_=>$svc_x->$_ } $svc_x->fields ),
1212 =item smart_search OPTION => VALUE ...
1214 Accepts the option I<search>, the string to search for. The string will
1215 be searched for as a username, email address, IP address, MAC address,
1216 phone number, and hardware serial number. Unlike the I<smart_search> on
1217 customers, this always requires an exact match.
1221 # though perhaps it should be fuzzy in some cases?
1224 my %param = __PACKAGE__->smart_search_param(@_);
1228 sub smart_search_param {
1232 my $string = $opt{'search'};
1233 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1236 map { my $table = $_;
1237 my $search_sql = "FS::$table"->search_sql($string);
1238 my $addl_from = "FS::$table"->search_sql_addl_from();
1240 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1241 "FROM $table $addl_from WHERE $search_sql";
1243 FS::part_svc->svc_tables;
1245 if ( $string =~ /^(\d+)$/ ) {
1246 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1249 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1250 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1254 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1255 'null_right' => 'View/link unlinked services'
1257 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1259 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1260 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1261 ' LEFT JOIN part_svc USING ( svcpart )';
1264 'table' => 'cust_svc',
1265 'select' => 'svc_all.svcnum AS svcnum, '.
1266 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1268 'addl_from' => $addl_from,
1270 'extra_sql' => $extra_sql,
1274 # If the associated cust_pkg is 'on hold'
1275 # and the associated pkg_svc has the provision_hold flag
1276 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1277 # then removes hold from pkg
1278 # returns $error or '' on success,
1279 # does not indicate if pkg status was changed
1280 sub _check_provision_hold {
1283 # check status of cust_pkg
1284 my $cust_pkg = $self->cust_pkg;
1285 return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1287 # check flag on this svc
1288 # small false laziness with $self->pkg_svc
1289 # to avoid looking up cust_pkg twice
1290 my $pkg_svc = qsearchs( 'pkg_svc', {
1291 'svcpart' => $self->svcpart,
1292 'pkgpart' => $cust_pkg->pkgpart,
1294 return '' unless $pkg_svc->provision_hold;
1296 # check for any others available with that flag
1297 return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1299 # conditions met, remove hold
1300 return $cust_pkg->unsuspend;
1306 # fix missing (deleted by mistake) svc_x records
1307 warn "searching for missing svc_x records...\n";
1309 'table' => 'cust_svc',
1310 'select' => 'cust_svc.*',
1311 'addl_from' => ' LEFT JOIN ( ' .
1313 map { "SELECT svcnum FROM $_" }
1314 FS::part_svc->svc_tables
1315 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1316 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1318 my @svcs = qsearch(\%search);
1319 warn "found ".scalar(@svcs)."\n";
1321 local $FS::Record::nowarn_classload = 1; # for h_svc_
1322 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1325 'hashref' => { history_action => 'delete' },
1326 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1328 foreach my $cust_svc (@svcs) {
1329 my $svcnum = $cust_svc->svcnum;
1330 my $svcdb = $cust_svc->part_svc->svcdb;
1331 $h_search{'hashref'}{'svcnum'} = $svcnum;
1332 $h_search{'table'} = "h_$svcdb";
1333 my $h_svc_x = qsearchs(\%h_search);
1335 my $class = "FS::$svcdb";
1336 my $new_svc_x = $class->new({ $h_svc_x->hash });
1337 my $error = $new_svc_x->insert;
1338 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1341 # can't be fixed, so remove the dangling cust_svc to avoid breaking
1343 my $error = $cust_svc->delete;
1344 warn "error cleaning up missing svcnum $svcnum ($svcdb):\n$error\n";
1355 Behaviour of changing the svcpart of cust_svc records is undefined and should
1356 possibly be prohibited, and pkg_svc records are not checked.
1358 pkg_svc records are not checked in general (here).
1360 Deleting this record doesn't check or delete the svc_* record associated
1363 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1364 a DBI database handle is not yet implemented.
1368 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1369 schema.html from the base documentation