4 use vars qw( @ISA $DEBUG $me $ignore_quantity );
6 #use Scalar::Util qw( blessed );
8 use FS::Record qw( qsearch qsearchs dbh str2time_sql );
13 use FS::domain_record;
17 #most FS::svc_ classes are autoloaded in svc_x emthod
18 use FS::svc_acct; #this one is used in the cache stuff
20 @ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
29 my ( $hashref, $cache ) = @_;
30 if ( $hashref->{'username'} ) {
31 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
33 if ( $hashref->{'svc'} ) {
34 $self->{'_svcpart'} = FS::part_svc->new($hashref);
40 FS::cust_svc - Object method for cust_svc objects
46 $record = new FS::cust_svc \%hash
47 $record = new FS::cust_svc { 'column' => 'value' };
49 $error = $record->insert;
51 $error = $new_record->replace($old_record);
53 $error = $record->delete;
55 $error = $record->check;
57 ($label, $value) = $record->label;
61 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
62 The following fields are currently supported:
66 =item svcnum - primary key (assigned automatically for new services)
68 =item pkgnum - Package (see L<FS::cust_pkg>)
70 =item svcpart - Service definition (see L<FS::part_svc>)
72 =item agent_svcid - Optional legacy service ID
74 =item overlimit - date the service exceeded its usage limit
84 Creates a new service. To add the refund to the database, see L<"insert">.
85 Services are normally created by creating FS::svc_ objects (see
86 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
90 sub table { 'cust_svc'; }
94 Adds this service to the database. If there is an error, returns the error,
95 otherwise returns false.
99 Deletes this service from the database. If there is an error, returns the
100 error, otherwise returns false. Note that this only removes the cust_svc
101 record - you should probably use the B<cancel> method instead.
107 my $error = $self->SUPER::delete;
108 return $error if $error;
110 if ( FS::Conf->new->config('ticket_system') eq 'RT_Internal' ) {
111 FS::TicketSystem->init;
112 my $session = FS::TicketSystem->session;
113 my $links = RT::Links->new($session->{CurrentUser});
114 my $svcnum = $self->svcnum;
115 $links->Limit(FIELD => 'Target',
116 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
117 while ( my $l = $links->Next ) {
118 my ($val, $msg) = $l->Delete;
119 # can't do anything useful on error
120 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
127 Cancels the relevant service by calling the B<cancel> method of the associated
128 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
129 deleting the FS::svc_XXX record and then deleting this record.
131 If there is an error, returns the error, otherwise returns false.
138 local $SIG{HUP} = 'IGNORE';
139 local $SIG{INT} = 'IGNORE';
140 local $SIG{QUIT} = 'IGNORE';
141 local $SIG{TERM} = 'IGNORE';
142 local $SIG{TSTP} = 'IGNORE';
143 local $SIG{PIPE} = 'IGNORE';
145 my $oldAutoCommit = $FS::UID::AutoCommit;
146 local $FS::UID::AutoCommit = 0;
149 my $part_svc = $self->part_svc;
151 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
152 $dbh->rollback if $oldAutoCommit;
153 return "Illegal svcdb value in part_svc!";
156 require "FS/$svcdb.pm";
158 my $svc = $self->svc_x;
160 if ( %opt && $opt{'date'} ) {
161 my $error = $svc->expire($opt{'date'});
163 $dbh->rollback if $oldAutoCommit;
164 return "Error expiring service: $error";
167 my $error = $svc->cancel;
169 $dbh->rollback if $oldAutoCommit;
170 return "Error canceling service: $error";
172 $error = $svc->delete; #this deletes this cust_svc record as well
174 $dbh->rollback if $oldAutoCommit;
175 return "Error deleting service: $error";
182 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
183 "; deleting cust_svc only\n";
185 my $error = $self->delete;
187 $dbh->rollback if $oldAutoCommit;
188 return "Error deleting cust_svc: $error";
193 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
199 =item overlimit [ ACTION ]
201 Retrieves or sets the overlimit date. If ACTION is absent, return
202 the present value of overlimit. If ACTION is present, it can
203 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
204 is set to the current time if it is not already set. The 'unsuspend' value
205 causes the time to be cleared.
207 If there is an error on setting, returns the error, otherwise returns false.
213 my $action = shift or return $self->getfield('overlimit');
215 local $SIG{HUP} = 'IGNORE';
216 local $SIG{INT} = 'IGNORE';
217 local $SIG{QUIT} = 'IGNORE';
218 local $SIG{TERM} = 'IGNORE';
219 local $SIG{TSTP} = 'IGNORE';
220 local $SIG{PIPE} = 'IGNORE';
222 my $oldAutoCommit = $FS::UID::AutoCommit;
223 local $FS::UID::AutoCommit = 0;
226 if ( $action eq 'suspend' ) {
227 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
228 }elsif ( $action eq 'unsuspend' ) {
229 $self->setfield('overlimit', '');
231 die "unexpected action value: $action";
234 local $ignore_quantity = 1;
235 my $error = $self->replace;
237 $dbh->rollback if $oldAutoCommit;
238 return "Error setting overlimit: $error";
241 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
247 =item replace OLD_RECORD
249 Replaces the OLD_RECORD with this one in the database. If there is an error,
250 returns the error, otherwise returns false.
257 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
259 # : $new->replace_old;
260 my ( $new, $old ) = ( shift, shift );
261 $old = $new->replace_old unless defined($old);
263 local $SIG{HUP} = 'IGNORE';
264 local $SIG{INT} = 'IGNORE';
265 local $SIG{QUIT} = 'IGNORE';
266 local $SIG{TERM} = 'IGNORE';
267 local $SIG{TSTP} = 'IGNORE';
268 local $SIG{PIPE} = 'IGNORE';
270 my $oldAutoCommit = $FS::UID::AutoCommit;
271 local $FS::UID::AutoCommit = 0;
274 if ( $new->svcpart != $old->svcpart ) {
275 my $svc_x = $new->svc_x;
276 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
277 local($FS::Record::nowarn_identical) = 1;
278 my $error = $new_svc_x->replace($svc_x);
280 $dbh->rollback if $oldAutoCommit;
281 return $error if $error;
285 # #trigger a re-export on pkgnum changes?
286 # # (of prepaid packages), for Expiration RADIUS attribute
287 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
288 # my $svc_x = $new->svc_x;
289 # local($FS::Record::nowarn_identical) = 1;
290 # my $error = $svc_x->export('replace');
292 # $dbh->rollback if $oldAutoCommit;
293 # return $error if $error;
297 #my $error = $new->SUPER::replace($old, @_);
298 my $error = $new->SUPER::replace($old);
300 $dbh->rollback if $oldAutoCommit;
301 return $error if $error;
304 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
311 Checks all fields to make sure this is a valid service. If there is an error,
312 returns the error, otherwise returns false. Called by the insert and
321 $self->ut_numbern('svcnum')
322 || $self->ut_numbern('pkgnum')
323 || $self->ut_number('svcpart')
324 || $self->ut_numbern('agent_svcid')
325 || $self->ut_numbern('overlimit')
327 return $error if $error;
329 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
330 return "Unknown svcpart" unless $part_svc;
332 if ( $self->pkgnum ) {
333 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
334 return "Unknown pkgnum" unless $cust_pkg;
335 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
336 return "No svcpart ". $self->svcpart.
337 " services in pkgpart ". $cust_pkg->pkgpart
339 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
340 " services for pkgnum ". $self->pkgnum
341 if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
349 Returns the displayed service number for this service: agent_svcid if it has a
350 value, svcnum otherwise
356 $self->agent_svcid || $self->svcnum;
361 Returns the definition for this service, as a FS::part_svc object (see
369 ? $self->{'_svcpart'}
370 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
375 Returns the package this service belongs to, as a FS::cust_pkg object (see
382 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
387 Returns the pkg_svc record for for this service, if applicable.
393 my $cust_pkg = $self->cust_pkg;
394 return undef unless $cust_pkg;
396 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
397 'pkgpart' => $cust_pkg->pkgpart,
404 Returns the date this service was inserted.
410 $self->h_date('insert');
413 =item pkg_cancel_date
415 Returns the date this service's package was canceled. This normally only
416 exists for a service that's been preserved through cancellation with the
417 part_pkg.preserve flag.
421 sub pkg_cancel_date {
423 my $cust_pkg = $self->cust_pkg or return;
424 return $cust_pkg->getfield('cancel') || '';
429 Returns a list consisting of:
430 - The name of this service (from part_svc)
431 - A meaningful identifier (username, domain, or mail alias)
432 - The table name (i.e. svc_domain) for this service
437 my($label, $value, $svcdb) = $cust_svc->label;
441 Like the B<label> method, except the second item in the list ("meaningful
442 identifier") may be longer - typically, a full name is included.
446 sub label { shift->_label('svc_label', @_); }
447 sub label_long { shift->_label('svc_label_long', @_); }
452 my $svc_x = $self->svc_x
453 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
455 $self->$method($svc_x);
458 sub svc_label { shift->_svc_label('label', @_); }
459 sub svc_label_long { shift->_svc_label('label_long', @_); }
462 my( $self, $method, $svc_x ) = ( shift, shift, shift );
464 my $identifier = $svc_x->$method(@_);
465 $identifier = '['.$self->agent_svcid.']'. $identifier if $self->agent_svcid;
468 $self->part_svc->svc,
470 $self->part_svc->svcdb,
478 Returns a listref of html elements associated with this service's exports.
484 my $svc_x = $self->svc_x
485 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
487 $svc_x->export_links;
490 =item export_getsettings
492 Returns two hashrefs of settings associated with this service's exports.
496 sub export_getsettings {
498 my $svc_x = $self->svc_x
499 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
501 $svc_x->export_getsettings;
507 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
508 FS::svc_domain object, etc.)
514 my $svcdb = $self->part_svc->svcdb;
515 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
516 $self->{'_svc_acct'};
518 require "FS/$svcdb.pm";
519 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
520 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
522 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
526 =item seconds_since TIMESTAMP
528 See L<FS::svc_acct/seconds_since>. Equivalent to
529 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
530 where B<svcdb> is not "svc_acct".
534 #internal session db deprecated (or at least on hold)
535 sub seconds_since { 'internal session db deprecated'; };
536 ##note: implementation here, POD in FS::svc_acct
538 # my($self, $since) = @_;
540 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
543 # AND logout IS NOT NULL'
544 # ) or die $dbh->errstr;
545 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
546 # $sth->fetchrow_arrayref->[0];
549 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
551 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
552 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
553 for records where B<svcdb> is not "svc_acct".
557 #note: implementation here, POD in FS::svc_acct
558 sub seconds_since_sqlradacct {
559 my($self, $start, $end) = @_;
561 my $mes = "$me seconds_since_sqlradacct:";
563 my $svc_x = $self->svc_x;
565 my @part_export = $self->part_svc->part_export_usage;
566 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
567 " service definition"
572 foreach my $part_export ( @part_export ) {
574 next if $part_export->option('ignore_accounting');
576 warn "$mes connecting to sqlradius database\n"
579 my $dbh = DBI->connect( map { $part_export->option($_) }
580 qw(datasrc username password) )
581 or die "can't connect to sqlradius database: ". $DBI::errstr;
583 warn "$mes connected to sqlradius database\n"
586 #select a unix time conversion function based on database type
587 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
589 my $username = $part_export->export_username($svc_x);
593 warn "$mes finding closed sessions completely within the given range\n"
598 if ($part_export->option('process_single_realm')) {
599 $realm = 'AND Realm = ?';
600 $realmparam = $part_export->option('realm');
603 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
607 AND $str2time AcctStartTime) >= ?
608 AND $str2time AcctStopTime ) < ?
609 AND $str2time AcctStopTime ) > 0
610 AND AcctStopTime IS NOT NULL"
611 ) or die $dbh->errstr;
612 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
614 my $regular = $sth->fetchrow_arrayref->[0];
616 warn "$mes finding open sessions which start in the range\n"
619 # count session start->range end
620 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
624 AND $str2time AcctStartTime ) >= ?
625 AND $str2time AcctStartTime ) < ?
626 AND ( ? - $str2time AcctStartTime ) ) < 86400
627 AND ( $str2time AcctStopTime ) = 0
628 OR AcctStopTime IS NULL )";
629 $sth = $dbh->prepare($query) or die $dbh->errstr;
632 ($realm ? $realmparam : ()),
636 or die $sth->errstr. " executing query $query";
637 my $start_during = $sth->fetchrow_arrayref->[0];
639 warn "$mes finding closed sessions which start before the range but stop during\n"
642 #count range start->session end
643 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
647 AND $str2time AcctStartTime ) < ?
648 AND $str2time AcctStopTime ) >= ?
649 AND $str2time AcctStopTime ) < ?
650 AND $str2time AcctStopTime ) > 0
651 AND AcctStopTime IS NOT NULL"
652 ) or die $dbh->errstr;
653 $sth->execute( $start,
655 ($realm ? $realmparam : ()),
660 my $end_during = $sth->fetchrow_arrayref->[0];
662 warn "$mes finding closed sessions which start before the range but stop after\n"
665 # count range start->range end
666 # don't count open sessions anymore (probably missing stop record)
667 $sth = $dbh->prepare("SELECT COUNT(*)
671 AND $str2time AcctStartTime ) < ?
672 AND ( $str2time AcctStopTime ) >= ?
674 # OR AcctStopTime = 0
675 # OR AcctStopTime IS NULL )"
676 ) or die $dbh->errstr;
677 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
679 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
681 $seconds += $regular + $end_during + $start_during + $entire_range;
683 warn "$mes done finding sessions\n"
692 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
694 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
695 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
696 for records where B<svcdb> is not "svc_acct".
700 #note: implementation here, POD in FS::svc_acct
701 #(false laziness w/seconds_since_sqlradacct above)
702 sub attribute_since_sqlradacct {
703 my($self, $start, $end, $attrib) = @_;
705 my $mes = "$me attribute_since_sqlradacct:";
707 my $svc_x = $self->svc_x;
709 my @part_export = $self->part_svc->part_export_usage;
710 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
711 " service definition"
717 foreach my $part_export ( @part_export ) {
719 next if $part_export->option('ignore_accounting');
721 warn "$mes connecting to sqlradius database\n"
724 my $dbh = DBI->connect( map { $part_export->option($_) }
725 qw(datasrc username password) )
726 or die "can't connect to sqlradius database: ". $DBI::errstr;
728 warn "$mes connected to sqlradius database\n"
731 #select a unix time conversion function based on database type
732 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
734 my $username = $part_export->export_username($svc_x);
736 warn "$mes SUMing $attrib sessions\n"
741 if ($part_export->option('process_single_realm')) {
742 $realm = 'AND Realm = ?';
743 $realmparam = $part_export->option('realm');
746 my $sth = $dbh->prepare("SELECT SUM($attrib)
750 AND $str2time AcctStopTime ) >= ?
751 AND $str2time AcctStopTime ) < ?
752 AND AcctStopTime IS NOT NULL"
753 ) or die $dbh->errstr;
754 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
757 my $row = $sth->fetchrow_arrayref;
758 $sum += $row->[0] if defined($row->[0]);
760 warn "$mes done SUMing sessions\n"
769 =item get_session_history TIMESTAMP_START TIMESTAMP_END
771 See L<FS::svc_acct/get_session_history>. Equivalent to
772 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
773 records where B<svcdb> is not "svc_acct".
777 sub get_session_history {
778 my($self, $start, $end, $attrib) = @_;
782 my @part_export = $self->part_svc->part_export_usage;
783 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
784 " service definition"
790 foreach my $part_export ( @part_export ) {
792 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
801 Returns an array of hashes representing the tickets linked to this service.
808 my $conf = FS::Conf->new;
809 my $num = $conf->config('cust_main-max_tickets') || 10;
812 if ( $conf->config('ticket_system') ) {
813 unless ( $conf->config('ticket_system-custom_priority_field') ) {
815 @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) };
819 foreach my $priority (
820 $conf->config('ticket_system-custom_priority_field-values'), ''
822 last if scalar(@tickets) >= $num;
824 @{ FS::TicketSystem->service_tickets( $self->svcnum,
825 $num - scalar(@tickets),
842 =item smart_search OPTION => VALUE ...
844 Accepts the option I<search>, the string to search for. The string will
845 be searched for as a username, email address, IP address, MAC address,
846 phone number, and hardware serial number. Unlike the I<smart_search> on
847 customers, this always requires an exact match.
851 # though perhaps it should be fuzzy in some cases?
854 my %param = __PACKAGE__->smart_search_param(@_);
858 sub smart_search_param {
862 my $string = $opt{'search'};
863 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
866 map { my $table = $_;
867 my $search_sql = "FS::$table"->search_sql($string);
869 AND 0 < ( SELECT COUNT(*) FROM $table
870 WHERE $table.svcnum = cust_svc.svcnum
875 FS::part_svc->svc_tables;
877 if ( $string =~ /^(\d+)$/ ) {
878 unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
881 my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
883 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
884 'null_right' => 'View/link unlinked services'
886 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
888 my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'.
889 ' LEFT JOIN cust_main USING ( custnum )'.
890 ' LEFT JOIN part_svc USING ( svcpart )';
893 'table' => 'cust_svc',
894 'addl_from' => $addl_from,
896 'extra_sql' => $extra_sql,
904 Behaviour of changing the svcpart of cust_svc records is undefined and should
905 possibly be prohibited, and pkg_svc records are not checked.
907 pkg_svc records are not checked in general (here).
909 Deleting this record doesn't check or delete the svc_* record associated
912 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
913 a DBI database handle is not yet implemented.
917 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
918 schema.html from the base documentation