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.
105 Cancels the relevant service by calling the B<cancel> method of the associated
106 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
107 deleting the FS::svc_XXX record and then deleting this record.
109 If there is an error, returns the error, otherwise returns false.
116 local $SIG{HUP} = 'IGNORE';
117 local $SIG{INT} = 'IGNORE';
118 local $SIG{QUIT} = 'IGNORE';
119 local $SIG{TERM} = 'IGNORE';
120 local $SIG{TSTP} = 'IGNORE';
121 local $SIG{PIPE} = 'IGNORE';
123 my $oldAutoCommit = $FS::UID::AutoCommit;
124 local $FS::UID::AutoCommit = 0;
127 my $part_svc = $self->part_svc;
129 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
130 $dbh->rollback if $oldAutoCommit;
131 return "Illegal svcdb value in part_svc!";
134 require "FS/$svcdb.pm";
136 my $svc = $self->svc_x;
138 if ( %opt && $opt{'date'} ) {
139 my $error = $svc->expire($opt{'date'});
141 $dbh->rollback if $oldAutoCommit;
142 return "Error expiring service: $error";
145 my $error = $svc->cancel;
147 $dbh->rollback if $oldAutoCommit;
148 return "Error canceling service: $error";
150 $error = $svc->delete; #this deletes this cust_svc record as well
152 $dbh->rollback if $oldAutoCommit;
153 return "Error deleting service: $error";
160 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
161 "; deleting cust_svc only\n";
163 my $error = $self->delete;
165 $dbh->rollback if $oldAutoCommit;
166 return "Error deleting cust_svc: $error";
171 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
177 =item overlimit [ ACTION ]
179 Retrieves or sets the overlimit date. If ACTION is absent, return
180 the present value of overlimit. If ACTION is present, it can
181 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
182 is set to the current time if it is not already set. The 'unsuspend' value
183 causes the time to be cleared.
185 If there is an error on setting, returns the error, otherwise returns false.
191 my $action = shift or return $self->getfield('overlimit');
193 local $SIG{HUP} = 'IGNORE';
194 local $SIG{INT} = 'IGNORE';
195 local $SIG{QUIT} = 'IGNORE';
196 local $SIG{TERM} = 'IGNORE';
197 local $SIG{TSTP} = 'IGNORE';
198 local $SIG{PIPE} = 'IGNORE';
200 my $oldAutoCommit = $FS::UID::AutoCommit;
201 local $FS::UID::AutoCommit = 0;
204 if ( $action eq 'suspend' ) {
205 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
206 }elsif ( $action eq 'unsuspend' ) {
207 $self->setfield('overlimit', '');
209 die "unexpected action value: $action";
212 local $ignore_quantity = 1;
213 my $error = $self->replace;
215 $dbh->rollback if $oldAutoCommit;
216 return "Error setting overlimit: $error";
219 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
225 =item replace OLD_RECORD
227 Replaces the OLD_RECORD with this one in the database. If there is an error,
228 returns the error, otherwise returns false.
235 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
237 # : $new->replace_old;
238 my ( $new, $old ) = ( shift, shift );
239 $old = $new->replace_old unless defined($old);
241 local $SIG{HUP} = 'IGNORE';
242 local $SIG{INT} = 'IGNORE';
243 local $SIG{QUIT} = 'IGNORE';
244 local $SIG{TERM} = 'IGNORE';
245 local $SIG{TSTP} = 'IGNORE';
246 local $SIG{PIPE} = 'IGNORE';
248 my $oldAutoCommit = $FS::UID::AutoCommit;
249 local $FS::UID::AutoCommit = 0;
252 if ( $new->svcpart != $old->svcpart ) {
253 my $svc_x = $new->svc_x;
254 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
255 local($FS::Record::nowarn_identical) = 1;
256 my $error = $new_svc_x->replace($svc_x);
258 $dbh->rollback if $oldAutoCommit;
259 return $error if $error;
263 # #trigger a re-export on pkgnum changes?
264 # # (of prepaid packages), for Expiration RADIUS attribute
265 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
266 # my $svc_x = $new->svc_x;
267 # local($FS::Record::nowarn_identical) = 1;
268 # my $error = $svc_x->export('replace');
270 # $dbh->rollback if $oldAutoCommit;
271 # return $error if $error;
275 #my $error = $new->SUPER::replace($old, @_);
276 my $error = $new->SUPER::replace($old);
278 $dbh->rollback if $oldAutoCommit;
279 return $error if $error;
282 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
289 Checks all fields to make sure this is a valid service. If there is an error,
290 returns the error, otherwise returns false. Called by the insert and
299 $self->ut_numbern('svcnum')
300 || $self->ut_numbern('pkgnum')
301 || $self->ut_number('svcpart')
302 || $self->ut_numbern('agent_svcid')
303 || $self->ut_numbern('overlimit')
305 return $error if $error;
307 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
308 return "Unknown svcpart" unless $part_svc;
310 if ( $self->pkgnum ) {
311 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
312 return "Unknown pkgnum" unless $cust_pkg;
313 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
314 return "No svcpart ". $self->svcpart.
315 " services in pkgpart ". $cust_pkg->pkgpart
316 unless $part_svc || $ignore_quantity;
317 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
318 " services for pkgnum ". $self->pkgnum
319 if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ;
327 Returns the displayed service number for this service: agent_svcid if it has a
328 value, svcnum otherwise
334 $self->agent_svcid || $self->svcnum;
339 Returns the definition for this service, as a FS::part_svc object (see
347 ? $self->{'_svcpart'}
348 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
353 Returns the package this service belongs to, as a FS::cust_pkg object (see
360 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
365 Returns the pkg_svc record for for this service, if applicable.
371 my $cust_pkg = $self->cust_pkg;
372 return undef unless $cust_pkg;
374 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
375 'pkgpart' => $cust_pkg->pkgpart,
382 Returns the date this service was inserted.
388 $self->h_date('insert');
391 =item pkg_cancel_date
393 Returns the date this service's package was canceled. This normally only
394 exists for a service that's been preserved through cancellation with the
395 part_pkg.preserve flag.
399 sub pkg_cancel_date {
401 my $cust_pkg = $self->cust_pkg or return;
402 return $cust_pkg->getfield('cancel') || '';
407 Returns a list consisting of:
408 - The name of this service (from part_svc)
409 - A meaningful identifier (username, domain, or mail alias)
410 - The table name (i.e. svc_domain) for this service
415 my($label, $value, $svcdb) = $cust_svc->label;
419 Like the B<label> method, except the second item in the list ("meaningful
420 identifier") may be longer - typically, a full name is included.
424 sub label { shift->_label('svc_label', @_); }
425 sub label_long { shift->_label('svc_label_long', @_); }
430 my $svc_x = $self->svc_x
431 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
433 $self->$method($svc_x);
436 sub svc_label { shift->_svc_label('label', @_); }
437 sub svc_label_long { shift->_svc_label('label_long', @_); }
440 my( $self, $method, $svc_x ) = ( shift, shift, shift );
443 $self->part_svc->svc,
445 $self->part_svc->svcdb,
453 Returns a listref of html elements associated with this service's exports.
459 my $svc_x = $self->svc_x
460 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
462 $svc_x->export_links;
465 =item export_getsettings
467 Returns two hashrefs of settings associated with this service's exports.
471 sub export_getsettings {
473 my $svc_x = $self->svc_x
474 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
476 $svc_x->export_getsettings;
482 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
483 FS::svc_domain object, etc.)
489 my $svcdb = $self->part_svc->svcdb;
490 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
491 $self->{'_svc_acct'};
493 require "FS/$svcdb.pm";
494 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
495 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
497 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
501 =item seconds_since TIMESTAMP
503 See L<FS::svc_acct/seconds_since>. Equivalent to
504 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
505 where B<svcdb> is not "svc_acct".
509 #internal session db deprecated (or at least on hold)
510 sub seconds_since { 'internal session db deprecated'; };
511 ##note: implementation here, POD in FS::svc_acct
513 # my($self, $since) = @_;
515 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
518 # AND logout IS NOT NULL'
519 # ) or die $dbh->errstr;
520 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
521 # $sth->fetchrow_arrayref->[0];
524 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
526 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
527 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
528 for records where B<svcdb> is not "svc_acct".
532 #note: implementation here, POD in FS::svc_acct
533 sub seconds_since_sqlradacct {
534 my($self, $start, $end) = @_;
536 my $mes = "$me seconds_since_sqlradacct:";
538 my $svc_x = $self->svc_x;
540 my @part_export = $self->part_svc->part_export_usage;
541 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
542 " service definition"
547 foreach my $part_export ( @part_export ) {
549 next if $part_export->option('ignore_accounting');
551 warn "$mes connecting to sqlradius database\n"
554 my $dbh = DBI->connect( map { $part_export->option($_) }
555 qw(datasrc username password) )
556 or die "can't connect to sqlradius database: ". $DBI::errstr;
558 warn "$mes connected to sqlradius database\n"
561 #select a unix time conversion function based on database type
562 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
564 my $username = $part_export->export_username($svc_x);
568 warn "$mes finding closed sessions completely within the given range\n"
573 if ($part_export->option('process_single_realm')) {
574 $realm = 'AND Realm = ?';
575 $realmparam = $part_export->option('realm');
578 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
582 AND $str2time AcctStartTime) >= ?
583 AND $str2time AcctStopTime ) < ?
584 AND $str2time AcctStopTime ) > 0
585 AND AcctStopTime IS NOT NULL"
586 ) or die $dbh->errstr;
587 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
589 my $regular = $sth->fetchrow_arrayref->[0];
591 warn "$mes finding open sessions which start in the range\n"
594 # count session start->range end
595 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
599 AND $str2time AcctStartTime ) >= ?
600 AND $str2time AcctStartTime ) < ?
601 AND ( ? - $str2time AcctStartTime ) ) < 86400
602 AND ( $str2time AcctStopTime ) = 0
603 OR AcctStopTime IS NULL )";
604 $sth = $dbh->prepare($query) or die $dbh->errstr;
607 ($realm ? $realmparam : ()),
611 or die $sth->errstr. " executing query $query";
612 my $start_during = $sth->fetchrow_arrayref->[0];
614 warn "$mes finding closed sessions which start before the range but stop during\n"
617 #count range start->session end
618 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
622 AND $str2time AcctStartTime ) < ?
623 AND $str2time AcctStopTime ) >= ?
624 AND $str2time AcctStopTime ) < ?
625 AND $str2time AcctStopTime ) > 0
626 AND AcctStopTime IS NOT NULL"
627 ) or die $dbh->errstr;
628 $sth->execute( $start,
630 ($realm ? $realmparam : ()),
635 my $end_during = $sth->fetchrow_arrayref->[0];
637 warn "$mes finding closed sessions which start before the range but stop after\n"
640 # count range start->range end
641 # don't count open sessions anymore (probably missing stop record)
642 $sth = $dbh->prepare("SELECT COUNT(*)
646 AND $str2time AcctStartTime ) < ?
647 AND ( $str2time AcctStopTime ) >= ?
649 # OR AcctStopTime = 0
650 # OR AcctStopTime IS NULL )"
651 ) or die $dbh->errstr;
652 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
654 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
656 $seconds += $regular + $end_during + $start_during + $entire_range;
658 warn "$mes done finding sessions\n"
667 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
669 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
670 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
671 for records where B<svcdb> is not "svc_acct".
675 #note: implementation here, POD in FS::svc_acct
676 #(false laziness w/seconds_since_sqlradacct above)
677 sub attribute_since_sqlradacct {
678 my($self, $start, $end, $attrib) = @_;
680 my $mes = "$me attribute_since_sqlradacct:";
682 my $svc_x = $self->svc_x;
684 my @part_export = $self->part_svc->part_export_usage;
685 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
686 " service definition"
692 foreach my $part_export ( @part_export ) {
694 next if $part_export->option('ignore_accounting');
696 warn "$mes connecting to sqlradius database\n"
699 my $dbh = DBI->connect( map { $part_export->option($_) }
700 qw(datasrc username password) )
701 or die "can't connect to sqlradius database: ". $DBI::errstr;
703 warn "$mes connected to sqlradius database\n"
706 #select a unix time conversion function based on database type
707 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
709 my $username = $part_export->export_username($svc_x);
711 warn "$mes SUMing $attrib sessions\n"
716 if ($part_export->option('process_single_realm')) {
717 $realm = 'AND Realm = ?';
718 $realmparam = $part_export->option('realm');
721 my $sth = $dbh->prepare("SELECT SUM($attrib)
725 AND $str2time AcctStopTime ) >= ?
726 AND $str2time AcctStopTime ) < ?
727 AND AcctStopTime IS NOT NULL"
728 ) or die $dbh->errstr;
729 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
732 my $row = $sth->fetchrow_arrayref;
733 $sum += $row->[0] if defined($row->[0]);
735 warn "$mes done SUMing sessions\n"
744 =item get_session_history TIMESTAMP_START TIMESTAMP_END
746 See L<FS::svc_acct/get_session_history>. Equivalent to
747 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
748 records where B<svcdb> is not "svc_acct".
752 sub get_session_history {
753 my($self, $start, $end, $attrib) = @_;
757 my @part_export = $self->part_svc->part_export_usage;
758 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
759 " service definition"
765 foreach my $part_export ( @part_export ) {
767 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
780 =item smart_search OPTION => VALUE ...
782 Accepts the option I<search>, the string to search for. The string will
783 be searched for as a username, email address, IP address, MAC address,
784 phone number, and hardware serial number. Unlike the I<smart_search> on
785 customers, this always requires an exact match.
789 # though perhaps it should be fuzzy in some cases?
792 my %param = __PACKAGE__->smart_search_param(@_);
796 sub smart_search_param {
800 my $string = $opt{'search'};
801 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
804 map { my $table = $_;
805 my $search_sql = "FS::$table"->search_sql($string);
807 AND 0 < ( SELECT COUNT(*) FROM $table
808 WHERE $table.svcnum = cust_svc.svcnum
813 FS::part_svc->svc_tables;
815 if ( $string =~ /^(\d+)$/ ) {
816 unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
819 my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
821 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
822 'null_right' => 'View/link unlinked services'
824 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
826 my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'.
827 ' LEFT JOIN cust_main USING ( custnum )'.
828 ' LEFT JOIN part_svc USING ( svcpart )';
831 'table' => 'cust_svc',
832 'addl_from' => $addl_from,
834 'extra_sql' => $extra_sql,
842 Behaviour of changing the svcpart of cust_svc records is undefined and should
843 possibly be prohibited, and pkg_svc records are not checked.
845 pkg_svc records are not checked in general (here).
847 Deleting this record doesn't check or delete the svc_* record associated
850 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
851 a DBI database handle is not yet implemented.
855 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
856 schema.html from the base documentation