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 overlimit - date the service exceeded its usage limit
82 Creates a new service. To add the refund to the database, see L<"insert">.
83 Services are normally created by creating FS::svc_ objects (see
84 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
88 sub table { 'cust_svc'; }
92 Adds this service to the database. If there is an error, returns the error,
93 otherwise returns false.
97 Deletes this service from the database. If there is an error, returns the
98 error, otherwise returns false. Note that this only removes the cust_svc
99 record - you should probably use the B<cancel> method instead.
103 Cancels the relevant service by calling the B<cancel> method of the associated
104 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
105 deleting the FS::svc_XXX record and then deleting this record.
107 If there is an error, returns the error, otherwise returns false.
114 local $SIG{HUP} = 'IGNORE';
115 local $SIG{INT} = 'IGNORE';
116 local $SIG{QUIT} = 'IGNORE';
117 local $SIG{TERM} = 'IGNORE';
118 local $SIG{TSTP} = 'IGNORE';
119 local $SIG{PIPE} = 'IGNORE';
121 my $oldAutoCommit = $FS::UID::AutoCommit;
122 local $FS::UID::AutoCommit = 0;
125 my $part_svc = $self->part_svc;
127 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
128 $dbh->rollback if $oldAutoCommit;
129 return "Illegal svcdb value in part_svc!";
132 require "FS/$svcdb.pm";
134 my $svc = $self->svc_x;
136 if ( %opt && $opt{'date'} ) {
137 my $error = $svc->expire($opt{'date'});
139 $dbh->rollback if $oldAutoCommit;
140 return "Error expiring service: $error";
143 my $error = $svc->cancel;
145 $dbh->rollback if $oldAutoCommit;
146 return "Error canceling service: $error";
148 $error = $svc->delete; #this deletes this cust_svc record as well
150 $dbh->rollback if $oldAutoCommit;
151 return "Error deleting service: $error";
158 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
159 "; deleting cust_svc only\n";
161 my $error = $self->delete;
163 $dbh->rollback if $oldAutoCommit;
164 return "Error deleting cust_svc: $error";
169 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
175 =item overlimit [ ACTION ]
177 Retrieves or sets the overlimit date. If ACTION is absent, return
178 the present value of overlimit. If ACTION is present, it can
179 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
180 is set to the current time if it is not already set. The 'unsuspend' value
181 causes the time to be cleared.
183 If there is an error on setting, returns the error, otherwise returns false.
189 my $action = shift or return $self->getfield('overlimit');
191 local $SIG{HUP} = 'IGNORE';
192 local $SIG{INT} = 'IGNORE';
193 local $SIG{QUIT} = 'IGNORE';
194 local $SIG{TERM} = 'IGNORE';
195 local $SIG{TSTP} = 'IGNORE';
196 local $SIG{PIPE} = 'IGNORE';
198 my $oldAutoCommit = $FS::UID::AutoCommit;
199 local $FS::UID::AutoCommit = 0;
202 if ( $action eq 'suspend' ) {
203 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
204 }elsif ( $action eq 'unsuspend' ) {
205 $self->setfield('overlimit', '');
207 die "unexpected action value: $action";
210 local $ignore_quantity = 1;
211 my $error = $self->replace;
213 $dbh->rollback if $oldAutoCommit;
214 return "Error setting overlimit: $error";
217 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
223 =item replace OLD_RECORD
225 Replaces the OLD_RECORD with this one in the database. If there is an error,
226 returns the error, otherwise returns false.
233 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
235 # : $new->replace_old;
236 my ( $new, $old ) = ( shift, shift );
237 $old = $new->replace_old unless defined($old);
239 local $SIG{HUP} = 'IGNORE';
240 local $SIG{INT} = 'IGNORE';
241 local $SIG{QUIT} = 'IGNORE';
242 local $SIG{TERM} = 'IGNORE';
243 local $SIG{TSTP} = 'IGNORE';
244 local $SIG{PIPE} = 'IGNORE';
246 my $oldAutoCommit = $FS::UID::AutoCommit;
247 local $FS::UID::AutoCommit = 0;
250 if ( $new->svcpart != $old->svcpart ) {
251 my $svc_x = $new->svc_x;
252 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
253 local($FS::Record::nowarn_identical) = 1;
254 my $error = $new_svc_x->replace($svc_x);
256 $dbh->rollback if $oldAutoCommit;
257 return $error if $error;
261 # #trigger a re-export on pkgnum changes?
262 # # (of prepaid packages), for Expiration RADIUS attribute
263 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
264 # my $svc_x = $new->svc_x;
265 # local($FS::Record::nowarn_identical) = 1;
266 # my $error = $svc_x->export('replace');
268 # $dbh->rollback if $oldAutoCommit;
269 # return $error if $error;
273 #my $error = $new->SUPER::replace($old, @_);
274 my $error = $new->SUPER::replace($old);
276 $dbh->rollback if $oldAutoCommit;
277 return $error if $error;
280 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
287 Checks all fields to make sure this is a valid service. If there is an error,
288 returns the error, otherwise returns false. Called by the insert and
297 $self->ut_numbern('svcnum')
298 || $self->ut_numbern('pkgnum')
299 || $self->ut_number('svcpart')
300 || $self->ut_numbern('overlimit')
302 return $error if $error;
304 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
305 return "Unknown svcpart" unless $part_svc;
307 if ( $self->pkgnum ) {
308 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
309 return "Unknown pkgnum" unless $cust_pkg;
310 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
312 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
313 " services for pkgnum ". $self->pkgnum
314 if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
322 Returns the definition for this service, as a FS::part_svc object (see
330 ? $self->{'_svcpart'}
331 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
336 Returns the package this service belongs to, as a FS::cust_pkg object (see
343 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
348 Returns the pkg_svc record for for this service, if applicable.
354 my $cust_pkg = $self->cust_pkg;
355 return undef unless $cust_pkg;
357 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
358 'pkgpart' => $cust_pkg->pkgpart,
365 Returns the date this service was inserted.
371 $self->h_date('insert');
374 =item pkg_cancel_date
376 Returns the date this service's package was canceled. This normally only
377 exists for a service that's been preserved through cancellation with the
378 part_pkg.preserve flag.
382 sub pkg_cancel_date {
384 my $cust_pkg = $self->cust_pkg or return;
385 return $cust_pkg->getfield('cancel') || '';
390 Returns a list consisting of:
391 - The name of this service (from part_svc)
392 - A meaningful identifier (username, domain, or mail alias)
393 - The table name (i.e. svc_domain) for this service
398 my($label, $value, $svcdb) = $cust_svc->label;
402 Like the B<label> method, except the second item in the list ("meaningful
403 identifier") may be longer - typically, a full name is included.
407 sub label { shift->_label('svc_label', @_); }
408 sub label_long { shift->_label('svc_label_long', @_); }
413 my $svc_x = $self->svc_x
414 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
416 $self->$method($svc_x);
419 sub svc_label { shift->_svc_label('label', @_); }
420 sub svc_label_long { shift->_svc_label('label_long', @_); }
423 my( $self, $method, $svc_x ) = ( shift, shift, shift );
426 $self->part_svc->svc,
428 $self->part_svc->svcdb,
436 Returns a listref of html elements associated with this service's exports.
442 my $svc_x = $self->svc_x
443 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
445 $svc_x->export_links;
448 =item export_getsettings
450 Returns two hashrefs of settings associated with this service's exports.
454 sub export_getsettings {
456 my $svc_x = $self->svc_x
457 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
459 $svc_x->export_getsettings;
465 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
466 FS::svc_domain object, etc.)
472 my $svcdb = $self->part_svc->svcdb;
473 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
474 $self->{'_svc_acct'};
476 require "FS/$svcdb.pm";
477 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
478 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
480 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
484 =item seconds_since TIMESTAMP
486 See L<FS::svc_acct/seconds_since>. Equivalent to
487 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
488 where B<svcdb> is not "svc_acct".
492 #internal session db deprecated (or at least on hold)
493 sub seconds_since { 'internal session db deprecated'; };
494 ##note: implementation here, POD in FS::svc_acct
496 # my($self, $since) = @_;
498 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
501 # AND logout IS NOT NULL'
502 # ) or die $dbh->errstr;
503 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
504 # $sth->fetchrow_arrayref->[0];
507 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
509 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
510 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
511 for records where B<svcdb> is not "svc_acct".
515 #note: implementation here, POD in FS::svc_acct
516 sub seconds_since_sqlradacct {
517 my($self, $start, $end) = @_;
519 my $mes = "$me seconds_since_sqlradacct:";
521 my $svc_x = $self->svc_x;
523 my @part_export = $self->part_svc->part_export_usage;
524 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
525 " service definition"
530 foreach my $part_export ( @part_export ) {
532 next if $part_export->option('ignore_accounting');
534 warn "$mes connecting to sqlradius database\n"
537 my $dbh = DBI->connect( map { $part_export->option($_) }
538 qw(datasrc username password) )
539 or die "can't connect to sqlradius database: ". $DBI::errstr;
541 warn "$mes connected to sqlradius database\n"
544 #select a unix time conversion function based on database type
545 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
547 my $username = $part_export->export_username($svc_x);
551 warn "$mes finding closed sessions completely within the given range\n"
556 if ($part_export->option('process_single_realm')) {
557 $realm = 'AND Realm = ?';
558 $realmparam = $part_export->option('realm');
561 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
565 AND $str2time AcctStartTime) >= ?
566 AND $str2time AcctStopTime ) < ?
567 AND $str2time AcctStopTime ) > 0
568 AND AcctStopTime IS NOT NULL"
569 ) or die $dbh->errstr;
570 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
572 my $regular = $sth->fetchrow_arrayref->[0];
574 warn "$mes finding open sessions which start in the range\n"
577 # count session start->range end
578 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
582 AND $str2time AcctStartTime ) >= ?
583 AND $str2time AcctStartTime ) < ?
584 AND ( ? - $str2time AcctStartTime ) ) < 86400
585 AND ( $str2time AcctStopTime ) = 0
586 OR AcctStopTime IS NULL )";
587 $sth = $dbh->prepare($query) or die $dbh->errstr;
590 ($realm ? $realmparam : ()),
594 or die $sth->errstr. " executing query $query";
595 my $start_during = $sth->fetchrow_arrayref->[0];
597 warn "$mes finding closed sessions which start before the range but stop during\n"
600 #count range start->session end
601 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
605 AND $str2time AcctStartTime ) < ?
606 AND $str2time AcctStopTime ) >= ?
607 AND $str2time AcctStopTime ) < ?
608 AND $str2time AcctStopTime ) > 0
609 AND AcctStopTime IS NOT NULL"
610 ) or die $dbh->errstr;
611 $sth->execute( $start,
613 ($realm ? $realmparam : ()),
618 my $end_during = $sth->fetchrow_arrayref->[0];
620 warn "$mes finding closed sessions which start before the range but stop after\n"
623 # count range start->range end
624 # don't count open sessions anymore (probably missing stop record)
625 $sth = $dbh->prepare("SELECT COUNT(*)
629 AND $str2time AcctStartTime ) < ?
630 AND ( $str2time AcctStopTime ) >= ?
632 # OR AcctStopTime = 0
633 # OR AcctStopTime IS NULL )"
634 ) or die $dbh->errstr;
635 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
637 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
639 $seconds += $regular + $end_during + $start_during + $entire_range;
641 warn "$mes done finding sessions\n"
650 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
652 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
653 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
654 for records where B<svcdb> is not "svc_acct".
658 #note: implementation here, POD in FS::svc_acct
659 #(false laziness w/seconds_since_sqlradacct above)
660 sub attribute_since_sqlradacct {
661 my($self, $start, $end, $attrib) = @_;
663 my $mes = "$me attribute_since_sqlradacct:";
665 my $svc_x = $self->svc_x;
667 my @part_export = $self->part_svc->part_export_usage;
668 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
669 " service definition"
675 foreach my $part_export ( @part_export ) {
677 next if $part_export->option('ignore_accounting');
679 warn "$mes connecting to sqlradius database\n"
682 my $dbh = DBI->connect( map { $part_export->option($_) }
683 qw(datasrc username password) )
684 or die "can't connect to sqlradius database: ". $DBI::errstr;
686 warn "$mes connected to sqlradius database\n"
689 #select a unix time conversion function based on database type
690 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
692 my $username = $part_export->export_username($svc_x);
694 warn "$mes SUMing $attrib sessions\n"
699 if ($part_export->option('process_single_realm')) {
700 $realm = 'AND Realm = ?';
701 $realmparam = $part_export->option('realm');
704 my $sth = $dbh->prepare("SELECT SUM($attrib)
708 AND $str2time AcctStopTime ) >= ?
709 AND $str2time AcctStopTime ) < ?
710 AND AcctStopTime IS NOT NULL"
711 ) or die $dbh->errstr;
712 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
715 my $row = $sth->fetchrow_arrayref;
716 $sum += $row->[0] if defined($row->[0]);
718 warn "$mes done SUMing sessions\n"
727 =item get_session_history TIMESTAMP_START TIMESTAMP_END
729 See L<FS::svc_acct/get_session_history>. Equivalent to
730 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
731 records where B<svcdb> is not "svc_acct".
735 sub get_session_history {
736 my($self, $start, $end, $attrib) = @_;
740 my @part_export = $self->part_svc->part_export_usage;
741 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
742 " service definition"
748 foreach my $part_export ( @part_export ) {
750 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
761 Behaviour of changing the svcpart of cust_svc records is undefined and should
762 possibly be prohibited, and pkg_svc records are not checked.
764 pkg_svc records are not checked in general (here).
766 Deleting this record doesn't check or delete the svc_* record associated
769 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
770 a DBI database handle is not yet implemented.
774 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
775 schema.html from the base documentation