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;
311 return "No svcpart ". $self->svcpart.
312 " services in pkgpart ". $cust_pkg->pkgpart
314 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
315 " services for pkgnum ". $self->pkgnum
316 if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
324 Returns the definition for this service, as a FS::part_svc object (see
332 ? $self->{'_svcpart'}
333 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
338 Returns the package this service belongs to, as a FS::cust_pkg object (see
345 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
350 Returns the pkg_svc record for for this service, if applicable.
356 my $cust_pkg = $self->cust_pkg;
357 return undef unless $cust_pkg;
359 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
360 'pkgpart' => $cust_pkg->pkgpart,
367 Returns the date this service was inserted.
373 $self->h_date('insert');
376 =item pkg_cancel_date
378 Returns the date this service's package was canceled. This normally only
379 exists for a service that's been preserved through cancellation with the
380 part_pkg.preserve flag.
384 sub pkg_cancel_date {
386 my $cust_pkg = $self->cust_pkg or return;
387 return $cust_pkg->getfield('cancel') || '';
392 Returns a list consisting of:
393 - The name of this service (from part_svc)
394 - A meaningful identifier (username, domain, or mail alias)
395 - The table name (i.e. svc_domain) for this service
400 my($label, $value, $svcdb) = $cust_svc->label;
404 Like the B<label> method, except the second item in the list ("meaningful
405 identifier") may be longer - typically, a full name is included.
409 sub label { shift->_label('svc_label', @_); }
410 sub label_long { shift->_label('svc_label_long', @_); }
415 my $svc_x = $self->svc_x
416 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
418 $self->$method($svc_x);
421 sub svc_label { shift->_svc_label('label', @_); }
422 sub svc_label_long { shift->_svc_label('label_long', @_); }
425 my( $self, $method, $svc_x ) = ( shift, shift, shift );
428 $self->part_svc->svc,
430 $self->part_svc->svcdb,
438 Returns a listref of html elements associated with this service's exports.
444 my $svc_x = $self->svc_x
445 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
447 $svc_x->export_links;
450 =item export_getsettings
452 Returns two hashrefs of settings associated with this service's exports.
456 sub export_getsettings {
458 my $svc_x = $self->svc_x
459 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
461 $svc_x->export_getsettings;
467 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
468 FS::svc_domain object, etc.)
474 my $svcdb = $self->part_svc->svcdb;
475 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
476 $self->{'_svc_acct'};
478 require "FS/$svcdb.pm";
479 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
480 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
482 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
486 =item seconds_since TIMESTAMP
488 See L<FS::svc_acct/seconds_since>. Equivalent to
489 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
490 where B<svcdb> is not "svc_acct".
494 #internal session db deprecated (or at least on hold)
495 sub seconds_since { 'internal session db deprecated'; };
496 ##note: implementation here, POD in FS::svc_acct
498 # my($self, $since) = @_;
500 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
503 # AND logout IS NOT NULL'
504 # ) or die $dbh->errstr;
505 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
506 # $sth->fetchrow_arrayref->[0];
509 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
511 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
512 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
513 for records where B<svcdb> is not "svc_acct".
517 #note: implementation here, POD in FS::svc_acct
518 sub seconds_since_sqlradacct {
519 my($self, $start, $end) = @_;
521 my $mes = "$me seconds_since_sqlradacct:";
523 my $svc_x = $self->svc_x;
525 my @part_export = $self->part_svc->part_export_usage;
526 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
527 " service definition"
532 foreach my $part_export ( @part_export ) {
534 next if $part_export->option('ignore_accounting');
536 warn "$mes connecting to sqlradius database\n"
539 my $dbh = DBI->connect( map { $part_export->option($_) }
540 qw(datasrc username password) )
541 or die "can't connect to sqlradius database: ". $DBI::errstr;
543 warn "$mes connected to sqlradius database\n"
546 #select a unix time conversion function based on database type
547 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
549 my $username = $part_export->export_username($svc_x);
553 warn "$mes finding closed sessions completely within the given range\n"
558 if ($part_export->option('process_single_realm')) {
559 $realm = 'AND Realm = ?';
560 $realmparam = $part_export->option('realm');
563 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
567 AND $str2time AcctStartTime) >= ?
568 AND $str2time AcctStopTime ) < ?
569 AND $str2time AcctStopTime ) > 0
570 AND AcctStopTime IS NOT NULL"
571 ) or die $dbh->errstr;
572 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
574 my $regular = $sth->fetchrow_arrayref->[0];
576 warn "$mes finding open sessions which start in the range\n"
579 # count session start->range end
580 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
584 AND $str2time AcctStartTime ) >= ?
585 AND $str2time AcctStartTime ) < ?
586 AND ( ? - $str2time AcctStartTime ) ) < 86400
587 AND ( $str2time AcctStopTime ) = 0
588 OR AcctStopTime IS NULL )";
589 $sth = $dbh->prepare($query) or die $dbh->errstr;
592 ($realm ? $realmparam : ()),
596 or die $sth->errstr. " executing query $query";
597 my $start_during = $sth->fetchrow_arrayref->[0];
599 warn "$mes finding closed sessions which start before the range but stop during\n"
602 #count range start->session end
603 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
607 AND $str2time AcctStartTime ) < ?
608 AND $str2time AcctStopTime ) >= ?
609 AND $str2time AcctStopTime ) < ?
610 AND $str2time AcctStopTime ) > 0
611 AND AcctStopTime IS NOT NULL"
612 ) or die $dbh->errstr;
613 $sth->execute( $start,
615 ($realm ? $realmparam : ()),
620 my $end_during = $sth->fetchrow_arrayref->[0];
622 warn "$mes finding closed sessions which start before the range but stop after\n"
625 # count range start->range end
626 # don't count open sessions anymore (probably missing stop record)
627 $sth = $dbh->prepare("SELECT COUNT(*)
631 AND $str2time AcctStartTime ) < ?
632 AND ( $str2time AcctStopTime ) >= ?
634 # OR AcctStopTime = 0
635 # OR AcctStopTime IS NULL )"
636 ) or die $dbh->errstr;
637 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
639 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
641 $seconds += $regular + $end_during + $start_during + $entire_range;
643 warn "$mes done finding sessions\n"
652 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
654 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
655 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
656 for records where B<svcdb> is not "svc_acct".
660 #note: implementation here, POD in FS::svc_acct
661 #(false laziness w/seconds_since_sqlradacct above)
662 sub attribute_since_sqlradacct {
663 my($self, $start, $end, $attrib) = @_;
665 my $mes = "$me attribute_since_sqlradacct:";
667 my $svc_x = $self->svc_x;
669 my @part_export = $self->part_svc->part_export_usage;
670 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
671 " service definition"
677 foreach my $part_export ( @part_export ) {
679 next if $part_export->option('ignore_accounting');
681 warn "$mes connecting to sqlradius database\n"
684 my $dbh = DBI->connect( map { $part_export->option($_) }
685 qw(datasrc username password) )
686 or die "can't connect to sqlradius database: ". $DBI::errstr;
688 warn "$mes connected to sqlradius database\n"
691 #select a unix time conversion function based on database type
692 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
694 my $username = $part_export->export_username($svc_x);
696 warn "$mes SUMing $attrib sessions\n"
701 if ($part_export->option('process_single_realm')) {
702 $realm = 'AND Realm = ?';
703 $realmparam = $part_export->option('realm');
706 my $sth = $dbh->prepare("SELECT SUM($attrib)
710 AND $str2time AcctStopTime ) >= ?
711 AND $str2time AcctStopTime ) < ?
712 AND AcctStopTime IS NOT NULL"
713 ) or die $dbh->errstr;
714 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
717 my $row = $sth->fetchrow_arrayref;
718 $sum += $row->[0] if defined($row->[0]);
720 warn "$mes done SUMing sessions\n"
729 =item get_session_history TIMESTAMP_START TIMESTAMP_END
731 See L<FS::svc_acct/get_session_history>. Equivalent to
732 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
733 records where B<svcdb> is not "svc_acct".
737 sub get_session_history {
738 my($self, $start, $end, $attrib) = @_;
742 my @part_export = $self->part_svc->part_export_usage;
743 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
744 " service definition"
750 foreach my $part_export ( @part_export ) {
752 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
763 Behaviour of changing the svcpart of cust_svc records is undefined and should
764 possibly be prohibited, and pkg_svc records are not checked.
766 pkg_svc records are not checked in general (here).
768 Deleting this record doesn't check or delete the svc_* record associated
771 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
772 a DBI database handle is not yet implemented.
776 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
777 schema.html from the base documentation