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')
35 our $cache_enabled = 0;
38 my( $self, $hashref ) = @_;
39 if ( $cache_enabled && $hashref->{'svc'} ) {
40 $self->{'_svcpart'} = FS::part_svc->new($hashref);
46 my ( $hashref, $cache ) = @_;
47 if ( $hashref->{'username'} ) {
48 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
50 if ( $hashref->{'svc'} ) {
51 $self->{'_svcpart'} = FS::part_svc->new($hashref);
57 FS::cust_svc - Object method for cust_svc objects
63 $record = new FS::cust_svc \%hash
64 $record = new FS::cust_svc { 'column' => 'value' };
66 $error = $record->insert;
68 $error = $new_record->replace($old_record);
70 $error = $record->delete;
72 $error = $record->check;
74 ($label, $value) = $record->label;
78 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
79 The following fields are currently supported:
83 =item svcnum - primary key (assigned automatically for new services)
85 =item pkgnum - Package (see L<FS::cust_pkg>)
87 =item svcpart - Service definition (see L<FS::part_svc>)
89 =item agent_svcid - Optional legacy service ID
91 =item overlimit - date the service exceeded its usage limit
101 Creates a new service. To add the refund to the database, see L<"insert">.
102 Services are normally created by creating FS::svc_ objects (see
103 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
107 sub table { 'cust_svc'; }
111 Adds this service to the database. If there is an error, returns the error,
112 otherwise returns false.
119 local $SIG{HUP} = 'IGNORE';
120 local $SIG{INT} = 'IGNORE';
121 local $SIG{QUIT} = 'IGNORE';
122 local $SIG{TERM} = 'IGNORE';
123 local $SIG{TSTP} = 'IGNORE';
124 local $SIG{PIPE} = 'IGNORE';
126 my $oldAutoCommit = $FS::UID::AutoCommit;
127 local $FS::UID::AutoCommit = 0;
130 my $error = $self->SUPER::insert;
132 #check if this releases a hold (see FS::pkg_svc provision_hold)
133 $error ||= $self->_check_provision_hold;
136 $dbh->rollback if $oldAutoCommit;
137 return $error if $error
140 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
147 Deletes this service from the database. If there is an error, returns the
148 error, otherwise returns false. Note that this only removes the cust_svc
149 record - you should probably use the B<cancel> method instead.
158 my $cust_pkg = $self->cust_pkg;
159 my $custnum = $cust_pkg->custnum if $cust_pkg;
161 local $SIG{HUP} = 'IGNORE';
162 local $SIG{INT} = 'IGNORE';
163 local $SIG{QUIT} = 'IGNORE';
164 local $SIG{TERM} = 'IGNORE';
165 local $SIG{TSTP} = 'IGNORE';
166 local $SIG{PIPE} = 'IGNORE';
168 my $oldAutoCommit = $FS::UID::AutoCommit;
169 local $FS::UID::AutoCommit = 0;
172 # delete associated export_cust_svc
173 foreach my $export_cust_svc (
174 qsearch('export_cust_svc',{ 'svcnum' => $self->svcnum })
176 my $error = $export_cust_svc->delete;
178 $dbh->rollback if $oldAutoCommit;
183 my $error = $self->SUPER::delete;
185 $dbh->rollback if $oldAutoCommit;
189 foreach my $part_svc_link ( $self->part_svc_link(
190 link_type => 'cust_svc_unprovision_cascade',
193 foreach my $cust_svc ( qsearch( 'cust_svc', {
194 'pkgnum' => $self->pkgnum,
195 'svcpart' => $part_svc_link->dst_svcpart,
198 my $error = $cust_svc->svc_x->delete;
200 $dbh->rollback if $oldAutoCommit;
207 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
209 if ( $ticket_system eq 'RT_Internal' ) {
210 unless ( $rt_session ) {
211 FS::TicketSystem->init;
212 $rt_session = FS::TicketSystem->session;
214 my $links = RT::Links->new($rt_session->{CurrentUser});
215 my $svcnum = $self->svcnum;
216 $links->Limit(FIELD => 'Target',
217 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
218 while ( my $l = $links->Next ) {
221 # re-link to point to the customer instead
223 $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
226 ($val, $msg) = $l->Delete;
228 # can't do anything useful on error
229 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
239 Suspends the relevant service by calling the B<suspend> method of the associated
240 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object).
242 If there is an error, returns the error, otherwise returns false.
247 my( $self, %opt ) = @_;
249 $self->part_svc->svcdb =~ /^([\w\-]+)$/ or return 'Illegal part_svc.svcdb';
251 require "FS/$svcdb.pm";
253 my $svc = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } )
256 my $error = $svc->suspend;
257 return $error if $error;
259 if ( $opt{labels_arryref} ) {
260 my( $label, $value ) = $self->label;
261 push @{ $opt{labels_arrayref} }, "$label: $value";
270 Cancels the relevant service by calling the B<cancel> method of the associated
271 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
272 deleting the FS::svc_XXX record and then deleting this record.
274 If there is an error, returns the error, otherwise returns false.
281 local $SIG{HUP} = 'IGNORE';
282 local $SIG{INT} = 'IGNORE';
283 local $SIG{QUIT} = 'IGNORE';
284 local $SIG{TERM} = 'IGNORE';
285 local $SIG{TSTP} = 'IGNORE';
286 local $SIG{PIPE} = 'IGNORE';
288 my $oldAutoCommit = $FS::UID::AutoCommit;
289 local $FS::UID::AutoCommit = 0;
292 my $part_svc = $self->part_svc;
294 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
295 $dbh->rollback if $oldAutoCommit;
296 return "Illegal svcdb value in part_svc!";
299 require "FS/$svcdb.pm";
301 my $svc = $self->svc_x;
303 if ( %opt && $opt{'date'} ) {
304 my $error = $svc->expire($opt{'date'});
306 $dbh->rollback if $oldAutoCommit;
307 return "Error expiring service: $error";
310 my $error = $svc->cancel;
312 $dbh->rollback if $oldAutoCommit;
313 return "Error canceling service: $error";
315 $error = $svc->delete; #this deletes this cust_svc record as well
317 $dbh->rollback if $oldAutoCommit;
318 return "Error deleting service: $error";
325 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
326 "; deleting cust_svc only\n";
328 my $error = $self->delete;
330 $dbh->rollback if $oldAutoCommit;
331 return "Error deleting cust_svc: $error";
336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
342 =item overlimit [ ACTION ]
344 Retrieves or sets the overlimit date. If ACTION is absent, return
345 the present value of overlimit. If ACTION is present, it can
346 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
347 is set to the current time if it is not already set. The 'unsuspend' value
348 causes the time to be cleared.
350 If there is an error on setting, returns the error, otherwise returns false.
356 my $action = shift or return $self->getfield('overlimit');
358 local $SIG{HUP} = 'IGNORE';
359 local $SIG{INT} = 'IGNORE';
360 local $SIG{QUIT} = 'IGNORE';
361 local $SIG{TERM} = 'IGNORE';
362 local $SIG{TSTP} = 'IGNORE';
363 local $SIG{PIPE} = 'IGNORE';
365 my $oldAutoCommit = $FS::UID::AutoCommit;
366 local $FS::UID::AutoCommit = 0;
369 if ( $action eq 'suspend' ) {
370 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
371 }elsif ( $action eq 'unsuspend' ) {
372 $self->setfield('overlimit', '');
374 die "unexpected action value: $action";
377 local $ignore_quantity = 1;
378 my $error = $self->replace;
380 $dbh->rollback if $oldAutoCommit;
381 return "Error setting overlimit: $error";
384 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
390 =item replace OLD_RECORD
392 Replaces the OLD_RECORD with this one in the database. If there is an error,
393 returns the error, otherwise returns false.
400 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
402 # : $new->replace_old;
403 my ( $new, $old ) = ( shift, shift );
404 $old = $new->replace_old unless defined($old);
406 local $SIG{HUP} = 'IGNORE';
407 local $SIG{INT} = 'IGNORE';
408 local $SIG{QUIT} = 'IGNORE';
409 local $SIG{TERM} = 'IGNORE';
410 local $SIG{TSTP} = 'IGNORE';
411 local $SIG{PIPE} = 'IGNORE';
413 my $oldAutoCommit = $FS::UID::AutoCommit;
414 local $FS::UID::AutoCommit = 0;
417 if ( $new->svcpart != $old->svcpart ) {
418 my $svc_x = $new->svc_x;
419 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
420 local($FS::Record::nowarn_identical) = 1;
421 my $error = $new_svc_x->replace($svc_x);
423 $dbh->rollback if $oldAutoCommit;
424 return $error if $error;
428 # #trigger a re-export on pkgnum changes?
429 # # (of prepaid packages), for Expiration RADIUS attribute
430 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
431 # my $svc_x = $new->svc_x;
432 # local($FS::Record::nowarn_identical) = 1;
433 # my $error = $svc_x->export('replace');
435 # $dbh->rollback if $oldAutoCommit;
436 # return $error if $error;
440 #trigger a pkg_change export on pkgnum changes
441 if ( $new->pkgnum != $old->pkgnum ) {
442 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
447 $dbh->rollback if $oldAutoCommit;
448 return $error if $error;
450 } # if pkgnum is changing
452 #my $error = $new->SUPER::replace($old, @_);
453 my $error = $new->SUPER::replace($old);
455 #trigger a relocate export on location changes
456 if ( $new->cust_pkg->locationnum != $old->cust_pkg->locationnum ) {
457 my $svc_x = $new->svc_x;
458 if ( $svc_x->locationnum ) {
459 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
460 # in this case, set the service location to be the same as the new
462 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
463 # and replace it, which triggers a relocate export so we don't
465 $error ||= $svc_x->replace;
467 # the service already has a different location from its package
471 # the service doesn't have a locationnum (either isn't of a type
472 # that has the locationnum field, or the locationnum is null and
473 # defaults to cust_pkg->locationnum)
474 # so just trigger the export here
475 $error ||= $new->svc_x->export('relocate',
476 $new->cust_pkg->cust_location,
477 $old->cust_pkg->cust_location,
479 } # if ($svc_x->locationnum)
480 } # if this is a location change
482 #check if this releases a hold (see FS::pkg_svc provision_hold)
483 $error ||= $new->_check_provision_hold;
486 $dbh->rollback if $oldAutoCommit;
487 return $error if $error
490 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
497 Checks all fields to make sure this is a valid service. If there is an error,
498 returns the error, otherwise returns false. Called by the insert and
507 $self->ut_numbern('svcnum')
508 || $self->ut_numbern('pkgnum')
509 || $self->ut_number('svcpart')
510 || $self->ut_numbern('agent_svcid')
511 || $self->ut_numbern('overlimit')
513 return $error if $error;
515 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
516 return "Unknown svcpart" unless $part_svc;
518 if ( $self->pkgnum && ! $ignore_quantity ) {
520 #slightly inefficient since ->pkg_svc will also look it up, but fixing
521 # a much larger perf problem and have bigger fish to fry
522 my $cust_pkg = $self->cust_pkg;
524 my $pkg_svc = $self->pkg_svc
525 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
526 'pkgpart' => $cust_pkg->pkgpart,
530 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
531 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
532 my $addon_pkg_svc = qsearchs('pkg_svc', {
533 pkgpart => $part_pkg_link->dst_pkgpart,
534 svcpart => $self->svcpart,
536 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
540 #better error message? UI shouldn't get here
541 return "No svcpart ". $self->svcpart.
542 " services in pkgpart ". $cust_pkg->pkgpart
543 unless $pkg_svc->quantity > 0;
545 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
547 #false laziness w/cust_pkg->part_svc
548 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
552 #better error message? again, UI shouldn't get here
553 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
554 " services for pkgnum ". $self->pkgnum
557 #part_svc_link rules (only make sense in pkgpart context, and
558 # skipping this when ignore_quantity is set DTRT when we're "forcing"
559 # an implicit change here (location change triggered pkgpart change,
560 # ->overlimit, bulk customer service changes)
561 foreach my $part_svc_link ( $self->part_svc_link(
562 link_type => 'cust_svc_provision_restrict',
565 return $part_svc_link->dst_svc. ' must be provisioned before '.
566 $part_svc_link->src_svc
568 'table' => 'cust_svc',
569 'hashref' => { 'pkgnum' => $self->pkgnum,
570 'svcpart' => $part_svc_link->dst_svcpart,
572 'order_by' => 'LIMIT 1',
581 =item check_part_svc_link_unprovision
583 Checks service dependency unprovision rules for this service.
585 If there is an error, returns the error, otherwise returns false.
589 sub check_part_svc_link_unprovision {
592 foreach my $part_svc_link ( $self->part_svc_link(
593 link_type => 'cust_svc_unprovision_restrict',
596 return $part_svc_link->dst_svc. ' must be unprovisioned before '.
597 $part_svc_link->src_svc
599 'table' => 'cust_svc',
600 'hashref' => { 'pkgnum' => $self->pkgnum,
601 'svcpart' => $part_svc_link->dst_svcpart,
603 'order_by' => 'LIMIT 1',
612 Returns the service dependencies (see L<FS::part_svc_link>) for the given
613 search options, taking into account this service definition as source and
614 this customer's agent.
616 Available options are any field in part_svc_link. Typically used options are
623 my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
624 FS::part_svc_link->by_agentnum($agentnum,
625 src_svcpart=>$self->svcpart,
633 Returns the displayed service number for this service: agent_svcid if it has a
634 value, svcnum otherwise
640 $self->agent_svcid || $self->svcnum;
645 Returns the definition for this service, as a FS::part_svc object (see
652 return $self->{_svcpart} if $self->{_svcpart};
653 cluck 'cust_svc->part_svc called' if $DEBUG;
654 qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
659 Returns the package this service belongs to, as a FS::cust_pkg object (see
664 Returns the pkg_svc record for for this service, if applicable.
670 my $cust_pkg = $self->cust_pkg;
671 return undef unless $cust_pkg;
673 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
674 'pkgpart' => $cust_pkg->pkgpart,
681 Returns the date this service was inserted.
687 $self->h_date('insert');
690 =item pkg_cancel_date
692 Returns the date this service's package was canceled. This normally only
693 exists for a service that's been preserved through cancellation with the
694 part_pkg.preserve flag.
698 sub pkg_cancel_date {
700 my $cust_pkg = $self->cust_pkg or return;
701 return $cust_pkg->getfield('cancel') || '';
706 Returns a list consisting of:
707 - The name of this service (from part_svc)
708 - A meaningful identifier (username, domain, or mail alias)
709 - The table name (i.e. svc_domain) for this service
714 my($label, $value, $svcdb) = $cust_svc->label;
718 Like the B<label> method, except the second item in the list ("meaningful
719 identifier") may be longer - typically, a full name is included.
723 sub label { shift->_label('svc_label', @_); }
724 sub label_long { shift->_label('svc_label_long', @_); }
729 my $svc_x = $self->svc_x
730 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
732 $self->$method($svc_x);
735 sub svc_label { shift->_svc_label('label', @_); }
736 sub svc_label_long { shift->_svc_label('label_long', @_); }
739 my( $self, $method, $svc_x ) = ( shift, shift, shift );
742 $self->part_svc->svc,
744 $self->part_svc->svcdb,
752 Returns a listref of html elements associated with this service's exports.
758 my $svc_x = $self->svc_x
759 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
761 $svc_x->export_links;
764 =item export_getsettings
766 Returns two hashrefs of settings associated with this service's exports.
770 sub export_getsettings {
772 my $svc_x = $self->svc_x
773 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
775 $svc_x->export_getsettings;
781 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
782 FS::svc_domain object, etc.)
788 my $svcdb = $self->part_svc->svcdb;
789 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
790 $self->{'_svc_acct'};
792 require "FS/$svcdb.pm";
793 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
794 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
796 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
800 =item seconds_since TIMESTAMP
802 See L<FS::svc_acct/seconds_since>. Equivalent to
803 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
804 where B<svcdb> is not "svc_acct".
808 #internal session db deprecated (or at least on hold)
809 sub seconds_since { 'internal session db deprecated'; };
810 ##note: implementation here, POD in FS::svc_acct
812 # my($self, $since) = @_;
814 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
817 # AND logout IS NOT NULL'
818 # ) or die $dbh->errstr;
819 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
820 # $sth->fetchrow_arrayref->[0];
823 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
825 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
826 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
827 for records where B<svcdb> is not "svc_acct".
831 #note: implementation here, POD in FS::svc_acct
832 sub seconds_since_sqlradacct {
833 my($self, $start, $end) = @_;
835 my $mes = "$me seconds_since_sqlradacct:";
837 my $svc_x = $self->svc_x;
839 my @part_export = $self->part_svc->part_export_usage;
840 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
841 " service definition"
846 foreach my $part_export ( @part_export ) {
848 next if $part_export->option('ignore_accounting');
850 warn "$mes connecting to sqlradius database\n"
853 my $dbh = DBI->connect( map { $part_export->option($_) }
854 qw(datasrc username password) )
855 or die "can't connect to sqlradius database: ". $DBI::errstr;
857 warn "$mes connected to sqlradius database\n"
860 #select a unix time conversion function based on database type
861 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
862 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
864 my $username = $part_export->export_username($svc_x);
868 warn "$mes finding closed sessions completely within the given range\n"
873 if ($part_export->option('process_single_realm')) {
874 $realm = 'AND Realm = ?';
875 $realmparam = $part_export->option('realm');
878 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
882 AND $str2time AcctStartTime $closing >= ?
883 AND $str2time AcctStopTime $closing < ?
884 AND $str2time AcctStopTime $closing > 0
885 AND AcctStopTime IS NOT NULL"
886 ) or die $dbh->errstr;
887 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
889 my $regular = $sth->fetchrow_arrayref->[0];
891 warn "$mes finding open sessions which start in the range\n"
894 # count session start->range end
895 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
899 AND $str2time AcctStartTime $closing >= ?
900 AND $str2time AcctStartTime $closing < ?
901 AND ( ? - $str2time AcctStartTime $closing ) < 86400
902 AND ( $str2time AcctStopTime $closing = 0
903 OR AcctStopTime IS NULL )";
904 $sth = $dbh->prepare($query) or die $dbh->errstr;
907 ($realm ? $realmparam : ()),
911 or die $sth->errstr. " executing query $query";
912 my $start_during = $sth->fetchrow_arrayref->[0];
914 warn "$mes finding closed sessions which start before the range but stop during\n"
917 #count range start->session end
918 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
922 AND $str2time AcctStartTime $closing < ?
923 AND $str2time AcctStopTime $closing >= ?
924 AND $str2time AcctStopTime $closing < ?
925 AND $str2time AcctStopTime $closing > 0
926 AND AcctStopTime IS NOT NULL"
927 ) or die $dbh->errstr;
928 $sth->execute( $start,
930 ($realm ? $realmparam : ()),
935 my $end_during = $sth->fetchrow_arrayref->[0];
937 warn "$mes finding closed sessions which start before the range but stop after\n"
940 # count range start->range end
941 # don't count open sessions anymore (probably missing stop record)
942 $sth = $dbh->prepare("SELECT COUNT(*)
946 AND $str2time AcctStartTime $closing < ?
947 AND ( $str2time AcctStopTime $closing >= ?
949 # OR AcctStopTime = 0
950 # OR AcctStopTime IS NULL )"
951 ) or die $dbh->errstr;
952 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
954 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
956 $seconds += $regular + $end_during + $start_during + $entire_range;
958 warn "$mes done finding sessions\n"
967 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
969 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
970 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
971 for records where B<svcdb> is not "svc_acct".
975 #note: implementation here, POD in FS::svc_acct
976 #(false laziness w/seconds_since_sqlradacct above)
977 sub attribute_since_sqlradacct {
978 my($self, $start, $end, $attrib) = @_;
980 my $mes = "$me attribute_since_sqlradacct:";
982 my $svc_x = $self->svc_x;
984 my @part_export = $self->part_svc->part_export_usage;
985 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
986 " service definition"
992 foreach my $part_export ( @part_export ) {
994 next if $part_export->option('ignore_accounting');
996 warn "$mes connecting to sqlradius database\n"
999 my $dbh = DBI->connect( map { $part_export->option($_) }
1000 qw(datasrc username password) )
1001 or die "can't connect to sqlradius database: ". $DBI::errstr;
1003 warn "$mes connected to sqlradius database\n"
1006 #select a unix time conversion function based on database type
1007 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1008 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1010 my $username = $part_export->export_username($svc_x);
1012 warn "$mes SUMing $attrib sessions\n"
1016 my $realmparam = '';
1017 if ($part_export->option('process_single_realm')) {
1018 $realm = 'AND Realm = ?';
1019 $realmparam = $part_export->option('realm');
1022 my $sth = $dbh->prepare("SELECT SUM($attrib)
1026 AND $str2time AcctStopTime $closing >= ?
1027 AND $str2time AcctStopTime $closing < ?
1028 AND AcctStopTime IS NOT NULL"
1029 ) or die $dbh->errstr;
1030 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
1031 or die $sth->errstr;
1033 my $row = $sth->fetchrow_arrayref;
1034 $sum += $row->[0] if defined($row->[0]);
1036 warn "$mes done SUMing sessions\n"
1045 #note: implementation here, POD in FS::svc_acct
1046 # false laziness w/above
1047 sub attribute_last_sqlradacct {
1048 my($self, $attrib) = @_;
1050 my $mes = "$me attribute_last_sqlradacct:";
1052 my $svc_x = $self->svc_x;
1054 my @part_export = $self->part_svc->part_export_usage;
1055 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1056 " service definition"
1057 unless @part_export;
1061 my $AcctStartTime = 0;
1063 foreach my $part_export ( @part_export ) {
1065 next if $part_export->option('ignore_accounting');
1067 warn "$mes connecting to sqlradius database\n"
1070 my $dbh = DBI->connect( map { $part_export->option($_) }
1071 qw(datasrc username password) )
1072 or die "can't connect to sqlradius database: ". $DBI::errstr;
1074 warn "$mes connected to sqlradius database\n"
1077 #select a unix time conversion function based on database type
1078 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1079 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1081 my $username = $part_export->export_username($svc_x);
1083 warn "$mes finding most-recent $attrib\n"
1087 my $realmparam = '';
1088 if ($part_export->option('process_single_realm')) {
1089 $realm = 'AND Realm = ?';
1090 $realmparam = $part_export->option('realm');
1093 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1097 ORDER BY AcctStartTime DESC LIMIT 1
1098 ") or die $dbh->errstr;
1099 $sth->execute($username, ($realm ? $realmparam : ()) )
1100 or die $sth->errstr;
1102 my $row = $sth->fetchrow_arrayref;
1103 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1105 $AcctStartTime = $row->[1];
1117 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1119 See L<FS::svc_acct/get_session_history>. Equivalent to
1120 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1121 records where B<svcdb> is not "svc_acct".
1125 sub get_session_history {
1126 my($self, $start, $end, $attrib) = @_;
1130 my @part_export = $self->part_svc->part_export_usage;
1131 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1132 " service definition"
1133 unless @part_export;
1138 foreach my $part_export ( @part_export ) {
1140 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1147 =item tickets [ STATUS ]
1149 Returns an array of hashes representing the tickets linked to this service.
1151 An optional status (or arrayref or hashref of statuses) may be specified.
1157 my $status = ( @_ && $_[0] ) ? shift : '';
1159 my $conf = FS::Conf->new;
1160 my $num = $conf->config('cust_main-max_tickets') || 10;
1163 if ( $conf->config('ticket_system') ) {
1164 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1166 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1175 foreach my $priority (
1176 $conf->config('ticket_system-custom_priority_field-values'), ''
1178 last if scalar(@tickets) >= $num;
1180 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1181 $num - scalar(@tickets),
1194 my $svc_x = $self->svc_x;
1195 +{ ( map { $_=>$self->$_ } $self->fields ),
1196 ( map { $svc_x=>$svc_x->$_ } $svc_x->fields ),
1206 =item smart_search OPTION => VALUE ...
1208 Accepts the option I<search>, the string to search for. The string will
1209 be searched for as a username, email address, IP address, MAC address,
1210 phone number, and hardware serial number. Unlike the I<smart_search> on
1211 customers, this always requires an exact match.
1215 # though perhaps it should be fuzzy in some cases?
1218 my %param = __PACKAGE__->smart_search_param(@_);
1222 sub smart_search_param {
1226 my $string = $opt{'search'};
1227 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1230 map { my $table = $_;
1231 my $search_sql = "FS::$table"->search_sql($string);
1232 my $addl_from = "FS::$table"->search_sql_addl_from();
1234 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1235 "FROM $table $addl_from WHERE $search_sql";
1237 FS::part_svc->svc_tables;
1239 if ( $string =~ /^(\d+)$/ ) {
1240 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1243 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1244 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1248 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1249 'null_right' => 'View/link unlinked services'
1251 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1253 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1254 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1255 ' LEFT JOIN part_svc USING ( svcpart )';
1258 'table' => 'cust_svc',
1259 'select' => 'svc_all.svcnum AS svcnum, '.
1260 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1262 'addl_from' => $addl_from,
1264 'extra_sql' => $extra_sql,
1268 # If the associated cust_pkg is 'on hold'
1269 # and the associated pkg_svc has the provision_hold flag
1270 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1271 # then removes hold from pkg
1272 # returns $error or '' on success,
1273 # does not indicate if pkg status was changed
1274 sub _check_provision_hold {
1277 # check status of cust_pkg
1278 my $cust_pkg = $self->cust_pkg;
1279 return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1281 # check flag on this svc
1282 # small false laziness with $self->pkg_svc
1283 # to avoid looking up cust_pkg twice
1284 my $pkg_svc = qsearchs( 'pkg_svc', {
1285 'svcpart' => $self->svcpart,
1286 'pkgpart' => $cust_pkg->pkgpart,
1288 return '' unless $pkg_svc->provision_hold;
1290 # check for any others available with that flag
1291 return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1293 # conditions met, remove hold
1294 return $cust_pkg->unsuspend;
1300 # fix missing (deleted by mistake) svc_x records
1301 warn "searching for missing svc_x records...\n";
1303 'table' => 'cust_svc',
1304 'select' => 'cust_svc.*',
1305 'addl_from' => ' LEFT JOIN ( ' .
1307 map { "SELECT svcnum FROM $_" }
1308 FS::part_svc->svc_tables
1309 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1310 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1312 my @svcs = qsearch(\%search);
1313 warn "found ".scalar(@svcs)."\n";
1315 local $FS::Record::nowarn_classload = 1; # for h_svc_
1316 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1319 'hashref' => { history_action => 'delete' },
1320 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1322 foreach my $cust_svc (@svcs) {
1323 my $svcnum = $cust_svc->svcnum;
1324 my $svcdb = $cust_svc->part_svc->svcdb;
1325 $h_search{'hashref'}{'svcnum'} = $svcnum;
1326 $h_search{'table'} = "h_$svcdb";
1327 my $h_svc_x = qsearchs(\%h_search);
1329 my $class = "FS::$svcdb";
1330 my $new_svc_x = $class->new({ $h_svc_x->hash });
1331 my $error = $new_svc_x->insert;
1332 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1335 # can't be fixed, so remove the dangling cust_svc to avoid breaking
1337 my $error = $cust_svc->delete;
1338 warn "error cleaning up missing svcnum $svcnum ($svcdb):\n$error\n";
1349 Behaviour of changing the svcpart of cust_svc records is undefined and should
1350 possibly be prohibited, and pkg_svc records are not checked.
1352 pkg_svc records are not checked in general (here).
1354 Deleting this record doesn't check or delete the svc_* record associated
1357 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1358 a DBI database handle is not yet implemented.
1362 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1363 schema.html from the base documentation