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 #trigger a pkg_change export on pkgnum changes
276 if ( $new->pkgnum != $old->pkgnum ) {
277 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
281 $dbh->rollback if $oldAutoCommit;
282 return $error if $error;
286 #my $error = $new->SUPER::replace($old, @_);
287 my $error = $new->SUPER::replace($old);
289 $dbh->rollback if $oldAutoCommit;
290 return $error if $error;
293 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
300 Checks all fields to make sure this is a valid service. If there is an error,
301 returns the error, otherwise returns false. Called by the insert and
310 $self->ut_numbern('svcnum')
311 || $self->ut_numbern('pkgnum')
312 || $self->ut_number('svcpart')
313 || $self->ut_numbern('agent_svcid')
314 || $self->ut_numbern('overlimit')
316 return $error if $error;
318 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
319 return "Unknown svcpart" unless $part_svc;
321 if ( $self->pkgnum && ! $ignore_quantity ) {
322 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
323 return "Unknown pkgnum" unless $cust_pkg;
324 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
325 return "No svcpart ". $self->svcpart.
326 " services in pkgpart ". $cust_pkg->pkgpart
327 unless $part_svc || $ignore_quantity;
328 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
329 " services for pkgnum ". $self->pkgnum
330 if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ;
338 Returns the displayed service number for this service: agent_svcid if it has a
339 value, svcnum otherwise
345 $self->agent_svcid || $self->svcnum;
350 Returns the definition for this service, as a FS::part_svc object (see
358 ? $self->{'_svcpart'}
359 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
364 Returns the package this service belongs to, as a FS::cust_pkg object (see
371 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
376 Returns the pkg_svc record for for this service, if applicable.
382 my $cust_pkg = $self->cust_pkg;
383 return undef unless $cust_pkg;
385 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
386 'pkgpart' => $cust_pkg->pkgpart,
393 Returns the date this service was inserted.
399 $self->h_date('insert');
402 =item pkg_cancel_date
404 Returns the date this service's package was canceled. This normally only
405 exists for a service that's been preserved through cancellation with the
406 part_pkg.preserve flag.
410 sub pkg_cancel_date {
412 my $cust_pkg = $self->cust_pkg or return;
413 return $cust_pkg->getfield('cancel') || '';
418 Returns a list consisting of:
419 - The name of this service (from part_svc)
420 - A meaningful identifier (username, domain, or mail alias)
421 - The table name (i.e. svc_domain) for this service
426 my($label, $value, $svcdb) = $cust_svc->label;
430 Like the B<label> method, except the second item in the list ("meaningful
431 identifier") may be longer - typically, a full name is included.
435 sub label { shift->_label('svc_label', @_); }
436 sub label_long { shift->_label('svc_label_long', @_); }
441 my $svc_x = $self->svc_x
442 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
444 $self->$method($svc_x);
447 sub svc_label { shift->_svc_label('label', @_); }
448 sub svc_label_long { shift->_svc_label('label_long', @_); }
451 my( $self, $method, $svc_x ) = ( shift, shift, shift );
454 $self->part_svc->svc,
456 $self->part_svc->svcdb,
464 Returns a listref of html elements associated with this service's exports.
470 my $svc_x = $self->svc_x
471 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
473 $svc_x->export_links;
476 =item export_getsettings
478 Returns two hashrefs of settings associated with this service's exports.
482 sub export_getsettings {
484 my $svc_x = $self->svc_x
485 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
487 $svc_x->export_getsettings;
493 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
494 FS::svc_domain object, etc.)
500 my $svcdb = $self->part_svc->svcdb;
501 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
502 $self->{'_svc_acct'};
504 require "FS/$svcdb.pm";
505 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
506 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
508 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
512 =item seconds_since TIMESTAMP
514 See L<FS::svc_acct/seconds_since>. Equivalent to
515 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
516 where B<svcdb> is not "svc_acct".
520 #internal session db deprecated (or at least on hold)
521 sub seconds_since { 'internal session db deprecated'; };
522 ##note: implementation here, POD in FS::svc_acct
524 # my($self, $since) = @_;
526 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
529 # AND logout IS NOT NULL'
530 # ) or die $dbh->errstr;
531 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
532 # $sth->fetchrow_arrayref->[0];
535 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
537 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
538 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
539 for records where B<svcdb> is not "svc_acct".
543 #note: implementation here, POD in FS::svc_acct
544 sub seconds_since_sqlradacct {
545 my($self, $start, $end) = @_;
547 my $mes = "$me seconds_since_sqlradacct:";
549 my $svc_x = $self->svc_x;
551 my @part_export = $self->part_svc->part_export_usage;
552 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
553 " service definition"
558 foreach my $part_export ( @part_export ) {
560 next if $part_export->option('ignore_accounting');
562 warn "$mes connecting to sqlradius database\n"
565 my $dbh = DBI->connect( map { $part_export->option($_) }
566 qw(datasrc username password) )
567 or die "can't connect to sqlradius database: ". $DBI::errstr;
569 warn "$mes connected to sqlradius database\n"
572 #select a unix time conversion function based on database type
573 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
575 my $username = $part_export->export_username($svc_x);
579 warn "$mes finding closed sessions completely within the given range\n"
584 if ($part_export->option('process_single_realm')) {
585 $realm = 'AND Realm = ?';
586 $realmparam = $part_export->option('realm');
589 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
593 AND $str2time AcctStartTime) >= ?
594 AND $str2time AcctStopTime ) < ?
595 AND $str2time AcctStopTime ) > 0
596 AND AcctStopTime IS NOT NULL"
597 ) or die $dbh->errstr;
598 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
600 my $regular = $sth->fetchrow_arrayref->[0];
602 warn "$mes finding open sessions which start in the range\n"
605 # count session start->range end
606 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
610 AND $str2time AcctStartTime ) >= ?
611 AND $str2time AcctStartTime ) < ?
612 AND ( ? - $str2time AcctStartTime ) ) < 86400
613 AND ( $str2time AcctStopTime ) = 0
614 OR AcctStopTime IS NULL )";
615 $sth = $dbh->prepare($query) or die $dbh->errstr;
618 ($realm ? $realmparam : ()),
622 or die $sth->errstr. " executing query $query";
623 my $start_during = $sth->fetchrow_arrayref->[0];
625 warn "$mes finding closed sessions which start before the range but stop during\n"
628 #count range start->session end
629 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
633 AND $str2time AcctStartTime ) < ?
634 AND $str2time AcctStopTime ) >= ?
635 AND $str2time AcctStopTime ) < ?
636 AND $str2time AcctStopTime ) > 0
637 AND AcctStopTime IS NOT NULL"
638 ) or die $dbh->errstr;
639 $sth->execute( $start,
641 ($realm ? $realmparam : ()),
646 my $end_during = $sth->fetchrow_arrayref->[0];
648 warn "$mes finding closed sessions which start before the range but stop after\n"
651 # count range start->range end
652 # don't count open sessions anymore (probably missing stop record)
653 $sth = $dbh->prepare("SELECT COUNT(*)
657 AND $str2time AcctStartTime ) < ?
658 AND ( $str2time AcctStopTime ) >= ?
660 # OR AcctStopTime = 0
661 # OR AcctStopTime IS NULL )"
662 ) or die $dbh->errstr;
663 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
665 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
667 $seconds += $regular + $end_during + $start_during + $entire_range;
669 warn "$mes done finding sessions\n"
678 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
680 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
681 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
682 for records where B<svcdb> is not "svc_acct".
686 #note: implementation here, POD in FS::svc_acct
687 #(false laziness w/seconds_since_sqlradacct above)
688 sub attribute_since_sqlradacct {
689 my($self, $start, $end, $attrib) = @_;
691 my $mes = "$me attribute_since_sqlradacct:";
693 my $svc_x = $self->svc_x;
695 my @part_export = $self->part_svc->part_export_usage;
696 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
697 " service definition"
703 foreach my $part_export ( @part_export ) {
705 next if $part_export->option('ignore_accounting');
707 warn "$mes connecting to sqlradius database\n"
710 my $dbh = DBI->connect( map { $part_export->option($_) }
711 qw(datasrc username password) )
712 or die "can't connect to sqlradius database: ". $DBI::errstr;
714 warn "$mes connected to sqlradius database\n"
717 #select a unix time conversion function based on database type
718 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
720 my $username = $part_export->export_username($svc_x);
722 warn "$mes SUMing $attrib sessions\n"
727 if ($part_export->option('process_single_realm')) {
728 $realm = 'AND Realm = ?';
729 $realmparam = $part_export->option('realm');
732 my $sth = $dbh->prepare("SELECT SUM($attrib)
736 AND $str2time AcctStopTime ) >= ?
737 AND $str2time AcctStopTime ) < ?
738 AND AcctStopTime IS NOT NULL"
739 ) or die $dbh->errstr;
740 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
743 my $row = $sth->fetchrow_arrayref;
744 $sum += $row->[0] if defined($row->[0]);
746 warn "$mes done SUMing sessions\n"
755 =item get_session_history TIMESTAMP_START TIMESTAMP_END
757 See L<FS::svc_acct/get_session_history>. Equivalent to
758 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
759 records where B<svcdb> is not "svc_acct".
763 sub get_session_history {
764 my($self, $start, $end, $attrib) = @_;
768 my @part_export = $self->part_svc->part_export_usage;
769 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
770 " service definition"
776 foreach my $part_export ( @part_export ) {
778 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
791 =item smart_search OPTION => VALUE ...
793 Accepts the option I<search>, the string to search for. The string will
794 be searched for as a username, email address, IP address, MAC address,
795 phone number, and hardware serial number. Unlike the I<smart_search> on
796 customers, this always requires an exact match.
800 # though perhaps it should be fuzzy in some cases?
803 my %param = __PACKAGE__->smart_search_param(@_);
807 sub smart_search_param {
811 my $string = $opt{'search'};
812 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
815 map { my $table = $_;
816 my $search_sql = "FS::$table"->search_sql($string);
818 AND 0 < ( SELECT COUNT(*) FROM $table
819 WHERE $table.svcnum = cust_svc.svcnum
824 FS::part_svc->svc_tables;
826 if ( $string =~ /^(\d+)$/ ) {
827 unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
830 my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
832 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
833 'null_right' => 'View/link unlinked services'
835 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
837 my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'.
838 ' LEFT JOIN cust_main USING ( custnum )'.
839 ' LEFT JOIN part_svc USING ( svcpart )';
842 'table' => 'cust_svc',
843 'addl_from' => $addl_from,
845 'extra_sql' => $extra_sql,
853 Behaviour of changing the svcpart of cust_svc records is undefined and should
854 possibly be prohibited, and pkg_svc records are not checked.
856 pkg_svc records are not checked in general (here).
858 Deleting this record doesn't check or delete the svc_* record associated
861 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
862 a DBI database handle is not yet implemented.
866 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
867 schema.html from the base documentation