2 use base qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
5 use vars qw( $DEBUG $me $ignore_quantity $conf $ticket_system );
7 #use Scalar::Util qw( blessed );
8 use List::Util qw( max );
10 use FS::Record qw( qsearch qsearchs dbh str2time_sql str2time_sql_closing );
14 use FS::part_svc_link;
15 use FS::domain_record;
19 use FS::export_cust_svc;
22 #most FS::svc_ classes are autoloaded in svc_x emthod
23 use FS::svc_acct; #this one is used in the cache stuff
31 #ask FS::UID to run this stuff for us later
32 FS::UID->install_callback( sub {
34 $ticket_system = $conf->config('ticket_system')
37 our $cache_enabled = 0;
40 my( $self, $hashref ) = @_;
41 if ( $cache_enabled && $hashref->{'svc'} ) {
42 $self->{'_svcpart'} = FS::part_svc->new($hashref);
48 my ( $hashref, $cache ) = @_;
49 if ( $hashref->{'username'} ) {
50 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
52 if ( $hashref->{'svc'} ) {
53 $self->{'_svcpart'} = FS::part_svc->new($hashref);
59 FS::cust_svc - Object method for cust_svc objects
65 $record = new FS::cust_svc \%hash
66 $record = new FS::cust_svc { 'column' => 'value' };
68 $error = $record->insert;
70 $error = $new_record->replace($old_record);
72 $error = $record->delete;
74 $error = $record->check;
76 ($label, $value) = $record->label;
80 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
81 The following fields are currently supported:
85 =item svcnum - primary key (assigned automatically for new services)
87 =item pkgnum - Package (see L<FS::cust_pkg>)
89 =item svcpart - Service definition (see L<FS::part_svc>)
91 =item agent_svcid - Optional legacy service ID
93 =item overlimit - date the service exceeded its usage limit
103 Creates a new service. To add the refund to the database, see L<"insert">.
104 Services are normally created by creating FS::svc_ objects (see
105 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
109 sub table { 'cust_svc'; }
113 Adds this service to the database. If there is an error, returns the error,
114 otherwise returns false.
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::insert;
134 #check if this releases a hold (see FS::pkg_svc provision_hold)
135 $error ||= $self->_check_provision_hold;
138 $dbh->rollback if $oldAutoCommit;
139 return $error if $error
142 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
149 Deletes this service from the database. If there is an error, returns the
150 error, otherwise returns false. Note that this only removes the cust_svc
151 record - you should probably use the B<cancel> method instead.
160 my $cust_pkg = $self->cust_pkg;
161 my $custnum = $cust_pkg->custnum if $cust_pkg;
163 local $SIG{HUP} = 'IGNORE';
164 local $SIG{INT} = 'IGNORE';
165 local $SIG{QUIT} = 'IGNORE';
166 local $SIG{TERM} = 'IGNORE';
167 local $SIG{TSTP} = 'IGNORE';
168 local $SIG{PIPE} = 'IGNORE';
170 my $oldAutoCommit = $FS::UID::AutoCommit;
171 local $FS::UID::AutoCommit = 0;
174 # delete associated export_cust_svc
175 foreach my $export_cust_svc (
176 qsearch('export_cust_svc',{ 'svcnum' => $self->svcnum })
178 my $error = $export_cust_svc->delete;
180 $dbh->rollback if $oldAutoCommit;
185 my $error = $self->SUPER::delete;
187 $dbh->rollback if $oldAutoCommit;
191 foreach my $part_svc_link ( $self->part_svc_link(
192 link_type => 'cust_svc_unprovision_cascade',
195 foreach my $cust_svc ( qsearch( 'cust_svc', {
196 'pkgnum' => $self->pkgnum,
197 'svcpart' => $part_svc_link->dst_svcpart,
200 my $error = $cust_svc->svc_x->delete;
202 $dbh->rollback if $oldAutoCommit;
209 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
211 if ( $ticket_system eq 'RT_Internal' ) {
212 unless ( $rt_session ) {
213 FS::TicketSystem->init;
214 $rt_session = FS::TicketSystem->session;
216 my $links = RT::Links->new($rt_session->{CurrentUser});
217 my $svcnum = $self->svcnum;
218 $links->Limit(FIELD => 'Target',
219 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
220 while ( my $l = $links->Next ) {
223 # re-link to point to the customer instead
225 $l->SetTarget('freeside://freeside/cust_main/'.$custnum);
228 ($val, $msg) = $l->Delete;
230 # can't do anything useful on error
231 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
241 Suspends the relevant service by calling the B<suspend> method of the associated
242 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object).
244 If there is an error, returns the error, otherwise returns false.
249 my( $self, %opt ) = @_;
251 $self->part_svc->svcdb =~ /^([\w\-]+)$/ or return 'Illegal part_svc.svcdb';
253 require "FS/$svcdb.pm";
255 my $svc = qsearchs( $svcdb, { 'svcnum' => $self->svcnum } )
258 my $error = $svc->suspend;
259 return $error if $error;
261 if ( $opt{labels_arryref} ) {
262 my( $label, $value ) = $self->label;
263 push @{ $opt{labels_arrayref} }, "$label: $value";
272 Cancels the relevant service by calling the B<cancel> method of the associated
273 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
274 deleting the FS::svc_XXX record and then deleting this record.
276 If there is an error, returns the error, otherwise returns false.
283 local $SIG{HUP} = 'IGNORE';
284 local $SIG{INT} = 'IGNORE';
285 local $SIG{QUIT} = 'IGNORE';
286 local $SIG{TERM} = 'IGNORE';
287 local $SIG{TSTP} = 'IGNORE';
288 local $SIG{PIPE} = 'IGNORE';
290 my $oldAutoCommit = $FS::UID::AutoCommit;
291 local $FS::UID::AutoCommit = 0;
294 my $part_svc = $self->part_svc;
296 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
297 $dbh->rollback if $oldAutoCommit;
298 return "Illegal svcdb value in part_svc!";
301 require "FS/$svcdb.pm";
303 my $svc = $self->svc_x;
305 if ( %opt && $opt{'date'} ) {
306 my $error = $svc->expire($opt{'date'});
308 $dbh->rollback if $oldAutoCommit;
309 return "Error expiring service: $error";
312 my $error = $svc->cancel;
314 $dbh->rollback if $oldAutoCommit;
315 return "Error canceling service: $error";
317 $error = $svc->delete; #this deletes this cust_svc record as well
319 $dbh->rollback if $oldAutoCommit;
320 return "Error deleting service: $error";
327 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
328 "; deleting cust_svc only\n";
330 my $error = $self->delete;
332 $dbh->rollback if $oldAutoCommit;
333 return "Error deleting cust_svc: $error";
338 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
344 =item overlimit [ ACTION ]
346 Retrieves or sets the overlimit date. If ACTION is absent, return
347 the present value of overlimit. If ACTION is present, it can
348 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
349 is set to the current time if it is not already set. The 'unsuspend' value
350 causes the time to be cleared.
352 If there is an error on setting, returns the error, otherwise returns false.
358 my $action = shift or return $self->getfield('overlimit');
360 local $SIG{HUP} = 'IGNORE';
361 local $SIG{INT} = 'IGNORE';
362 local $SIG{QUIT} = 'IGNORE';
363 local $SIG{TERM} = 'IGNORE';
364 local $SIG{TSTP} = 'IGNORE';
365 local $SIG{PIPE} = 'IGNORE';
367 my $oldAutoCommit = $FS::UID::AutoCommit;
368 local $FS::UID::AutoCommit = 0;
371 if ( $action eq 'suspend' ) {
372 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
373 }elsif ( $action eq 'unsuspend' ) {
374 $self->setfield('overlimit', '');
376 die "unexpected action value: $action";
379 local $ignore_quantity = 1;
380 my $error = $self->replace;
382 $dbh->rollback if $oldAutoCommit;
383 return "Error setting overlimit: $error";
386 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
392 =item replace OLD_RECORD
394 Replaces the OLD_RECORD with this one in the database. If there is an error,
395 returns the error, otherwise returns false.
402 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
404 # : $new->replace_old;
405 my ( $new, $old ) = ( shift, shift );
406 $old = $new->replace_old unless defined($old);
408 local $SIG{HUP} = 'IGNORE';
409 local $SIG{INT} = 'IGNORE';
410 local $SIG{QUIT} = 'IGNORE';
411 local $SIG{TERM} = 'IGNORE';
412 local $SIG{TSTP} = 'IGNORE';
413 local $SIG{PIPE} = 'IGNORE';
415 my $oldAutoCommit = $FS::UID::AutoCommit;
416 local $FS::UID::AutoCommit = 0;
419 if ( $new->svcpart != $old->svcpart ) {
420 my $svc_x = $new->svc_x;
421 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
422 local($FS::Record::nowarn_identical) = 1;
423 my $error = $new_svc_x->replace($svc_x);
425 $dbh->rollback if $oldAutoCommit;
426 return $error if $error;
430 # #trigger a re-export on pkgnum changes?
431 # # (of prepaid packages), for Expiration RADIUS attribute
432 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
433 # my $svc_x = $new->svc_x;
434 # local($FS::Record::nowarn_identical) = 1;
435 # my $error = $svc_x->export('replace');
437 # $dbh->rollback if $oldAutoCommit;
438 # return $error if $error;
442 #trigger a pkg_change export on pkgnum changes
443 if ( $new->pkgnum != $old->pkgnum ) {
444 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
449 $dbh->rollback if $oldAutoCommit;
450 return $error if $error;
452 } # if pkgnum is changing
454 #my $error = $new->SUPER::replace($old, @_);
455 my $error = $new->SUPER::replace($old);
457 #trigger a relocate export on location changes (NENA2 and Northern 911 export)
458 my $old_pkg = $old->cust_pkg;
459 my $new_pkg = $new->cust_pkg;
460 if ( $old_pkg && $new_pkg && $new_pkg->locationnum != $old_pkg->locationnum ) {
461 my $svc_x = $new->svc_x;
462 if ( $svc_x->locationnum ) {
463 if ( $svc_x->locationnum == $old->cust_pkg->locationnum ) {
464 # in this case, set the service location to be the same as the new
466 $svc_x->set('locationnum', $new->cust_pkg->locationnum);
467 # and replace it, which triggers a relocate export so we don't
469 $error ||= $svc_x->replace;
471 # the service already has a different location from its package
475 # the service doesn't have a locationnum (either isn't of a type
476 # that has the locationnum field, or the locationnum is null and
477 # defaults to cust_pkg->locationnum)
478 # so just trigger the export here
479 $error ||= $new->svc_x->export('relocate',
480 $new->cust_pkg->cust_location,
481 $old->cust_pkg->cust_location,
483 } # if ($svc_x->locationnum)
484 } # if this is a location change
486 #check if this releases a hold (see FS::pkg_svc provision_hold)
487 $error ||= $new->_check_provision_hold;
490 $dbh->rollback if $oldAutoCommit;
491 return $error if $error
494 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
501 Checks all fields to make sure this is a valid service. If there is an error,
502 returns the error, otherwise returns false. Called by the insert and
511 $self->ut_numbern('svcnum')
512 || $self->ut_numbern('pkgnum')
513 || $self->ut_number('svcpart')
514 || $self->ut_numbern('agent_svcid')
515 || $self->ut_numbern('overlimit')
517 return $error if $error;
519 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
520 return "Unknown svcpart" unless $part_svc;
522 if ( $self->pkgnum && ! $ignore_quantity ) {
524 #slightly inefficient since ->pkg_svc will also look it up, but fixing
525 # a much larger perf problem and have bigger fish to fry
526 my $cust_pkg = $self->cust_pkg;
528 my $pkg_svc = $self->pkg_svc
529 || new FS::pkg_svc { 'svcpart' => $self->svcpart,
530 'pkgpart' => $cust_pkg->pkgpart,
534 #service add-ons, kinda false laziness/reimplementation of part_pkg->pkg_svc
535 foreach my $part_pkg_link ( $cust_pkg->part_pkg->svc_part_pkg_link ) {
536 my $addon_pkg_svc = qsearchs('pkg_svc', {
537 pkgpart => $part_pkg_link->dst_pkgpart,
538 svcpart => $self->svcpart,
540 $pkg_svc->quantity( $pkg_svc->quantity + $addon_pkg_svc->quantity )
544 #better error message? UI shouldn't get here
545 return "No svcpart ". $self->svcpart.
546 " services in pkgpart ". $cust_pkg->pkgpart
547 unless $pkg_svc->quantity > 0;
549 my $num_cust_svc = $cust_pkg->num_cust_svc( $self->svcpart );
551 #false laziness w/cust_pkg->part_svc
552 my $num_avail = max( 0, ($cust_pkg->quantity || 1) * $pkg_svc->quantity
556 #better error message? again, UI shouldn't get here
557 return "Already $num_cust_svc ". $pkg_svc->part_svc->svc.
558 " services for pkgnum ". $self->pkgnum
561 #part_svc_link rules (only make sense in pkgpart context, and
562 # skipping this when ignore_quantity is set DTRT when we're "forcing"
563 # an implicit change here (location change triggered pkgpart change,
564 # ->overlimit, bulk customer service changes)
565 foreach my $part_svc_link ( $self->part_svc_link(
566 link_type => 'cust_svc_provision_restrict',
569 return $part_svc_link->dst_svc. ' must be provisioned before '.
570 $part_svc_link->src_svc
572 'table' => 'cust_svc',
573 'hashref' => { 'pkgnum' => $self->pkgnum,
574 'svcpart' => $part_svc_link->dst_svcpart,
576 'order_by' => 'LIMIT 1',
585 =item check_part_svc_link_unprovision
587 Checks service dependency unprovision rules for this service.
589 If there is an error, returns the error, otherwise returns false.
593 sub check_part_svc_link_unprovision {
596 foreach my $part_svc_link ( $self->part_svc_link(
597 link_type => 'cust_svc_unprovision_restrict',
600 return $part_svc_link->dst_svc. ' must be unprovisioned before '.
601 $part_svc_link->src_svc
603 'table' => 'cust_svc',
604 'hashref' => { 'pkgnum' => $self->pkgnum,
605 'svcpart' => $part_svc_link->dst_svcpart,
607 'order_by' => 'LIMIT 1',
616 Returns the service dependencies (see L<FS::part_svc_link>) for the given
617 search options, taking into account this service definition as source and
618 this customer's agent.
620 Available options are any field in part_svc_link. Typically used options are
627 my $agentnum = $self->pkgnum ? $self->cust_pkg->cust_main->agentnum : '';
628 FS::part_svc_link->by_agentnum($agentnum,
629 src_svcpart=>$self->svcpart,
637 Returns the displayed service number for this service: agent_svcid if it has a
638 value, svcnum otherwise
644 $self->agent_svcid || $self->svcnum;
649 Returns the definition for this service, as a FS::part_svc object (see
656 return $self->{_svcpart} if $self->{_svcpart};
657 cluck 'cust_svc->part_svc called' if $DEBUG;
658 qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
663 Returns the package this service belongs to, as a FS::cust_pkg object (see
668 Returns the pkg_svc record for for this service, if applicable.
674 my $cust_pkg = $self->cust_pkg;
675 return undef unless $cust_pkg;
677 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
678 'pkgpart' => $cust_pkg->pkgpart,
685 Returns the date this service was inserted.
691 $self->h_date('insert');
694 =item pkg_cancel_date
696 Returns the date this service's package was canceled. This normally only
697 exists for a service that's been preserved through cancellation with the
698 part_pkg.preserve flag.
702 sub pkg_cancel_date {
704 my $cust_pkg = $self->cust_pkg or return;
705 return $cust_pkg->getfield('cancel') || '';
708 =item label [ LOCALE ]
710 Returns a list consisting of:
711 - The name of this service (from part_svc), optionally localized
712 - A meaningful identifier (username, domain, or mail alias)
713 - The table name (i.e. svc_domain) for this service
718 my($label, $value, $svcdb) = $cust_svc->label;
720 =item label_long [ LOCALE ]
722 Like the B<label> method, except the second item in the list ("meaningful
723 identifier") may be longer - typically, a full name is included.
727 sub label { shift->_label('svc_label', @_); }
728 sub label_long { shift->_label('svc_label_long', @_); }
734 my $svc_x = $self->svc_x
735 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
737 $self->$method($svc_x, undef, undef, $locale);
740 # svc_label(_long) takes three arguments: end date, start date, locale
741 # and FS::svc_*::label methods must accept those also, if they even care
743 sub svc_label { shift->_svc_label('label', @_); }
744 sub svc_label_long { shift->_svc_label('label_long', @_); }
747 my( $self, $method, $svc_x ) = ( shift, shift, shift );
748 my ($end, $start, $locale) = @_;
751 $self->part_svc->svc_locale($locale),
753 $self->part_svc->svcdb,
761 Returns a listref of html elements associated with this service's exports.
767 my $svc_x = $self->svc_x
768 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
770 $svc_x->export_links;
773 =item export_getsettings
775 Returns two hashrefs of settings associated with this service's exports.
779 sub export_getsettings {
781 my $svc_x = $self->svc_x
782 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
784 $svc_x->export_getsettings;
790 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
791 FS::svc_domain object, etc.)
797 my $svcdb = $self->part_svc->svcdb;
798 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
799 $self->{'_svc_acct'};
801 require "FS/$svcdb.pm";
802 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
803 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
805 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
809 =item seconds_since TIMESTAMP
811 See L<FS::svc_acct/seconds_since>. Equivalent to
812 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
813 where B<svcdb> is not "svc_acct".
817 #internal session db deprecated (or at least on hold)
818 sub seconds_since { 'internal session db deprecated'; };
819 ##note: implementation here, POD in FS::svc_acct
821 # my($self, $since) = @_;
823 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
826 # AND logout IS NOT NULL'
827 # ) or die $dbh->errstr;
828 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
829 # $sth->fetchrow_arrayref->[0];
832 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
834 Equivalent to $cust_svc->svc_x->seconds_since_sqlradacct, but
835 more efficient. Meaningless for records where B<svcdb> is not
836 svc_acct or svc_broadband.
840 sub seconds_since_sqlradacct {
841 my($self, $start, $end) = @_;
843 my $mes = "$me seconds_since_sqlradacct:";
845 my $svc_x = $self->svc_x;
847 my @part_export = $self->part_svc->part_export_usage;
848 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
849 " service definition"
854 foreach my $part_export ( @part_export ) {
856 next if $part_export->option('ignore_accounting');
858 warn "$mes connecting to sqlradius database\n"
861 my $dbh = FS::DBI->connect( map { $part_export->option($_) }
862 qw(datasrc username password) )
863 or die "can't connect to sqlradius database: ". $FS::DBI::errstr;
865 warn "$mes connected to sqlradius database\n"
868 #select a unix time conversion function based on database type
869 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
870 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
872 my $username = $part_export->export_username($svc_x);
876 warn "$mes finding closed sessions completely within the given range\n"
881 if ($part_export->option('process_single_realm')) {
882 $realm = 'AND Realm = ?';
883 $realmparam = $part_export->option('realm');
886 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
890 AND $str2time AcctStartTime $closing >= ?
891 AND $str2time AcctStopTime $closing < ?
892 AND $str2time AcctStopTime $closing > 0
893 AND AcctStopTime IS NOT NULL"
894 ) or die $dbh->errstr;
895 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
897 my $regular = $sth->fetchrow_arrayref->[0];
899 warn "$mes finding open sessions which start in the range\n"
902 # count session start->range end
903 $query = "SELECT SUM( ? - $str2time AcctStartTime $closing )
907 AND $str2time AcctStartTime $closing >= ?
908 AND $str2time AcctStartTime $closing < ?
909 AND ( ? - $str2time AcctStartTime $closing ) < 86400
910 AND ( $str2time AcctStopTime $closing = 0
911 OR AcctStopTime IS NULL )";
912 $sth = $dbh->prepare($query) or die $dbh->errstr;
915 ($realm ? $realmparam : ()),
919 or die $sth->errstr. " executing query $query";
920 my $start_during = $sth->fetchrow_arrayref->[0];
922 warn "$mes finding closed sessions which start before the range but stop during\n"
925 #count range start->session end
926 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime $closing - ? )
930 AND $str2time AcctStartTime $closing < ?
931 AND $str2time AcctStopTime $closing >= ?
932 AND $str2time AcctStopTime $closing < ?
933 AND $str2time AcctStopTime $closing > 0
934 AND AcctStopTime IS NOT NULL"
935 ) or die $dbh->errstr;
936 $sth->execute( $start,
938 ($realm ? $realmparam : ()),
943 my $end_during = $sth->fetchrow_arrayref->[0];
945 warn "$mes finding closed sessions which start before the range but stop after\n"
948 # count range start->range end
949 # don't count open sessions anymore (probably missing stop record)
950 $sth = $dbh->prepare("SELECT COUNT(*)
954 AND $str2time AcctStartTime $closing < ?
955 AND ( $str2time AcctStopTime $closing >= ?
957 # OR AcctStopTime = 0
958 # OR AcctStopTime IS NULL )"
959 ) or die $dbh->errstr;
960 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
962 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
964 $seconds += $regular + $end_during + $start_during + $entire_range;
966 warn "$mes done finding sessions\n"
975 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
977 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
978 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient.
979 Meaningless for records where B<svcdb> is not svc_acct or svc_broadband.
983 #(false laziness w/seconds_since_sqlradacct above)
984 sub attribute_since_sqlradacct {
985 my($self, $start, $end, $attrib) = @_;
987 my $mes = "$me attribute_since_sqlradacct:";
989 my $svc_x = $self->svc_x;
991 my @part_export = $self->part_svc->part_export_usage;
992 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
993 " service definition"
999 foreach my $part_export ( @part_export ) {
1001 next if $part_export->option('ignore_accounting');
1003 warn "$mes connecting to sqlradius database\n"
1006 my $dbh = FS::DBI->connect( map { $part_export->option($_) }
1007 qw(datasrc username password) )
1008 or die "can't connect to sqlradius database: ". $FS::DBI::errstr;
1010 warn "$mes connected to sqlradius database\n"
1013 #select a unix time conversion function based on database type
1014 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1015 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1017 my $username = $part_export->export_username($svc_x);
1019 warn "$mes SUMing $attrib sessions\n"
1023 my $realmparam = '';
1024 if ($part_export->option('process_single_realm')) {
1025 $realm = 'AND Realm = ?';
1026 $realmparam = $part_export->option('realm');
1029 my $sth = $dbh->prepare("SELECT SUM($attrib)
1033 AND $str2time AcctStopTime $closing >= ?
1034 AND $str2time AcctStopTime $closing < ?
1035 AND AcctStopTime IS NOT NULL"
1036 ) or die $dbh->errstr;
1037 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
1038 or die $sth->errstr;
1040 my $row = $sth->fetchrow_arrayref;
1041 $sum += $row->[0] if defined($row->[0]);
1043 warn "$mes done SUMing sessions\n"
1052 #note: implementation here, POD in FS::svc_acct
1053 # false laziness w/above
1054 sub attribute_last_sqlradacct {
1055 my($self, $attrib) = @_;
1057 my $mes = "$me attribute_last_sqlradacct:";
1059 my $svc_x = $self->svc_x;
1061 my @part_export = $self->part_svc->part_export_usage;
1062 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1063 " service definition"
1064 unless @part_export;
1068 my $AcctStartTime = 0;
1070 foreach my $part_export ( @part_export ) {
1072 next if $part_export->option('ignore_accounting');
1074 warn "$mes connecting to sqlradius database\n"
1077 my $dbh = FS::DBI->connect( map { $part_export->option($_) }
1078 qw(datasrc username password) )
1079 or die "can't connect to sqlradius database: ". $FS::DBI::errstr;
1081 warn "$mes connected to sqlradius database\n"
1084 #select a unix time conversion function based on database type
1085 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
1086 my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} );
1088 my $username = $part_export->export_username($svc_x);
1090 warn "$mes finding most-recent $attrib\n"
1094 my $realmparam = '';
1095 if ($part_export->option('process_single_realm')) {
1096 $realm = 'AND Realm = ?';
1097 $realmparam = $part_export->option('realm');
1100 my $sth = $dbh->prepare("SELECT $attrib, $str2time AcctStartTime $closing
1104 ORDER BY AcctStartTime DESC LIMIT 1
1105 ") or die $dbh->errstr;
1106 $sth->execute($username, ($realm ? $realmparam : ()) )
1107 or die $sth->errstr;
1109 my $row = $sth->fetchrow_arrayref;
1110 if ( defined($row->[0]) && $row->[1] > $AcctStartTime ) {
1112 $AcctStartTime = $row->[1];
1124 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1126 See L<FS::svc_acct/get_session_history>. Equivalent to
1127 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
1128 records where B<svcdb> is not "svc_acct".
1132 sub get_session_history {
1133 my($self, $start, $end, $attrib) = @_;
1137 my @part_export = $self->part_svc->part_export_usage;
1138 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
1139 " service definition"
1140 unless @part_export;
1145 foreach my $part_export ( @part_export ) {
1147 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
1154 =item tickets [ STATUS ]
1156 Returns an array of hashes representing the tickets linked to this service.
1158 An optional status (or arrayref or hashref of statuses) may be specified.
1164 my $status = ( @_ && $_[0] ) ? shift : '';
1166 my $conf = FS::Conf->new;
1167 my $num = $conf->config('cust_main-max_tickets') || 10;
1170 if ( $conf->config('ticket_system') ) {
1171 unless ( $conf->config('ticket_system-custom_priority_field') ) {
1173 @tickets = @{ FS::TicketSystem->service_tickets( $self->svcnum,
1182 foreach my $priority (
1183 $conf->config('ticket_system-custom_priority_field-values'), ''
1185 last if scalar(@tickets) >= $num;
1187 @{ FS::TicketSystem->service_tickets( $self->svcnum,
1188 $num - scalar(@tickets),
1201 my $svc_x = $self->svc_x;
1202 +{ ( map { $_=>$self->$_ } $self->fields ),
1203 ( map { $_=>$svc_x->$_ } $svc_x->fields ),
1213 =item smart_search OPTION => VALUE ...
1215 Accepts the option I<search>, the string to search for. The string will
1216 be searched for as a username, email address, IP address, MAC address,
1217 phone number, and hardware serial number. Unlike the I<smart_search> on
1218 customers, this always requires an exact match.
1222 # though perhaps it should be fuzzy in some cases?
1225 my %param = __PACKAGE__->smart_search_param(@_);
1229 sub smart_search_param {
1233 my $string = $opt{'search'};
1234 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
1237 map { my $table = $_;
1238 my $search_sql = "FS::$table"->search_sql($string);
1239 my $addl_from = "FS::$table"->search_sql_addl_from();
1241 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
1242 "FROM $table $addl_from WHERE $search_sql";
1244 FS::part_svc->svc_tables;
1246 if ( $string =~ /^(\d+)$/ ) {
1247 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
1250 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
1251 " ON (svc_all.svcnum = cust_svc.svcnum) ";
1255 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
1256 'null_right' => 'View/link unlinked services'
1258 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
1260 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
1261 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
1262 ' LEFT JOIN part_svc USING ( svcpart )';
1265 'table' => 'cust_svc',
1266 'select' => 'svc_all.svcnum AS svcnum, '.
1267 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
1269 'addl_from' => $addl_from,
1271 'extra_sql' => $extra_sql,
1275 # If the associated cust_pkg is 'on hold'
1276 # and the associated pkg_svc has the provision_hold flag
1277 # and there are no more available_part_svcs on the cust_pkg similarly flagged,
1278 # then removes hold from pkg
1279 # returns $error or '' on success,
1280 # does not indicate if pkg status was changed
1281 sub _check_provision_hold {
1284 # check status of cust_pkg
1285 my $cust_pkg = $self->cust_pkg;
1286 return '' unless $cust_pkg && $cust_pkg->status eq 'on hold';
1288 # check flag on this svc
1289 # small false laziness with $self->pkg_svc
1290 # to avoid looking up cust_pkg twice
1291 my $pkg_svc = qsearchs( 'pkg_svc', {
1292 'svcpart' => $self->svcpart,
1293 'pkgpart' => $cust_pkg->pkgpart,
1295 return '' unless $pkg_svc->provision_hold;
1297 # check for any others available with that flag
1298 return '' if $cust_pkg->available_part_svc( 'provision_hold' => 1 );
1300 # conditions met, remove hold
1301 return $cust_pkg->unsuspend;
1307 # fix missing (deleted by mistake) svc_x records
1308 warn "searching for missing svc_x records...\n";
1310 'table' => 'cust_svc',
1311 'select' => 'cust_svc.*',
1312 'addl_from' => ' LEFT JOIN ( ' .
1314 map { "SELECT svcnum FROM $_" }
1315 FS::part_svc->svc_tables
1316 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
1317 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
1319 my @svcs = qsearch(\%search);
1320 warn "found ".scalar(@svcs)."\n";
1322 local $FS::Record::nowarn_classload = 1; # for h_svc_
1323 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
1326 'hashref' => { history_action => 'delete' },
1327 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
1329 foreach my $cust_svc (@svcs) {
1330 my $svcnum = $cust_svc->svcnum;
1331 my $svcdb = $cust_svc->part_svc->svcdb;
1332 $h_search{'hashref'}{'svcnum'} = $svcnum;
1333 $h_search{'table'} = "h_$svcdb";
1334 my $h_svc_x = qsearchs(\%h_search);
1336 my $class = "FS::$svcdb";
1337 my $new_svc_x = $class->new({ $h_svc_x->hash });
1338 my $error = $new_svc_x->insert;
1339 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
1342 # can't be fixed, so remove the dangling cust_svc to avoid breaking
1344 my $error = $cust_svc->delete;
1345 warn "error cleaning up missing svcnum $svcnum ($svcdb):\n$error\n";
1356 Behaviour of changing the svcpart of cust_svc records is undefined and should
1357 possibly be prohibited, and pkg_svc records are not checked.
1359 pkg_svc records are not checked in general (here).
1361 Deleting this record doesn't check or delete the svc_* record associated
1364 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
1365 a DBI database handle is not yet implemented.
1369 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
1370 schema.html from the base documentation