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
317 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
318 " services for pkgnum ". $self->pkgnum
319 if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
327 Returns the definition for this service, as a FS::part_svc object (see
335 ? $self->{'_svcpart'}
336 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
341 Returns the package this service belongs to, as a FS::cust_pkg object (see
348 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
353 Returns the pkg_svc record for for this service, if applicable.
359 my $cust_pkg = $self->cust_pkg;
360 return undef unless $cust_pkg;
362 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
363 'pkgpart' => $cust_pkg->pkgpart,
370 Returns the date this service was inserted.
376 $self->h_date('insert');
379 =item pkg_cancel_date
381 Returns the date this service's package was canceled. This normally only
382 exists for a service that's been preserved through cancellation with the
383 part_pkg.preserve flag.
387 sub pkg_cancel_date {
389 my $cust_pkg = $self->cust_pkg or return;
390 return $cust_pkg->getfield('cancel') || '';
395 Returns a list consisting of:
396 - The name of this service (from part_svc)
397 - A meaningful identifier (username, domain, or mail alias)
398 - The table name (i.e. svc_domain) for this service
403 my($label, $value, $svcdb) = $cust_svc->label;
407 Like the B<label> method, except the second item in the list ("meaningful
408 identifier") may be longer - typically, a full name is included.
412 sub label { shift->_label('svc_label', @_); }
413 sub label_long { shift->_label('svc_label_long', @_); }
418 my $svc_x = $self->svc_x
419 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
421 $self->$method($svc_x);
424 sub svc_label { shift->_svc_label('label', @_); }
425 sub svc_label_long { shift->_svc_label('label_long', @_); }
428 my( $self, $method, $svc_x ) = ( shift, shift, shift );
430 my $identifier = $svc_x->$method(@_);
431 $identifier = '['.$self->agent_svcid.']'. $identifier if $self->agent_svcid;
434 $self->part_svc->svc,
436 $self->part_svc->svcdb,
444 Returns a listref of html elements associated with this service's exports.
450 my $svc_x = $self->svc_x
451 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
453 $svc_x->export_links;
456 =item export_getsettings
458 Returns two hashrefs of settings associated with this service's exports.
462 sub export_getsettings {
464 my $svc_x = $self->svc_x
465 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
467 $svc_x->export_getsettings;
473 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
474 FS::svc_domain object, etc.)
480 my $svcdb = $self->part_svc->svcdb;
481 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
482 $self->{'_svc_acct'};
484 require "FS/$svcdb.pm";
485 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
486 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
488 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
492 =item seconds_since TIMESTAMP
494 See L<FS::svc_acct/seconds_since>. Equivalent to
495 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
496 where B<svcdb> is not "svc_acct".
500 #internal session db deprecated (or at least on hold)
501 sub seconds_since { 'internal session db deprecated'; };
502 ##note: implementation here, POD in FS::svc_acct
504 # my($self, $since) = @_;
506 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
509 # AND logout IS NOT NULL'
510 # ) or die $dbh->errstr;
511 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
512 # $sth->fetchrow_arrayref->[0];
515 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
517 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
518 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
519 for records where B<svcdb> is not "svc_acct".
523 #note: implementation here, POD in FS::svc_acct
524 sub seconds_since_sqlradacct {
525 my($self, $start, $end) = @_;
527 my $mes = "$me seconds_since_sqlradacct:";
529 my $svc_x = $self->svc_x;
531 my @part_export = $self->part_svc->part_export_usage;
532 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
533 " service definition"
538 foreach my $part_export ( @part_export ) {
540 next if $part_export->option('ignore_accounting');
542 warn "$mes connecting to sqlradius database\n"
545 my $dbh = DBI->connect( map { $part_export->option($_) }
546 qw(datasrc username password) )
547 or die "can't connect to sqlradius database: ". $DBI::errstr;
549 warn "$mes connected to sqlradius database\n"
552 #select a unix time conversion function based on database type
553 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
555 my $username = $part_export->export_username($svc_x);
559 warn "$mes finding closed sessions completely within the given range\n"
564 if ($part_export->option('process_single_realm')) {
565 $realm = 'AND Realm = ?';
566 $realmparam = $part_export->option('realm');
569 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
573 AND $str2time AcctStartTime) >= ?
574 AND $str2time AcctStopTime ) < ?
575 AND $str2time AcctStopTime ) > 0
576 AND AcctStopTime IS NOT NULL"
577 ) or die $dbh->errstr;
578 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
580 my $regular = $sth->fetchrow_arrayref->[0];
582 warn "$mes finding open sessions which start in the range\n"
585 # count session start->range end
586 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
590 AND $str2time AcctStartTime ) >= ?
591 AND $str2time AcctStartTime ) < ?
592 AND ( ? - $str2time AcctStartTime ) ) < 86400
593 AND ( $str2time AcctStopTime ) = 0
594 OR AcctStopTime IS NULL )";
595 $sth = $dbh->prepare($query) or die $dbh->errstr;
598 ($realm ? $realmparam : ()),
602 or die $sth->errstr. " executing query $query";
603 my $start_during = $sth->fetchrow_arrayref->[0];
605 warn "$mes finding closed sessions which start before the range but stop during\n"
608 #count range start->session end
609 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
613 AND $str2time AcctStartTime ) < ?
614 AND $str2time AcctStopTime ) >= ?
615 AND $str2time AcctStopTime ) < ?
616 AND $str2time AcctStopTime ) > 0
617 AND AcctStopTime IS NOT NULL"
618 ) or die $dbh->errstr;
619 $sth->execute( $start,
621 ($realm ? $realmparam : ()),
626 my $end_during = $sth->fetchrow_arrayref->[0];
628 warn "$mes finding closed sessions which start before the range but stop after\n"
631 # count range start->range end
632 # don't count open sessions anymore (probably missing stop record)
633 $sth = $dbh->prepare("SELECT COUNT(*)
637 AND $str2time AcctStartTime ) < ?
638 AND ( $str2time AcctStopTime ) >= ?
640 # OR AcctStopTime = 0
641 # OR AcctStopTime IS NULL )"
642 ) or die $dbh->errstr;
643 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
645 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
647 $seconds += $regular + $end_during + $start_during + $entire_range;
649 warn "$mes done finding sessions\n"
658 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
660 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
661 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
662 for records where B<svcdb> is not "svc_acct".
666 #note: implementation here, POD in FS::svc_acct
667 #(false laziness w/seconds_since_sqlradacct above)
668 sub attribute_since_sqlradacct {
669 my($self, $start, $end, $attrib) = @_;
671 my $mes = "$me attribute_since_sqlradacct:";
673 my $svc_x = $self->svc_x;
675 my @part_export = $self->part_svc->part_export_usage;
676 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
677 " service definition"
683 foreach my $part_export ( @part_export ) {
685 next if $part_export->option('ignore_accounting');
687 warn "$mes connecting to sqlradius database\n"
690 my $dbh = DBI->connect( map { $part_export->option($_) }
691 qw(datasrc username password) )
692 or die "can't connect to sqlradius database: ". $DBI::errstr;
694 warn "$mes connected to sqlradius database\n"
697 #select a unix time conversion function based on database type
698 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
700 my $username = $part_export->export_username($svc_x);
702 warn "$mes SUMing $attrib sessions\n"
707 if ($part_export->option('process_single_realm')) {
708 $realm = 'AND Realm = ?';
709 $realmparam = $part_export->option('realm');
712 my $sth = $dbh->prepare("SELECT SUM($attrib)
716 AND $str2time AcctStopTime ) >= ?
717 AND $str2time AcctStopTime ) < ?
718 AND AcctStopTime IS NOT NULL"
719 ) or die $dbh->errstr;
720 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
723 my $row = $sth->fetchrow_arrayref;
724 $sum += $row->[0] if defined($row->[0]);
726 warn "$mes done SUMing sessions\n"
735 =item get_session_history TIMESTAMP_START TIMESTAMP_END
737 See L<FS::svc_acct/get_session_history>. Equivalent to
738 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
739 records where B<svcdb> is not "svc_acct".
743 sub get_session_history {
744 my($self, $start, $end, $attrib) = @_;
748 my @part_export = $self->part_svc->part_export_usage;
749 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
750 " service definition"
756 foreach my $part_export ( @part_export ) {
758 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
771 =item smart_search OPTION => VALUE ...
773 Accepts the option I<search>, the string to search for. The string will
774 be searched for as a username, email address, IP address, MAC address,
775 phone number, and hardware serial number. Unlike the I<smart_search> on
776 customers, this always requires an exact match.
780 # though perhaps it should be fuzzy in some cases?
783 my %param = __PACKAGE__->smart_search_param(@_);
787 sub smart_search_param {
791 my $string = $opt{'search'};
792 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
795 map { my $table = $_;
796 my $search_sql = "FS::$table"->search_sql($string);
798 AND 0 < ( SELECT COUNT(*) FROM $table
799 WHERE $table.svcnum = cust_svc.svcnum
804 FS::part_svc->svc_tables;
806 if ( $string =~ /^(\d+)$/ ) {
807 unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
810 my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
812 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
813 'null_right' => 'View/link unlinked services'
815 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
817 my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'.
818 ' LEFT JOIN cust_main USING ( custnum )'.
819 ' LEFT JOIN part_svc USING ( svcpart )';
822 'table' => 'cust_svc',
823 'addl_from' => $addl_from,
825 'extra_sql' => $extra_sql,
833 Behaviour of changing the svcpart of cust_svc records is undefined and should
834 possibly be prohibited, and pkg_svc records are not checked.
836 pkg_svc records are not checked in general (here).
838 Deleting this record doesn't check or delete the svc_* record associated
841 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
842 a DBI database handle is not yet implemented.
846 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
847 schema.html from the base documentation