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;
20 #most FS::svc_ classes are autoloaded in svc_x emthod
21 use FS::svc_acct; #this one is used in the cache stuff
29 #ask FS::UID to run this stuff for us later
30 FS::UID->install_callback( sub {
32 $ticket_system = $conf->config('ticket_system')
37 my ( $hashref, $cache ) = @_;
38 if ( $hashref->{'username'} ) {
39 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
41 if ( $hashref->{'svc'} ) {
42 $self->{'_svcpart'} = FS::part_svc->new($hashref);
48 FS::cust_svc - Object method for cust_svc objects
54 $record = new FS::cust_svc \%hash
55 $record = new FS::cust_svc { 'column' => 'value' };
57 $error = $record->insert;
59 $error = $new_record->replace($old_record);
61 $error = $record->delete;
63 $error = $record->check;
65 ($label, $value) = $record->label;
69 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
70 The following fields are currently supported:
74 =item svcnum - primary key (assigned automatically for new services)
76 =item pkgnum - Package (see L<FS::cust_pkg>)
78 =item svcpart - Service definition (see L<FS::part_svc>)
80 =item agent_svcid - Optional legacy service ID
82 =item overlimit - date the service exceeded its usage limit
92 Creates a new service. To add the refund to the database, see L<"insert">.
93 Services are normally created by creating FS::svc_ objects (see
94 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
98 sub table { 'cust_svc'; }
102 Adds this service to the database. If there is an error, returns the error,
103 otherwise returns false.
107 Deletes this service from the database. If there is an error, returns the
108 error, otherwise returns false. Note that this only removes the cust_svc
109 record - you should probably use the B<cancel> method instead.
118 my $cust_pkg = $self->cust_pkg;
119 my $custnum = $cust_pkg->custnum if $cust_pkg;
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::delete;
134 $dbh->rollback if $oldAutoCommit;
138 foreach my $part_svc_link ( $self->part_svc_link(
139 link_type => 'cust_svc_unprovision_cascade',
142 foreach my $cust_svc ( qsearch( 'cust_svc', {
143 'pkgnum' => $self->pkgnum,
144 'svcpart' => $part_svc_link->dst_svcpart,
147 my $error = $cust_svc->svc_x->delete;
149 $dbh->rollback if $oldAutoCommit;
156 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
158 if ( $ticket_system eq 'RT_Internal' ) {
159 unless ( $rt_session ) {
160 FS::TicketSystem->init;
161 $rt_session = FS::TicketSystem->session;
163 my $links = RT::Links->new($rt_session->{CurrentUser});
164 my $svcnum = $self->svcnum;
165 $links->Limit(FIELD => 'Target',
166 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
167 while ( my $l = $links->Next ) {
170 # re-link to point to the customer instead
172 $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
175 ($val, $msg) = $l->Delete;
177 # can't do anything useful on error
178 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
188 Suspends the relevant service by calling the B<suspend> method of the associated
189 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object).
191 If there is an error, returns the error, otherwise returns false.
196 my( $self, %opt ) = @_;
198 $self->part_svc->svcdb =~ /^([\w\-]+)$/ or return 'Illegal part_svc.svcdb';
200 require "FS/$svcdb.pm";
202 my $svc = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } )
205 my $error = $svc->suspend;
206 return $error if $error;
208 if ( $opt{labels_arryref} ) {
209 my( $label, $value ) = $self->label;
210 push @{ $opt{labels_arrayref} }, "$label: $value";
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
405 if ( $new->cust_pkg->locationnum != $old->cust_pkg->locationnum ) {
406 my $svc_x = $new->svc_x;
407 if ( $svc_x->locationnum ) {
408 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
409 # in this case, set the service location to be the same as the new
411 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
412 # and replace it, which triggers a relocate export so we don't
414 $error ||= $svc_x->replace;
416 # the service already has a different location from its package
420 # the service doesn't have a locationnum (either isn't of a type
421 # that has the locationnum field, or the locationnum is null and
422 # defaults to cust_pkg->locationnum)
423 # so just trigger the export here
424 $error ||= $new->svc_x->export('relocate',
425 $new->cust_pkg->cust_location,
426 $old->cust_pkg->cust_location,
428 } # if ($svc_x->locationnum)
429 } # if this is a location change
432 $dbh->rollback if $oldAutoCommit;
433 return $error if $error
436 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
443 Checks all fields to make sure this is a valid service. If there is an error,
444 returns the error, otherwise returns false. Called by the insert and
453 $self->ut_numbern('svcnum')
454 || $self->ut_numbern('pkgnum')
455 || $self->ut_number('svcpart')
456 || $self->ut_numbern('agent_svcid')
457 || $self->ut_numbern('overlimit')
459 return $error if $error;
461 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
462 return "Unknown svcpart" unless $part_svc;
464 if ( $self->pkgnum && ! $ignore_quantity ) {
466 #slightly inefficient since ->pkg_svc will also look it up, but fixing
467 # a much larger perf problem and have bigger fish to fry
468 my $cust_pkg = $self->cust_pkg;
470 my $pkg_svc = $self->pkg_svc
471 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
472 'pkgpart' => $cust_pkg->pkgpart,
476 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
477 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
478 my $addon_pkg_svc = qsearchs('pkg_svc', {
479 pkgpart => $part_pkg_link->dst_pkgpart,
480 svcpart => $self->svcpart,
482 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
486 #better error message? UI shouldn't get here
487 return "No svcpart ". $self->svcpart.
488 " services in pkgpart ". $cust_pkg->pkgpart
489 unless $pkg_svc->quantity > 0;
491 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
493 #false laziness w/cust_pkg->part_svc
494 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
498 #better error message? again, UI shouldn't get here
499 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
500 " services for pkgnum ". $self->pkgnum
503 #part_svc_link rules (only make sense in pkgpart context, and
504 # skipping this when ignore_quantity is set DTRT when we're "forcing"
505 # an implicit change here (location change triggered pkgpart change,
506 # ->overlimit, bulk customer service changes)
507 foreach my $part_svc_link ( $self->part_svc_link(
508 link_type => 'cust_svc_provision_restrict',
511 return $part_svc_link->dst_svc. ' must be provisioned before '.
512 $part_svc_link->src_svc
514 'table' => 'cust_svc',
515 'hashref' => { 'pkgnum' => $self->pkgnum,
516 'svcpart' => $part_svc_link->dst_svcpart,
518 'order_by' => 'LIMIT 1',
527 =item check_part_svc_link_unprovision
529 Checks service dependency unprovision rules for this service.
531 If there is an error, returns the error, otherwise returns false.
535 sub check_part_svc_link_unprovision {
538 foreach my $part_svc_link ( $self->part_svc_link(
539 link_type => 'cust_svc_unprovision_restrict',
542 return $part_svc_link->dst_svc. ' must be unprovisioned before '.
543 $part_svc_link->src_svc
545 'table' => 'cust_svc',
546 'hashref' => { 'pkgnum' => $self->pkgnum,
547 'svcpart' => $part_svc_link->dst_svcpart,
549 'order_by' => 'LIMIT 1',
558 Returns the service dependencies (see L<FS::part_svc_link>) for the given
559 search options, taking into account this service definition as source and
560 this customer's agent.
562 Available options are any field in part_svc_link. Typically used options are
569 my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
570 FS::part_svc_link->by_agentnum($agentnum, src_svcpart=>$self->svcpart, @_);
575 Returns the displayed service number for this service: agent_svcid if it has a
576 value, svcnum otherwise
582 $self->agent_svcid || $self->svcnum;
587 Returns the definition for this service, as a FS::part_svc object (see
595 ? $self->{'_svcpart'}
596 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
601 Returns the package this service belongs to, as a FS::cust_pkg object (see
606 Returns the pkg_svc record for for this service, if applicable.
612 my $cust_pkg = $self->cust_pkg;
613 return undef unless $cust_pkg;
615 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
616 'pkgpart' => $cust_pkg->pkgpart,
623 Returns the date this service was inserted.
629 $self->h_date('insert');
632 =item pkg_cancel_date
634 Returns the date this service's package was canceled. This normally only
635 exists for a service that's been preserved through cancellation with the
636 part_pkg.preserve flag.
640 sub pkg_cancel_date {
642 my $cust_pkg = $self->cust_pkg or return;
643 return $cust_pkg->getfield('cancel') || '';
648 Returns a list consisting of:
649 - The name of this service (from part_svc)
650 - A meaningful identifier (username, domain, or mail alias)
651 - The table name (i.e. svc_domain) for this service
656 my($label, $value, $svcdb) = $cust_svc->label;
660 Like the B<label> method, except the second item in the list ("meaningful
661 identifier") may be longer - typically, a full name is included.
665 sub label { shift->_label('svc_label', @_); }
666 sub label_long { shift->_label('svc_label_long', @_); }
671 my $svc_x = $self->svc_x
672 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
674 $self->$method($svc_x);
677 sub svc_label { shift->_svc_label('label', @_); }
678 sub svc_label_long { shift->_svc_label('label_long', @_); }
681 my( $self, $method, $svc_x ) = ( shift, shift, shift );
684 $self->part_svc->svc,
686 $self->part_svc->svcdb,
694 Returns a listref of html elements associated with this service's exports.
700 my $svc_x = $self->svc_x
701 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
703 $svc_x->export_links;
706 =item export_getsettings
708 Returns two hashrefs of settings associated with this service's exports.
712 sub export_getsettings {
714 my $svc_x = $self->svc_x
715 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
717 $svc_x->export_getsettings;
723 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
724 FS::svc_domain object, etc.)
730 my $svcdb = $self->part_svc->svcdb;
731 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
732 $self->{'_svc_acct'};
734 require "FS/$svcdb.pm";
735 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
736 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
738 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
742 =item seconds_since TIMESTAMP
744 See L<FS::svc_acct/seconds_since>. Equivalent to
745 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
746 where B<svcdb> is not "svc_acct".
750 #internal session db deprecated (or at least on hold)
751 sub seconds_since { 'internal session db deprecated'; };
752 ##note: implementation here, POD in FS::svc_acct
754 # my($self, $since) = @_;
756 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
759 # AND logout IS NOT NULL'
760 # ) or die $dbh->errstr;
761 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
762 # $sth->fetchrow_arrayref->[0];
765 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
767 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
768 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
769 for records where B<svcdb> is not "svc_acct".
773 #note: implementation here, POD in FS::svc_acct
774 sub seconds_since_sqlradacct {
775 my($self, $start, $end) = @_;
777 my $mes = "$me seconds_since_sqlradacct:";
779 my $svc_x = $self->svc_x;
781 my @part_export = $self->part_svc->part_export_usage;
782 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
783 " service definition"
788 foreach my $part_export ( @part_export ) {
790 next if $part_export->option('ignore_accounting');
792 warn "$mes connecting to sqlradius database\n"
795 my $dbh = DBI->connect( map { $part_export->option($_) }
796 qw(datasrc username password) )
797 or die "can't connect to sqlradius database: ". $DBI::errstr;
799 warn "$mes connected to sqlradius database\n"
802 #select a unix time conversion function based on database type
803 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
804 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
806 my $username = $part_export->export_username($svc_x);
810 warn "$mes finding closed sessions completely within the given range\n"
815 if ($part_export->option('process_single_realm')) {
816 $realm = 'AND Realm = ?';
817 $realmparam = $part_export->option('realm');
820 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
824 AND $str2time AcctStartTime $closing >= ?
825 AND $str2time AcctStopTime $closing < ?
826 AND $str2time AcctStopTime $closing > 0
827 AND AcctStopTime IS NOT NULL"
828 ) or die $dbh->errstr;
829 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
831 my $regular = $sth->fetchrow_arrayref->[0];
833 warn "$mes finding open sessions which start in the range\n"
836 # count session start->range end
837 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
841 AND $str2time AcctStartTime $closing >= ?
842 AND $str2time AcctStartTime $closing < ?
843 AND ( ? - $str2time AcctStartTime $closing ) < 86400
844 AND ( $str2time AcctStopTime $closing = 0
845 OR AcctStopTime IS NULL )";
846 $sth = $dbh->prepare($query) or die $dbh->errstr;
849 ($realm ? $realmparam : ()),
853 or die $sth->errstr. " executing query $query";
854 my $start_during = $sth->fetchrow_arrayref->[0];
856 warn "$mes finding closed sessions which start before the range but stop during\n"
859 #count range start->session end
860 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
864 AND $str2time AcctStartTime $closing < ?
865 AND $str2time AcctStopTime $closing >= ?
866 AND $str2time AcctStopTime $closing < ?
867 AND $str2time AcctStopTime $closing > 0
868 AND AcctStopTime IS NOT NULL"
869 ) or die $dbh->errstr;
870 $sth->execute( $start,
872 ($realm ? $realmparam : ()),
877 my $end_during = $sth->fetchrow_arrayref->[0];
879 warn "$mes finding closed sessions which start before the range but stop after\n"
882 # count range start->range end
883 # don't count open sessions anymore (probably missing stop record)
884 $sth = $dbh->prepare("SELECT COUNT(*)
888 AND $str2time AcctStartTime $closing < ?
889 AND ( $str2time AcctStopTime $closing >= ?
891 # OR AcctStopTime = 0
892 # OR AcctStopTime IS NULL )"
893 ) or die $dbh->errstr;
894 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
896 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
898 $seconds += $regular + $end_during + $start_during + $entire_range;
900 warn "$mes done finding sessions\n"
909 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
911 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
912 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
913 for records where B<svcdb> is not "svc_acct".
917 #note: implementation here, POD in FS::svc_acct
918 #(false laziness w/seconds_since_sqlradacct above)
919 sub attribute_since_sqlradacct {
920 my($self, $start, $end, $attrib) = @_;
922 my $mes = "$me attribute_since_sqlradacct:";
924 my $svc_x = $self->svc_x;
926 my @part_export = $self->part_svc->part_export_usage;
927 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
928 " service definition"
934 foreach my $part_export ( @part_export ) {
936 next if $part_export->option('ignore_accounting');
938 warn "$mes connecting to sqlradius database\n"
941 my $dbh = DBI->connect( map { $part_export->option($_) }
942 qw(datasrc username password) )
943 or die "can't connect to sqlradius database: ". $DBI::errstr;
945 warn "$mes connected to sqlradius database\n"
948 #select a unix time conversion function based on database type
949 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
950 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
952 my $username = $part_export->export_username($svc_x);
954 warn "$mes SUMing $attrib sessions\n"
959 if ($part_export->option('process_single_realm')) {
960 $realm = 'AND Realm = ?';
961 $realmparam = $part_export->option('realm');
964 my $sth = $dbh->prepare("SELECT SUM($attrib)
968 AND $str2time AcctStopTime $closing >= ?
969 AND $str2time AcctStopTime $closing < ?
970 AND AcctStopTime IS NOT NULL"
971 ) or die $dbh->errstr;
972 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
975 my $row = $sth->fetchrow_arrayref;
976 $sum += $row->[0] if defined($row->[0]);
978 warn "$mes done SUMing sessions\n"
987 #note: implementation here, POD in FS::svc_acct
988 # false laziness w/above
989 sub attribute_last_sqlradacct {
990 my($self, $attrib) = @_;
992 my $mes = "$me attribute_last_sqlradacct:";
994 my $svc_x = $self->svc_x;
996 my @part_export = $self->part_svc->part_export_usage;
997 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
998 " service definition"
1003 my $AcctStartTime = 0;
1005 foreach my $part_export ( @part_export ) {
1007 next if $part_export->option('ignore_accounting');
1009 warn "$mes connecting to sqlradius database\n"
1012 my $dbh = DBI->connect( map { $part_export->option($_) }
1013 qw(datasrc username password) )
1014 or die "can't connect to sqlradius database: ". $DBI::errstr;
1016 warn "$mes connected to sqlradius database\n"
1019 #select a unix time conversion function based on database type
1020 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1021 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1023 my $username = $part_export->export_username($svc_x);
1025 warn "$mes finding most-recent $attrib\n"
1029 my $realmparam = '';
1030 if ($part_export->option('process_single_realm')) {
1031 $realm = 'AND Realm = ?';
1032 $realmparam = $part_export->option('realm');
1035 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1039 ORDER BY AcctStartTime DESC LIMIT 1
1040 ") or die $dbh->errstr;
1041 $sth->execute($username, ($realm ? $realmparam : ()) )
1042 or die $sth->errstr;
1044 my $row = $sth->fetchrow_arrayref;
1045 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1047 $AcctStartTime = $row->[1];
1059 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1061 See L<FS::svc_acct/get_session_history>. Equivalent to
1062 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1063 records where B<svcdb> is not "svc_acct".
1067 sub get_session_history {
1068 my($self, $start, $end, $attrib) = @_;
1072 my @part_export = $self->part_svc->part_export_usage;
1073 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1074 " service definition"
1075 unless @part_export;
1080 foreach my $part_export ( @part_export ) {
1082 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1089 =item tickets [ STATUS ]
1091 Returns an array of hashes representing the tickets linked to this service.
1093 An optional status (or arrayref or hashref of statuses) may be specified.
1099 my $status = ( @_ && $_[0] ) ? shift : '';
1101 my $conf = FS::Conf->new;
1102 my $num = $conf->config('cust_main-max_tickets') || 10;
1105 if ( $conf->config('ticket_system') ) {
1106 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1108 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1117 foreach my $priority (
1118 $conf->config('ticket_system-custom_priority_field-values'), ''
1120 last if scalar(@tickets) >= $num;
1122 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1123 $num - scalar(@tickets),
1136 my $svc_x = $self->svc_x;
1137 +{ ( map { $_=>$self->$_ } $self->fields ),
1138 ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ),
1148 =item smart_search OPTION => VALUE ...
1150 Accepts the option I<search>, the string to search for. The string will
1151 be searched for as a username, email address, IP address, MAC address,
1152 phone number, and hardware serial number. Unlike the I<smart_search> on
1153 customers, this always requires an exact match.
1157 # though perhaps it should be fuzzy in some cases?
1160 my %param = __PACKAGE__->smart_search_param(@_);
1164 sub smart_search_param {
1168 my $string = $opt{'search'};
1169 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1172 map { my $table = $_;
1173 my $search_sql = "FS::$table"->search_sql($string);
1175 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1176 "FROM $table WHERE $search_sql";
1178 FS::part_svc->svc_tables;
1180 if ( $string =~ /^(\d+)$/ ) {
1181 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1184 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1185 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1189 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1190 'null_right' => 'View/link unlinked services'
1192 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1194 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1195 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1196 ' LEFT JOIN part_svc USING ( svcpart )';
1199 'table' => 'cust_svc',
1200 'select' => 'svc_all.svcnum AS svcnum, '.
1201 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1203 'addl_from' => $addl_from,
1205 'extra_sql' => $extra_sql,
1212 # fix missing (deleted by mistake) svc_x records
1213 warn "searching for missing svc_x records...\n";
1215 'table' => 'cust_svc',
1216 'select' => 'cust_svc.*',
1217 'addl_from' => ' LEFT JOIN ( ' .
1219 map { "SELECT svcnum FROM $_" }
1220 FS::part_svc->svc_tables
1221 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1222 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1224 my @svcs = qsearch(\%search);
1225 warn "found ".scalar(@svcs)."\n";
1227 local $FS::Record::nowarn_classload = 1; # for h_svc_
1228 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1231 'hashref' => { history_action => 'delete' },
1232 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1234 foreach my $cust_svc (@svcs) {
1235 my $svcnum = $cust_svc->svcnum;
1236 my $svcdb = $cust_svc->part_svc->svcdb;
1237 $h_search{'hashref'}{'svcnum'} = $svcnum;
1238 $h_search{'table'} = "h_$svcdb";
1239 my $h_svc_x = qsearchs(\%h_search)
1241 my $class = "FS::$svcdb";
1242 my $new_svc_x = $class->new({ $h_svc_x->hash });
1243 my $error = $new_svc_x->insert;
1244 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1255 Behaviour of changing the svcpart of cust_svc records is undefined and should
1256 possibly be prohibited, and pkg_svc records are not checked.
1258 pkg_svc records are not checked in general (here).
1260 Deleting this record doesn't check or delete the svc_* record associated
1263 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1264 a DBI database handle is not yet implemented.
1268 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1269 schema.html from the base documentation