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 Cancels the relevant service by calling the B<cancel> method of the associated
189 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
190 deleting the FS::svc_XXX record and then deleting this record.
192 If there is an error, returns the error, otherwise returns false.
199 local $SIG{HUP} = 'IGNORE';
200 local $SIG{INT} = 'IGNORE';
201 local $SIG{QUIT} = 'IGNORE';
202 local $SIG{TERM} = 'IGNORE';
203 local $SIG{TSTP} = 'IGNORE';
204 local $SIG{PIPE} = 'IGNORE';
206 my $oldAutoCommit = $FS::UID::AutoCommit;
207 local $FS::UID::AutoCommit = 0;
210 my $part_svc = $self->part_svc;
212 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
213 $dbh->rollback if $oldAutoCommit;
214 return "Illegal svcdb value in part_svc!";
217 require "FS/$svcdb.pm";
219 my $svc = $self->svc_x;
221 if ( %opt && $opt{'date'} ) {
222 my $error = $svc->expire($opt{'date'});
224 $dbh->rollback if $oldAutoCommit;
225 return "Error expiring service: $error";
228 my $error = $svc->cancel;
230 $dbh->rollback if $oldAutoCommit;
231 return "Error canceling service: $error";
233 $error = $svc->delete; #this deletes this cust_svc record as well
235 $dbh->rollback if $oldAutoCommit;
236 return "Error deleting service: $error";
243 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
244 "; deleting cust_svc only\n";
246 my $error = $self->delete;
248 $dbh->rollback if $oldAutoCommit;
249 return "Error deleting cust_svc: $error";
254 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
260 =item overlimit [ ACTION ]
262 Retrieves or sets the overlimit date. If ACTION is absent, return
263 the present value of overlimit. If ACTION is present, it can
264 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
265 is set to the current time if it is not already set. The 'unsuspend' value
266 causes the time to be cleared.
268 If there is an error on setting, returns the error, otherwise returns false.
274 my $action = shift or return $self->getfield('overlimit');
276 local $SIG{HUP} = 'IGNORE';
277 local $SIG{INT} = 'IGNORE';
278 local $SIG{QUIT} = 'IGNORE';
279 local $SIG{TERM} = 'IGNORE';
280 local $SIG{TSTP} = 'IGNORE';
281 local $SIG{PIPE} = 'IGNORE';
283 my $oldAutoCommit = $FS::UID::AutoCommit;
284 local $FS::UID::AutoCommit = 0;
287 if ( $action eq 'suspend' ) {
288 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
289 }elsif ( $action eq 'unsuspend' ) {
290 $self->setfield('overlimit', '');
292 die "unexpected action value: $action";
295 local $ignore_quantity = 1;
296 my $error = $self->replace;
298 $dbh->rollback if $oldAutoCommit;
299 return "Error setting overlimit: $error";
302 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
308 =item replace OLD_RECORD
310 Replaces the OLD_RECORD with this one in the database. If there is an error,
311 returns the error, otherwise returns false.
318 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
320 # : $new->replace_old;
321 my ( $new, $old ) = ( shift, shift );
322 $old = $new->replace_old unless defined($old);
324 local $SIG{HUP} = 'IGNORE';
325 local $SIG{INT} = 'IGNORE';
326 local $SIG{QUIT} = 'IGNORE';
327 local $SIG{TERM} = 'IGNORE';
328 local $SIG{TSTP} = 'IGNORE';
329 local $SIG{PIPE} = 'IGNORE';
331 my $oldAutoCommit = $FS::UID::AutoCommit;
332 local $FS::UID::AutoCommit = 0;
335 if ( $new->svcpart != $old->svcpart ) {
336 my $svc_x = $new->svc_x;
337 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
338 local($FS::Record::nowarn_identical) = 1;
339 my $error = $new_svc_x->replace($svc_x);
341 $dbh->rollback if $oldAutoCommit;
342 return $error if $error;
346 # #trigger a re-export on pkgnum changes?
347 # # (of prepaid packages), for Expiration RADIUS attribute
348 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
349 # my $svc_x = $new->svc_x;
350 # local($FS::Record::nowarn_identical) = 1;
351 # my $error = $svc_x->export('replace');
353 # $dbh->rollback if $oldAutoCommit;
354 # return $error if $error;
358 #trigger a pkg_change export on pkgnum changes
359 if ( $new->pkgnum != $old->pkgnum ) {
360 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
365 $dbh->rollback if $oldAutoCommit;
366 return $error if $error;
368 } # if pkgnum is changing
370 #my $error = $new->SUPER::replace($old, @_);
371 my $error = $new->SUPER::replace($old);
373 #trigger a relocate export on location changes
374 if ( $new->cust_pkg->locationnum != $old->cust_pkg->locationnum ) {
375 my $svc_x = $new->svc_x;
376 if ( $svc_x->locationnum ) {
377 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
378 # in this case, set the service location to be the same as the new
380 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
381 # and replace it, which triggers a relocate export so we don't
383 $error ||= $svc_x->replace;
385 # the service already has a different location from its package
389 # the service doesn't have a locationnum (either isn't of a type
390 # that has the locationnum field, or the locationnum is null and
391 # defaults to cust_pkg->locationnum)
392 # so just trigger the export here
393 $error ||= $new->svc_x->export('relocate',
394 $new->cust_pkg->cust_location,
395 $old->cust_pkg->cust_location,
397 } # if ($svc_x->locationnum)
398 } # if this is a location change
401 $dbh->rollback if $oldAutoCommit;
402 return $error if $error
405 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
412 Checks all fields to make sure this is a valid service. If there is an error,
413 returns the error, otherwise returns false. Called by the insert and
422 $self->ut_numbern('svcnum')
423 || $self->ut_numbern('pkgnum')
424 || $self->ut_number('svcpart')
425 || $self->ut_numbern('agent_svcid')
426 || $self->ut_numbern('overlimit')
428 return $error if $error;
430 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
431 return "Unknown svcpart" unless $part_svc;
433 if ( $self->pkgnum && ! $ignore_quantity ) {
435 #slightly inefficient since ->pkg_svc will also look it up, but fixing
436 # a much larger perf problem and have bigger fish to fry
437 my $cust_pkg = $self->cust_pkg;
439 my $pkg_svc = $self->pkg_svc
440 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
441 'pkgpart' => $cust_pkg->pkgpart,
445 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
446 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
447 my $addon_pkg_svc = qsearchs('pkg_svc', {
448 pkgpart => $part_pkg_link->dst_pkgpart,
449 svcpart => $self->svcpart,
451 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
455 #better error message? UI shouldn't get here
456 return "No svcpart ". $self->svcpart.
457 " services in pkgpart ". $cust_pkg->pkgpart
458 unless $pkg_svc->quantity > 0;
460 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
462 #false laziness w/cust_pkg->part_svc
463 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
467 #better error message? again, UI shouldn't get here
468 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
469 " services for pkgnum ". $self->pkgnum
472 #part_svc_link rules (only make sense in pkgpart context, and
473 # skipping this when ignore_quantity is set DTRT when we're "forcing"
474 # an implicit change here (location change triggered pkgpart change,
475 # ->overlimit, bulk customer service changes)
476 foreach my $part_svc_link ( $self->part_svc_link(
477 link_type => 'cust_svc_provision_restrict',
480 return $part_svc_link->dst_svc. ' must be provisioned before '.
481 $part_svc_link->src_svc
483 'table' => 'cust_svc',
484 'hashref' => { 'pkgnum' => $self->pkgnum,
485 'svcpart' => $part_svc_link->dst_svcpart,
487 'order_by' => 'LIMIT 1',
496 =item check_part_svc_link_unprovision
498 Checks service dependency unprovision rules for this service.
500 If there is an error, returns the error, otherwise returns false.
504 sub check_part_svc_link_unprovision {
507 foreach my $part_svc_link ( $self->part_svc_link(
508 link_type => 'cust_svc_unprovision_restrict',
511 return $part_svc_link->dst_svc. ' must be unprovisioned 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 Returns the service dependencies (see L<FS::part_svc_link>) for the given
528 search options, taking into account this service definition as source and
529 this customer's agent.
531 Available options are any field in part_svc_link. Typically used options are
538 my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
539 FS::part_svc_link->by_agentnum($agentnum, src_svcpart=>$self->svcpart, @_);
544 Returns the displayed service number for this service: agent_svcid if it has a
545 value, svcnum otherwise
551 $self->agent_svcid || $self->svcnum;
556 Returns the definition for this service, as a FS::part_svc object (see
564 ? $self->{'_svcpart'}
565 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
570 Returns the package this service belongs to, as a FS::cust_pkg object (see
575 Returns the pkg_svc record for for this service, if applicable.
581 my $cust_pkg = $self->cust_pkg;
582 return undef unless $cust_pkg;
584 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
585 'pkgpart' => $cust_pkg->pkgpart,
592 Returns the date this service was inserted.
598 $self->h_date('insert');
601 =item pkg_cancel_date
603 Returns the date this service's package was canceled. This normally only
604 exists for a service that's been preserved through cancellation with the
605 part_pkg.preserve flag.
609 sub pkg_cancel_date {
611 my $cust_pkg = $self->cust_pkg or return;
612 return $cust_pkg->getfield('cancel') || '';
617 Returns a list consisting of:
618 - The name of this service (from part_svc)
619 - A meaningful identifier (username, domain, or mail alias)
620 - The table name (i.e. svc_domain) for this service
625 my($label, $value, $svcdb) = $cust_svc->label;
629 Like the B<label> method, except the second item in the list ("meaningful
630 identifier") may be longer - typically, a full name is included.
634 sub label { shift->_label('svc_label', @_); }
635 sub label_long { shift->_label('svc_label_long', @_); }
640 my $svc_x = $self->svc_x
641 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
643 $self->$method($svc_x);
646 sub svc_label { shift->_svc_label('label', @_); }
647 sub svc_label_long { shift->_svc_label('label_long', @_); }
650 my( $self, $method, $svc_x ) = ( shift, shift, shift );
653 $self->part_svc->svc,
655 $self->part_svc->svcdb,
663 Returns a listref of html elements associated with this service's exports.
669 my $svc_x = $self->svc_x
670 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
672 $svc_x->export_links;
675 =item export_getsettings
677 Returns two hashrefs of settings associated with this service's exports.
681 sub export_getsettings {
683 my $svc_x = $self->svc_x
684 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
686 $svc_x->export_getsettings;
692 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
693 FS::svc_domain object, etc.)
699 my $svcdb = $self->part_svc->svcdb;
700 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
701 $self->{'_svc_acct'};
703 require "FS/$svcdb.pm";
704 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
705 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
707 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
711 =item seconds_since TIMESTAMP
713 See L<FS::svc_acct/seconds_since>. Equivalent to
714 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
715 where B<svcdb> is not "svc_acct".
719 #internal session db deprecated (or at least on hold)
720 sub seconds_since { 'internal session db deprecated'; };
721 ##note: implementation here, POD in FS::svc_acct
723 # my($self, $since) = @_;
725 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
728 # AND logout IS NOT NULL'
729 # ) or die $dbh->errstr;
730 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
731 # $sth->fetchrow_arrayref->[0];
734 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
736 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
737 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
738 for records where B<svcdb> is not "svc_acct".
742 #note: implementation here, POD in FS::svc_acct
743 sub seconds_since_sqlradacct {
744 my($self, $start, $end) = @_;
746 my $mes = "$me seconds_since_sqlradacct:";
748 my $svc_x = $self->svc_x;
750 my @part_export = $self->part_svc->part_export_usage;
751 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
752 " service definition"
757 foreach my $part_export ( @part_export ) {
759 next if $part_export->option('ignore_accounting');
761 warn "$mes connecting to sqlradius database\n"
764 my $dbh = DBI->connect( map { $part_export->option($_) }
765 qw(datasrc username password) )
766 or die "can't connect to sqlradius database: ". $DBI::errstr;
768 warn "$mes connected to sqlradius database\n"
771 #select a unix time conversion function based on database type
772 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
773 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
775 my $username = $part_export->export_username($svc_x);
779 warn "$mes finding closed sessions completely within the given range\n"
784 if ($part_export->option('process_single_realm')) {
785 $realm = 'AND Realm = ?';
786 $realmparam = $part_export->option('realm');
789 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
793 AND $str2time AcctStartTime $closing >= ?
794 AND $str2time AcctStopTime $closing < ?
795 AND $str2time AcctStopTime $closing > 0
796 AND AcctStopTime IS NOT NULL"
797 ) or die $dbh->errstr;
798 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
800 my $regular = $sth->fetchrow_arrayref->[0];
802 warn "$mes finding open sessions which start in the range\n"
805 # count session start->range end
806 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
810 AND $str2time AcctStartTime $closing >= ?
811 AND $str2time AcctStartTime $closing < ?
812 AND ( ? - $str2time AcctStartTime $closing ) < 86400
813 AND ( $str2time AcctStopTime $closing = 0
814 OR AcctStopTime IS NULL )";
815 $sth = $dbh->prepare($query) or die $dbh->errstr;
818 ($realm ? $realmparam : ()),
822 or die $sth->errstr. " executing query $query";
823 my $start_during = $sth->fetchrow_arrayref->[0];
825 warn "$mes finding closed sessions which start before the range but stop during\n"
828 #count range start->session end
829 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
833 AND $str2time AcctStartTime $closing < ?
834 AND $str2time AcctStopTime $closing >= ?
835 AND $str2time AcctStopTime $closing < ?
836 AND $str2time AcctStopTime $closing > 0
837 AND AcctStopTime IS NOT NULL"
838 ) or die $dbh->errstr;
839 $sth->execute( $start,
841 ($realm ? $realmparam : ()),
846 my $end_during = $sth->fetchrow_arrayref->[0];
848 warn "$mes finding closed sessions which start before the range but stop after\n"
851 # count range start->range end
852 # don't count open sessions anymore (probably missing stop record)
853 $sth = $dbh->prepare("SELECT COUNT(*)
857 AND $str2time AcctStartTime $closing < ?
858 AND ( $str2time AcctStopTime $closing >= ?
860 # OR AcctStopTime = 0
861 # OR AcctStopTime IS NULL )"
862 ) or die $dbh->errstr;
863 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
865 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
867 $seconds += $regular + $end_during + $start_during + $entire_range;
869 warn "$mes done finding sessions\n"
878 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
880 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
881 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
882 for records where B<svcdb> is not "svc_acct".
886 #note: implementation here, POD in FS::svc_acct
887 #(false laziness w/seconds_since_sqlradacct above)
888 sub attribute_since_sqlradacct {
889 my($self, $start, $end, $attrib) = @_;
891 my $mes = "$me attribute_since_sqlradacct:";
893 my $svc_x = $self->svc_x;
895 my @part_export = $self->part_svc->part_export_usage;
896 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
897 " service definition"
903 foreach my $part_export ( @part_export ) {
905 next if $part_export->option('ignore_accounting');
907 warn "$mes connecting to sqlradius database\n"
910 my $dbh = DBI->connect( map { $part_export->option($_) }
911 qw(datasrc username password) )
912 or die "can't connect to sqlradius database: ". $DBI::errstr;
914 warn "$mes connected to sqlradius database\n"
917 #select a unix time conversion function based on database type
918 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
919 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
921 my $username = $part_export->export_username($svc_x);
923 warn "$mes SUMing $attrib sessions\n"
928 if ($part_export->option('process_single_realm')) {
929 $realm = 'AND Realm = ?';
930 $realmparam = $part_export->option('realm');
933 my $sth = $dbh->prepare("SELECT SUM($attrib)
937 AND $str2time AcctStopTime $closing >= ?
938 AND $str2time AcctStopTime $closing < ?
939 AND AcctStopTime IS NOT NULL"
940 ) or die $dbh->errstr;
941 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
944 my $row = $sth->fetchrow_arrayref;
945 $sum += $row->[0] if defined($row->[0]);
947 warn "$mes done SUMing sessions\n"
956 #note: implementation here, POD in FS::svc_acct
957 # false laziness w/above
958 sub attribute_last_sqlradacct {
959 my($self, $attrib) = @_;
961 my $mes = "$me attribute_last_sqlradacct:";
963 my $svc_x = $self->svc_x;
965 my @part_export = $self->part_svc->part_export_usage;
966 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
967 " service definition"
972 my $AcctStartTime = 0;
974 foreach my $part_export ( @part_export ) {
976 next if $part_export->option('ignore_accounting');
978 warn "$mes connecting to sqlradius database\n"
981 my $dbh = DBI->connect( map { $part_export->option($_) }
982 qw(datasrc username password) )
983 or die "can't connect to sqlradius database: ". $DBI::errstr;
985 warn "$mes connected to sqlradius database\n"
988 #select a unix time conversion function based on database type
989 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
990 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
992 my $username = $part_export->export_username($svc_x);
994 warn "$mes finding most-recent $attrib\n"
999 if ($part_export->option('process_single_realm')) {
1000 $realm = 'AND Realm = ?';
1001 $realmparam = $part_export->option('realm');
1004 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1008 ORDER BY AcctStartTime DESC LIMIT 1
1009 ") or die $dbh->errstr;
1010 $sth->execute($username, ($realm ? $realmparam : ()) )
1011 or die $sth->errstr;
1013 my $row = $sth->fetchrow_arrayref;
1014 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1016 $AcctStartTime = $row->[1];
1028 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1030 See L<FS::svc_acct/get_session_history>. Equivalent to
1031 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1032 records where B<svcdb> is not "svc_acct".
1036 sub get_session_history {
1037 my($self, $start, $end, $attrib) = @_;
1041 my @part_export = $self->part_svc->part_export_usage;
1042 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1043 " service definition"
1044 unless @part_export;
1049 foreach my $part_export ( @part_export ) {
1051 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1058 =item tickets [ STATUS ]
1060 Returns an array of hashes representing the tickets linked to this service.
1062 An optional status (or arrayref or hashref of statuses) may be specified.
1068 my $status = ( @_ && $_[0] ) ? shift : '';
1070 my $conf = FS::Conf->new;
1071 my $num = $conf->config('cust_main-max_tickets') || 10;
1074 if ( $conf->config('ticket_system') ) {
1075 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1077 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1086 foreach my $priority (
1087 $conf->config('ticket_system-custom_priority_field-values'), ''
1089 last if scalar(@tickets) >= $num;
1091 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1092 $num - scalar(@tickets),
1105 my $svc_x = $self->svc_x;
1106 +{ ( map { $_=>$self->$_ } $self->fields ),
1107 ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ),
1117 =item smart_search OPTION => VALUE ...
1119 Accepts the option I<search>, the string to search for. The string will
1120 be searched for as a username, email address, IP address, MAC address,
1121 phone number, and hardware serial number. Unlike the I<smart_search> on
1122 customers, this always requires an exact match.
1126 # though perhaps it should be fuzzy in some cases?
1129 my %param = __PACKAGE__->smart_search_param(@_);
1133 sub smart_search_param {
1137 my $string = $opt{'search'};
1138 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1141 map { my $table = $_;
1142 my $search_sql = "FS::$table"->search_sql($string);
1144 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1145 "FROM $table WHERE $search_sql";
1147 FS::part_svc->svc_tables;
1149 if ( $string =~ /^(\d+)$/ ) {
1150 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1153 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1154 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1158 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1159 'null_right' => 'View/link unlinked services'
1161 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1163 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1164 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1165 ' LEFT JOIN part_svc USING ( svcpart )';
1168 'table' => 'cust_svc',
1169 'select' => 'svc_all.svcnum AS svcnum, '.
1170 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1172 'addl_from' => $addl_from,
1174 'extra_sql' => $extra_sql,
1181 # fix missing (deleted by mistake) svc_x records
1182 warn "searching for missing svc_x records...\n";
1184 'table' => 'cust_svc',
1185 'select' => 'cust_svc.*',
1186 'addl_from' => ' LEFT JOIN ( ' .
1188 map { "SELECT svcnum FROM $_" }
1189 FS::part_svc->svc_tables
1190 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1191 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1193 my @svcs = qsearch(\%search);
1194 warn "found ".scalar(@svcs)."\n";
1196 local $FS::Record::nowarn_classload = 1; # for h_svc_
1197 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1200 'hashref' => { history_action => 'delete' },
1201 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1203 foreach my $cust_svc (@svcs) {
1204 my $svcnum = $cust_svc->svcnum;
1205 my $svcdb = $cust_svc->part_svc->svcdb;
1206 $h_search{'hashref'}{'svcnum'} = $svcnum;
1207 $h_search{'table'} = "h_$svcdb";
1208 my $h_svc_x = qsearchs(\%h_search)
1210 my $class = "FS::$svcdb";
1211 my $new_svc_x = $class->new({ $h_svc_x->hash });
1212 my $error = $new_svc_x->insert;
1213 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1224 Behaviour of changing the svcpart of cust_svc records is undefined and should
1225 possibly be prohibited, and pkg_svc records are not checked.
1227 pkg_svc records are not checked in general (here).
1229 Deleting this record doesn't check or delete the svc_* record associated
1232 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1233 a DBI database handle is not yet implemented.
1237 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1238 schema.html from the base documentation