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.
110 local $SIG{HUP} = 'IGNORE';
111 local $SIG{INT} = 'IGNORE';
112 local $SIG{QUIT} = 'IGNORE';
113 local $SIG{TERM} = 'IGNORE';
114 local $SIG{TSTP} = 'IGNORE';
115 local $SIG{PIPE} = 'IGNORE';
117 my $oldAutoCommit = $FS::UID::AutoCommit;
118 local $FS::UID::AutoCommit = 0;
121 my $error = $self->SUPER::insert;
123 #check if this releases a hold (see FS::pkg_svc provision_hold)
124 $error ||= $self->_check_provision_hold;
127 $dbh->rollback if $oldAutoCommit;
128 return $error if $error
131 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
138 Deletes this service from the database. If there is an error, returns the
139 error, otherwise returns false. Note that this only removes the cust_svc
140 record - you should probably use the B<cancel> method instead.
149 my $cust_pkg = $self->cust_pkg;
150 my $custnum = $cust_pkg->custnum if $cust_pkg;
152 local $SIG{HUP} = 'IGNORE';
153 local $SIG{INT} = 'IGNORE';
154 local $SIG{QUIT} = 'IGNORE';
155 local $SIG{TERM} = 'IGNORE';
156 local $SIG{TSTP} = 'IGNORE';
157 local $SIG{PIPE} = 'IGNORE';
159 my $oldAutoCommit = $FS::UID::AutoCommit;
160 local $FS::UID::AutoCommit = 0;
163 my $error = $self->SUPER::delete;
165 $dbh->rollback if $oldAutoCommit;
169 foreach my $part_svc_link ( $self->part_svc_link(
170 link_type => 'cust_svc_unprovision_cascade',
173 foreach my $cust_svc ( qsearch( 'cust_svc', {
174 'pkgnum' => $self->pkgnum,
175 'svcpart' => $part_svc_link->dst_svcpart,
178 my $error = $cust_svc->svc_x->delete;
180 $dbh->rollback if $oldAutoCommit;
187 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
189 if ( $ticket_system eq 'RT_Internal' ) {
190 unless ( $rt_session ) {
191 FS::TicketSystem->init;
192 $rt_session = FS::TicketSystem->session;
194 my $links = RT::Links->new($rt_session->{CurrentUser});
195 my $svcnum = $self->svcnum;
196 $links->Limit(FIELD => 'Target',
197 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
198 while ( my $l = $links->Next ) {
201 # re-link to point to the customer instead
203 $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
206 ($val, $msg) = $l->Delete;
208 # can't do anything useful on error
209 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
219 Suspends the relevant service by calling the B<suspend> method of the associated
220 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object).
222 If there is an error, returns the error, otherwise returns false.
227 my( $self, %opt ) = @_;
229 $self->part_svc->svcdb =~ /^([\w\-]+)$/ or return 'Illegal part_svc.svcdb';
231 require "FS/$svcdb.pm";
233 my $svc = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } )
236 my $error = $svc->suspend;
237 return $error if $error;
239 if ( $opt{labels_arryref} ) {
240 my( $label, $value ) = $self->label;
241 push @{ $opt{labels_arrayref} }, "$label: $value";
250 Cancels the relevant service by calling the B<cancel> method of the associated
251 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
252 deleting the FS::svc_XXX record and then deleting this record.
254 If there is an error, returns the error, otherwise returns false.
261 local $SIG{HUP} = 'IGNORE';
262 local $SIG{INT} = 'IGNORE';
263 local $SIG{QUIT} = 'IGNORE';
264 local $SIG{TERM} = 'IGNORE';
265 local $SIG{TSTP} = 'IGNORE';
266 local $SIG{PIPE} = 'IGNORE';
268 my $oldAutoCommit = $FS::UID::AutoCommit;
269 local $FS::UID::AutoCommit = 0;
272 my $part_svc = $self->part_svc;
274 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
275 $dbh->rollback if $oldAutoCommit;
276 return "Illegal svcdb value in part_svc!";
279 require "FS/$svcdb.pm";
281 my $svc = $self->svc_x;
283 if ( %opt && $opt{'date'} ) {
284 my $error = $svc->expire($opt{'date'});
286 $dbh->rollback if $oldAutoCommit;
287 return "Error expiring service: $error";
290 my $error = $svc->cancel;
292 $dbh->rollback if $oldAutoCommit;
293 return "Error canceling service: $error";
295 $error = $svc->delete; #this deletes this cust_svc record as well
297 $dbh->rollback if $oldAutoCommit;
298 return "Error deleting service: $error";
305 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
306 "; deleting cust_svc only\n";
308 my $error = $self->delete;
310 $dbh->rollback if $oldAutoCommit;
311 return "Error deleting cust_svc: $error";
316 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
322 =item overlimit [ ACTION ]
324 Retrieves or sets the overlimit date. If ACTION is absent, return
325 the present value of overlimit. If ACTION is present, it can
326 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
327 is set to the current time if it is not already set. The 'unsuspend' value
328 causes the time to be cleared.
330 If there is an error on setting, returns the error, otherwise returns false.
336 my $action = shift or return $self->getfield('overlimit');
338 local $SIG{HUP} = 'IGNORE';
339 local $SIG{INT} = 'IGNORE';
340 local $SIG{QUIT} = 'IGNORE';
341 local $SIG{TERM} = 'IGNORE';
342 local $SIG{TSTP} = 'IGNORE';
343 local $SIG{PIPE} = 'IGNORE';
345 my $oldAutoCommit = $FS::UID::AutoCommit;
346 local $FS::UID::AutoCommit = 0;
349 if ( $action eq 'suspend' ) {
350 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
351 }elsif ( $action eq 'unsuspend' ) {
352 $self->setfield('overlimit', '');
354 die "unexpected action value: $action";
357 local $ignore_quantity = 1;
358 my $error = $self->replace;
360 $dbh->rollback if $oldAutoCommit;
361 return "Error setting overlimit: $error";
364 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
370 =item replace OLD_RECORD
372 Replaces the OLD_RECORD with this one in the database. If there is an error,
373 returns the error, otherwise returns false.
380 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
382 # : $new->replace_old;
383 my ( $new, $old ) = ( shift, shift );
384 $old = $new->replace_old unless defined($old);
386 local $SIG{HUP} = 'IGNORE';
387 local $SIG{INT} = 'IGNORE';
388 local $SIG{QUIT} = 'IGNORE';
389 local $SIG{TERM} = 'IGNORE';
390 local $SIG{TSTP} = 'IGNORE';
391 local $SIG{PIPE} = 'IGNORE';
393 my $oldAutoCommit = $FS::UID::AutoCommit;
394 local $FS::UID::AutoCommit = 0;
397 if ( $new->svcpart != $old->svcpart ) {
398 my $svc_x = $new->svc_x;
399 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
400 local($FS::Record::nowarn_identical) = 1;
401 my $error = $new_svc_x->replace($svc_x);
403 $dbh->rollback if $oldAutoCommit;
404 return $error if $error;
408 # #trigger a re-export on pkgnum changes?
409 # # (of prepaid packages), for Expiration RADIUS attribute
410 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
411 # my $svc_x = $new->svc_x;
412 # local($FS::Record::nowarn_identical) = 1;
413 # my $error = $svc_x->export('replace');
415 # $dbh->rollback if $oldAutoCommit;
416 # return $error if $error;
420 #trigger a pkg_change export on pkgnum changes
421 if ( $new->pkgnum != $old->pkgnum ) {
422 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
427 $dbh->rollback if $oldAutoCommit;
428 return $error if $error;
430 } # if pkgnum is changing
432 #my $error = $new->SUPER::replace($old, @_);
433 my $error = $new->SUPER::replace($old);
435 #trigger a relocate export on location changes
436 if ( $new->cust_pkg->locationnum != $old->cust_pkg->locationnum ) {
437 my $svc_x = $new->svc_x;
438 if ( $svc_x->locationnum ) {
439 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
440 # in this case, set the service location to be the same as the new
442 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
443 # and replace it, which triggers a relocate export so we don't
445 $error ||= $svc_x->replace;
447 # the service already has a different location from its package
451 # the service doesn't have a locationnum (either isn't of a type
452 # that has the locationnum field, or the locationnum is null and
453 # defaults to cust_pkg->locationnum)
454 # so just trigger the export here
455 $error ||= $new->svc_x->export('relocate',
456 $new->cust_pkg->cust_location,
457 $old->cust_pkg->cust_location,
459 } # if ($svc_x->locationnum)
460 } # if this is a location change
462 #check if this releases a hold (see FS::pkg_svc provision_hold)
463 $error ||= $new->_check_provision_hold;
466 $dbh->rollback if $oldAutoCommit;
467 return $error if $error
470 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
477 Checks all fields to make sure this is a valid service. If there is an error,
478 returns the error, otherwise returns false. Called by the insert and
487 $self->ut_numbern('svcnum')
488 || $self->ut_numbern('pkgnum')
489 || $self->ut_number('svcpart')
490 || $self->ut_numbern('agent_svcid')
491 || $self->ut_numbern('overlimit')
493 return $error if $error;
495 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
496 return "Unknown svcpart" unless $part_svc;
498 if ( $self->pkgnum && ! $ignore_quantity ) {
500 #slightly inefficient since ->pkg_svc will also look it up, but fixing
501 # a much larger perf problem and have bigger fish to fry
502 my $cust_pkg = $self->cust_pkg;
504 my $pkg_svc = $self->pkg_svc
505 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
506 'pkgpart' => $cust_pkg->pkgpart,
510 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
511 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
512 my $addon_pkg_svc = qsearchs('pkg_svc', {
513 pkgpart => $part_pkg_link->dst_pkgpart,
514 svcpart => $self->svcpart,
516 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
520 #better error message? UI shouldn't get here
521 return "No svcpart ". $self->svcpart.
522 " services in pkgpart ". $cust_pkg->pkgpart
523 unless $pkg_svc->quantity > 0;
525 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
527 #false laziness w/cust_pkg->part_svc
528 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
532 #better error message? again, UI shouldn't get here
533 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
534 " services for pkgnum ". $self->pkgnum
537 #part_svc_link rules (only make sense in pkgpart context, and
538 # skipping this when ignore_quantity is set DTRT when we're "forcing"
539 # an implicit change here (location change triggered pkgpart change,
540 # ->overlimit, bulk customer service changes)
541 foreach my $part_svc_link ( $self->part_svc_link(
542 link_type => 'cust_svc_provision_restrict',
545 return $part_svc_link->dst_svc. ' must be provisioned before '.
546 $part_svc_link->src_svc
548 'table' => 'cust_svc',
549 'hashref' => { 'pkgnum' => $self->pkgnum,
550 'svcpart' => $part_svc_link->dst_svcpart,
552 'order_by' => 'LIMIT 1',
561 =item check_part_svc_link_unprovision
563 Checks service dependency unprovision rules for this service.
565 If there is an error, returns the error, otherwise returns false.
569 sub check_part_svc_link_unprovision {
572 foreach my $part_svc_link ( $self->part_svc_link(
573 link_type => 'cust_svc_unprovision_restrict',
576 return $part_svc_link->dst_svc. ' must be unprovisioned before '.
577 $part_svc_link->src_svc
579 'table' => 'cust_svc',
580 'hashref' => { 'pkgnum' => $self->pkgnum,
581 'svcpart' => $part_svc_link->dst_svcpart,
583 'order_by' => 'LIMIT 1',
592 Returns the service dependencies (see L<FS::part_svc_link>) for the given
593 search options, taking into account this service definition as source and
594 this customer's agent.
596 Available options are any field in part_svc_link. Typically used options are
603 my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
604 FS::part_svc_link->by_agentnum($agentnum,
605 src_svcpart=>$self->svcpart,
613 Returns the displayed service number for this service: agent_svcid if it has a
614 value, svcnum otherwise
620 $self->agent_svcid || $self->svcnum;
625 Returns the definition for this service, as a FS::part_svc object (see
633 ? $self->{'_svcpart'}
634 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
639 Returns the package this service belongs to, as a FS::cust_pkg object (see
644 Returns the pkg_svc record for for this service, if applicable.
650 my $cust_pkg = $self->cust_pkg;
651 return undef unless $cust_pkg;
653 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
654 'pkgpart' => $cust_pkg->pkgpart,
661 Returns the date this service was inserted.
667 $self->h_date('insert');
670 =item pkg_cancel_date
672 Returns the date this service's package was canceled. This normally only
673 exists for a service that's been preserved through cancellation with the
674 part_pkg.preserve flag.
678 sub pkg_cancel_date {
680 my $cust_pkg = $self->cust_pkg or return;
681 return $cust_pkg->getfield('cancel') || '';
686 Returns a list consisting of:
687 - The name of this service (from part_svc)
688 - A meaningful identifier (username, domain, or mail alias)
689 - The table name (i.e. svc_domain) for this service
694 my($label, $value, $svcdb) = $cust_svc->label;
698 Like the B<label> method, except the second item in the list ("meaningful
699 identifier") may be longer - typically, a full name is included.
703 sub label { shift->_label('svc_label', @_); }
704 sub label_long { shift->_label('svc_label_long', @_); }
709 my $svc_x = $self->svc_x
710 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
712 $self->$method($svc_x);
715 sub svc_label { shift->_svc_label('label', @_); }
716 sub svc_label_long { shift->_svc_label('label_long', @_); }
719 my( $self, $method, $svc_x ) = ( shift, shift, shift );
722 $self->part_svc->svc,
724 $self->part_svc->svcdb,
732 Returns a listref of html elements associated with this service's exports.
738 my $svc_x = $self->svc_x
739 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
741 $svc_x->export_links;
744 =item export_getsettings
746 Returns two hashrefs of settings associated with this service's exports.
750 sub export_getsettings {
752 my $svc_x = $self->svc_x
753 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
755 $svc_x->export_getsettings;
761 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
762 FS::svc_domain object, etc.)
768 my $svcdb = $self->part_svc->svcdb;
769 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
770 $self->{'_svc_acct'};
772 require "FS/$svcdb.pm";
773 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
774 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
776 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
780 =item seconds_since TIMESTAMP
782 See L<FS::svc_acct/seconds_since>. Equivalent to
783 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
784 where B<svcdb> is not "svc_acct".
788 #internal session db deprecated (or at least on hold)
789 sub seconds_since { 'internal session db deprecated'; };
790 ##note: implementation here, POD in FS::svc_acct
792 # my($self, $since) = @_;
794 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
797 # AND logout IS NOT NULL'
798 # ) or die $dbh->errstr;
799 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
800 # $sth->fetchrow_arrayref->[0];
803 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
805 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
806 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
807 for records where B<svcdb> is not "svc_acct".
811 #note: implementation here, POD in FS::svc_acct
812 sub seconds_since_sqlradacct {
813 my($self, $start, $end) = @_;
815 my $mes = "$me seconds_since_sqlradacct:";
817 my $svc_x = $self->svc_x;
819 my @part_export = $self->part_svc->part_export_usage;
820 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
821 " service definition"
826 foreach my $part_export ( @part_export ) {
828 next if $part_export->option('ignore_accounting');
830 warn "$mes connecting to sqlradius database\n"
833 my $dbh = DBI->connect( map { $part_export->option($_) }
834 qw(datasrc username password) )
835 or die "can't connect to sqlradius database: ". $DBI::errstr;
837 warn "$mes connected to sqlradius database\n"
840 #select a unix time conversion function based on database type
841 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
842 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
844 my $username = $part_export->export_username($svc_x);
848 warn "$mes finding closed sessions completely within the given range\n"
853 if ($part_export->option('process_single_realm')) {
854 $realm = 'AND Realm = ?';
855 $realmparam = $part_export->option('realm');
858 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
862 AND $str2time AcctStartTime $closing >= ?
863 AND $str2time AcctStopTime $closing < ?
864 AND $str2time AcctStopTime $closing > 0
865 AND AcctStopTime IS NOT NULL"
866 ) or die $dbh->errstr;
867 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
869 my $regular = $sth->fetchrow_arrayref->[0];
871 warn "$mes finding open sessions which start in the range\n"
874 # count session start->range end
875 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
879 AND $str2time AcctStartTime $closing >= ?
880 AND $str2time AcctStartTime $closing < ?
881 AND ( ? - $str2time AcctStartTime $closing ) < 86400
882 AND ( $str2time AcctStopTime $closing = 0
883 OR AcctStopTime IS NULL )";
884 $sth = $dbh->prepare($query) or die $dbh->errstr;
887 ($realm ? $realmparam : ()),
891 or die $sth->errstr. " executing query $query";
892 my $start_during = $sth->fetchrow_arrayref->[0];
894 warn "$mes finding closed sessions which start before the range but stop during\n"
897 #count range start->session end
898 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
902 AND $str2time AcctStartTime $closing < ?
903 AND $str2time AcctStopTime $closing >= ?
904 AND $str2time AcctStopTime $closing < ?
905 AND $str2time AcctStopTime $closing > 0
906 AND AcctStopTime IS NOT NULL"
907 ) or die $dbh->errstr;
908 $sth->execute( $start,
910 ($realm ? $realmparam : ()),
915 my $end_during = $sth->fetchrow_arrayref->[0];
917 warn "$mes finding closed sessions which start before the range but stop after\n"
920 # count range start->range end
921 # don't count open sessions anymore (probably missing stop record)
922 $sth = $dbh->prepare("SELECT COUNT(*)
926 AND $str2time AcctStartTime $closing < ?
927 AND ( $str2time AcctStopTime $closing >= ?
929 # OR AcctStopTime = 0
930 # OR AcctStopTime IS NULL )"
931 ) or die $dbh->errstr;
932 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
934 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
936 $seconds += $regular + $end_during + $start_during + $entire_range;
938 warn "$mes done finding sessions\n"
947 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
949 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
950 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
951 for records where B<svcdb> is not "svc_acct".
955 #note: implementation here, POD in FS::svc_acct
956 #(false laziness w/seconds_since_sqlradacct above)
957 sub attribute_since_sqlradacct {
958 my($self, $start, $end, $attrib) = @_;
960 my $mes = "$me attribute_since_sqlradacct:";
962 my $svc_x = $self->svc_x;
964 my @part_export = $self->part_svc->part_export_usage;
965 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
966 " service definition"
972 foreach my $part_export ( @part_export ) {
974 next if $part_export->option('ignore_accounting');
976 warn "$mes connecting to sqlradius database\n"
979 my $dbh = DBI->connect( map { $part_export->option($_) }
980 qw(datasrc username password) )
981 or die "can't connect to sqlradius database: ". $DBI::errstr;
983 warn "$mes connected to sqlradius database\n"
986 #select a unix time conversion function based on database type
987 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
988 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
990 my $username = $part_export->export_username($svc_x);
992 warn "$mes SUMing $attrib sessions\n"
997 if ($part_export->option('process_single_realm')) {
998 $realm = 'AND Realm = ?';
999 $realmparam = $part_export->option('realm');
1002 my $sth = $dbh->prepare("SELECT SUM($attrib)
1006 AND $str2time AcctStopTime $closing >= ?
1007 AND $str2time AcctStopTime $closing < ?
1008 AND AcctStopTime IS NOT NULL"
1009 ) or die $dbh->errstr;
1010 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
1011 or die $sth->errstr;
1013 my $row = $sth->fetchrow_arrayref;
1014 $sum += $row->[0] if defined($row->[0]);
1016 warn "$mes done SUMing sessions\n"
1025 #note: implementation here, POD in FS::svc_acct
1026 # false laziness w/above
1027 sub attribute_last_sqlradacct {
1028 my($self, $attrib) = @_;
1030 my $mes = "$me attribute_last_sqlradacct:";
1032 my $svc_x = $self->svc_x;
1034 my @part_export = $self->part_svc->part_export_usage;
1035 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1036 " service definition"
1037 unless @part_export;
1041 my $AcctStartTime = 0;
1043 foreach my $part_export ( @part_export ) {
1045 next if $part_export->option('ignore_accounting');
1047 warn "$mes connecting to sqlradius database\n"
1050 my $dbh = DBI->connect( map { $part_export->option($_) }
1051 qw(datasrc username password) )
1052 or die "can't connect to sqlradius database: ". $DBI::errstr;
1054 warn "$mes connected to sqlradius database\n"
1057 #select a unix time conversion function based on database type
1058 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1059 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1061 my $username = $part_export->export_username($svc_x);
1063 warn "$mes finding most-recent $attrib\n"
1067 my $realmparam = '';
1068 if ($part_export->option('process_single_realm')) {
1069 $realm = 'AND Realm = ?';
1070 $realmparam = $part_export->option('realm');
1073 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1077 ORDER BY AcctStartTime DESC LIMIT 1
1078 ") or die $dbh->errstr;
1079 $sth->execute($username, ($realm ? $realmparam : ()) )
1080 or die $sth->errstr;
1082 my $row = $sth->fetchrow_arrayref;
1083 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1085 $AcctStartTime = $row->[1];
1097 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1099 See L<FS::svc_acct/get_session_history>. Equivalent to
1100 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1101 records where B<svcdb> is not "svc_acct".
1105 sub get_session_history {
1106 my($self, $start, $end, $attrib) = @_;
1110 my @part_export = $self->part_svc->part_export_usage;
1111 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1112 " service definition"
1113 unless @part_export;
1118 foreach my $part_export ( @part_export ) {
1120 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1127 =item tickets [ STATUS ]
1129 Returns an array of hashes representing the tickets linked to this service.
1131 An optional status (or arrayref or hashref of statuses) may be specified.
1137 my $status = ( @_ && $_[0] ) ? shift : '';
1139 my $conf = FS::Conf->new;
1140 my $num = $conf->config('cust_main-max_tickets') || 10;
1143 if ( $conf->config('ticket_system') ) {
1144 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1146 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1155 foreach my $priority (
1156 $conf->config('ticket_system-custom_priority_field-values'), ''
1158 last if scalar(@tickets) >= $num;
1160 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1161 $num - scalar(@tickets),
1174 my $svc_x = $self->svc_x;
1175 +{ ( map { $_=>$self->$_ } $self->fields ),
1176 ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ),
1186 =item smart_search OPTION => VALUE ...
1188 Accepts the option I<search>, the string to search for. The string will
1189 be searched for as a username, email address, IP address, MAC address,
1190 phone number, and hardware serial number. Unlike the I<smart_search> on
1191 customers, this always requires an exact match.
1195 # though perhaps it should be fuzzy in some cases?
1198 my %param = __PACKAGE__->smart_search_param(@_);
1202 sub smart_search_param {
1206 my $string = $opt{'search'};
1207 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1210 map { my $table = $_;
1211 my $search_sql = "FS::$table"->search_sql($string);
1212 my $addl_from = "FS::$table"->search_sql_addl_from();
1214 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1215 "FROM $table $addl_from WHERE $search_sql";
1217 FS::part_svc->svc_tables;
1219 if ( $string =~ /^(\d+)$/ ) {
1220 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1223 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1224 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1228 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1229 'null_right' => 'View/link unlinked services'
1231 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1233 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1234 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1235 ' LEFT JOIN part_svc USING ( svcpart )';
1238 'table' => 'cust_svc',
1239 'select' => 'svc_all.svcnum AS svcnum, '.
1240 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1242 'addl_from' => $addl_from,
1244 'extra_sql' => $extra_sql,
1248 # If the associated cust_pkg is 'on hold'
1249 # and the associated pkg_svc has the provision_hold flag
1250 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1251 # then removes hold from pkg
1252 # returns $error or '' on success,
1253 # does not indicate if pkg status was changed
1254 sub _check_provision_hold {
1257 # check status of cust_pkg
1258 my $cust_pkg = $self->cust_pkg;
1259 return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1261 # check flag on this svc
1262 # small false laziness with $self->pkg_svc
1263 # to avoid looking up cust_pkg twice
1264 my $pkg_svc = qsearchs( 'pkg_svc', {
1265 'svcpart' => $self->svcpart,
1266 'pkgpart' => $cust_pkg->pkgpart,
1268 return '' unless $pkg_svc->provision_hold;
1270 # check for any others available with that flag
1271 return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1273 # conditions met, remove hold
1274 return $cust_pkg->unsuspend;
1280 # fix missing (deleted by mistake) svc_x records
1281 warn "searching for missing svc_x records...\n";
1283 'table' => 'cust_svc',
1284 'select' => 'cust_svc.*',
1285 'addl_from' => ' LEFT JOIN ( ' .
1287 map { "SELECT svcnum FROM $_" }
1288 FS::part_svc->svc_tables
1289 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1290 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1292 my @svcs = qsearch(\%search);
1293 warn "found ".scalar(@svcs)."\n";
1295 local $FS::Record::nowarn_classload = 1; # for h_svc_
1296 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1299 'hashref' => { history_action => 'delete' },
1300 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1302 foreach my $cust_svc (@svcs) {
1303 my $svcnum = $cust_svc->svcnum;
1304 my $svcdb = $cust_svc->part_svc->svcdb;
1305 $h_search{'hashref'}{'svcnum'} = $svcnum;
1306 $h_search{'table'} = "h_$svcdb";
1307 my $h_svc_x = qsearchs(\%h_search);
1309 my $class = "FS::$svcdb";
1310 my $new_svc_x = $class->new({ $h_svc_x->hash });
1311 my $error = $new_svc_x->insert;
1312 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1315 # can't be fixed, so remove the dangling cust_svc to avoid breaking
1317 my $error = $cust_svc->delete;
1318 warn "error cleaning up missing svcnum $svcnum ($svcdb):\n$error\n";
1329 Behaviour of changing the svcpart of cust_svc records is undefined and should
1330 possibly be prohibited, and pkg_svc records are not checked.
1332 pkg_svc records are not checked in general (here).
1334 Deleting this record doesn't check or delete the svc_* record associated
1337 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1338 a DBI database handle is not yet implemented.
1342 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1343 schema.html from the base documentation