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;
137 my $error = $svc->cancel;
139 $dbh->rollback if $oldAutoCommit;
140 return "Error canceling service: $error";
142 $error = $svc->delete; #this deletes this cust_svc record as well
144 $dbh->rollback if $oldAutoCommit;
145 return "Error deleting service: $error";
151 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
152 "; deleting cust_svc only\n";
154 my $error = $self->delete;
156 $dbh->rollback if $oldAutoCommit;
157 return "Error deleting cust_svc: $error";
162 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
168 =item overlimit [ ACTION ]
170 Retrieves or sets the overlimit date. If ACTION is absent, return
171 the present value of overlimit. If ACTION is present, it can
172 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
173 is set to the current time if it is not already set. The 'unsuspend' value
174 causes the time to be cleared.
176 If there is an error on setting, returns the error, otherwise returns false.
182 my $action = shift or return $self->getfield('overlimit');
184 local $SIG{HUP} = 'IGNORE';
185 local $SIG{INT} = 'IGNORE';
186 local $SIG{QUIT} = 'IGNORE';
187 local $SIG{TERM} = 'IGNORE';
188 local $SIG{TSTP} = 'IGNORE';
189 local $SIG{PIPE} = 'IGNORE';
191 my $oldAutoCommit = $FS::UID::AutoCommit;
192 local $FS::UID::AutoCommit = 0;
195 if ( $action eq 'suspend' ) {
196 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
197 }elsif ( $action eq 'unsuspend' ) {
198 $self->setfield('overlimit', '');
200 die "unexpected action value: $action";
203 local $ignore_quantity = 1;
204 my $error = $self->replace;
206 $dbh->rollback if $oldAutoCommit;
207 return "Error setting overlimit: $error";
210 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
216 =item replace OLD_RECORD
218 Replaces the OLD_RECORD with this one in the database. If there is an error,
219 returns the error, otherwise returns false.
226 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
228 # : $new->replace_old;
229 my ( $new, $old ) = ( shift, shift );
230 $old = $new->replace_old unless defined($old);
232 local $SIG{HUP} = 'IGNORE';
233 local $SIG{INT} = 'IGNORE';
234 local $SIG{QUIT} = 'IGNORE';
235 local $SIG{TERM} = 'IGNORE';
236 local $SIG{TSTP} = 'IGNORE';
237 local $SIG{PIPE} = 'IGNORE';
239 my $oldAutoCommit = $FS::UID::AutoCommit;
240 local $FS::UID::AutoCommit = 0;
243 if ( $new->svcpart != $old->svcpart ) {
244 my $svc_x = $new->svc_x;
245 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
246 local($FS::Record::nowarn_identical) = 1;
247 my $error = $new_svc_x->replace($svc_x);
249 $dbh->rollback if $oldAutoCommit;
250 return $error if $error;
254 # #trigger a re-export on pkgnum changes?
255 # # (of prepaid packages), for Expiration RADIUS attribute
256 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
257 # my $svc_x = $new->svc_x;
258 # local($FS::Record::nowarn_identical) = 1;
259 # my $error = $svc_x->export('replace');
261 # $dbh->rollback if $oldAutoCommit;
262 # return $error if $error;
266 #my $error = $new->SUPER::replace($old, @_);
267 my $error = $new->SUPER::replace($old);
269 $dbh->rollback if $oldAutoCommit;
270 return $error if $error;
273 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
280 Checks all fields to make sure this is a valid service. If there is an error,
281 returns the error, otherwise returns false. Called by the insert and
290 $self->ut_numbern('svcnum')
291 || $self->ut_numbern('pkgnum')
292 || $self->ut_number('svcpart')
293 || $self->ut_numbern('overlimit')
295 return $error if $error;
297 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
298 return "Unknown svcpart" unless $part_svc;
300 if ( $self->pkgnum ) {
301 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
302 return "Unknown pkgnum" unless $cust_pkg;
303 my $pkg_svc = qsearchs( 'pkg_svc', {
304 'pkgpart' => $cust_pkg->pkgpart,
305 'svcpart' => $self->svcpart,
307 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
308 # 'svcpart' => $self->svcpart,
309 # 'quantity' => 0 } );
310 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
312 my @cust_svc = qsearch('cust_svc', {
313 'pkgnum' => $self->pkgnum,
314 'svcpart' => $self->svcpart,
316 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
317 " services for pkgnum ". $self->pkgnum
318 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
326 Returns the definition for this service, as a FS::part_svc object (see
334 ? $self->{'_svcpart'}
335 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
340 Returns the package this service belongs to, as a FS::cust_pkg object (see
347 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
352 Returns the pkg_svc record for for this service, if applicable.
358 my $cust_pkg = $self->cust_pkg;
359 return undef unless $cust_pkg;
361 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
362 'pkgpart' => $cust_pkg->pkgpart,
369 Returns the date this service was inserted.
375 $self->h_date('insert');
380 Returns a list consisting of:
381 - The name of this service (from part_svc)
382 - A meaningful identifier (username, domain, or mail alias)
383 - The table name (i.e. svc_domain) for this service
388 my($label, $value, $svcdb) = $cust_svc->label;
392 Like the B<label> method, except the second item in the list ("meaningful
393 identifier") may be longer - typically, a full name is included.
397 sub label { shift->_label('svc_label', @_); }
398 sub label_long { shift->_label('svc_label_long', @_); }
403 my $svc_x = $self->svc_x
404 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
406 $self->$method($svc_x);
409 sub svc_label { shift->_svc_label('label', @_); }
410 sub svc_label_long { shift->_svc_label('label_long', @_); }
413 my( $self, $method, $svc_x ) = ( shift, shift, shift );
416 $self->part_svc->svc,
418 $self->part_svc->svcdb,
426 Returns a listref of html elements associated with this service's exports.
432 my $svc_x = $self->svc_x
433 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
435 $svc_x->export_links;
438 =item export_getsettings
440 Returns two hashrefs of settings associated with this service's exports.
444 sub export_getsettings {
446 my $svc_x = $self->svc_x
447 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
449 $svc_x->export_getsettings;
455 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
456 FS::svc_domain object, etc.)
462 my $svcdb = $self->part_svc->svcdb;
463 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
464 $self->{'_svc_acct'};
466 require "FS/$svcdb.pm";
467 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
468 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
470 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
474 =item seconds_since TIMESTAMP
476 See L<FS::svc_acct/seconds_since>. Equivalent to
477 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
478 where B<svcdb> is not "svc_acct".
482 #note: implementation here, POD in FS::svc_acct
484 my($self, $since) = @_;
486 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
489 AND logout IS NOT NULL'
490 ) or die $dbh->errstr;
491 $sth->execute($self->svcnum, $since) or die $sth->errstr;
492 $sth->fetchrow_arrayref->[0];
495 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
497 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
498 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
499 for records where B<svcdb> is not "svc_acct".
503 #note: implementation here, POD in FS::svc_acct
504 sub seconds_since_sqlradacct {
505 my($self, $start, $end) = @_;
507 my $mes = "$me seconds_since_sqlradacct:";
509 my $svc_x = $self->svc_x;
511 my @part_export = $self->part_svc->part_export_usage;
512 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
513 " service definition"
518 foreach my $part_export ( @part_export ) {
520 next if $part_export->option('ignore_accounting');
522 warn "$mes connecting to sqlradius database\n"
525 my $dbh = DBI->connect( map { $part_export->option($_) }
526 qw(datasrc username password) )
527 or die "can't connect to sqlradius database: ". $DBI::errstr;
529 warn "$mes connected to sqlradius database\n"
532 #select a unix time conversion function based on database type
533 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
535 my $username = $part_export->export_username($svc_x);
539 warn "$mes finding closed sessions completely within the given range\n"
542 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
545 AND $str2time AcctStartTime) >= ?
546 AND $str2time AcctStopTime ) < ?
547 AND $str2time AcctStopTime ) > 0
548 AND AcctStopTime IS NOT NULL"
549 ) or die $dbh->errstr;
550 $sth->execute($username, $start, $end) or die $sth->errstr;
551 my $regular = $sth->fetchrow_arrayref->[0];
553 warn "$mes finding open sessions which start in the range\n"
556 # count session start->range end
557 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
560 AND $str2time AcctStartTime ) >= ?
561 AND $str2time AcctStartTime ) < ?
562 AND ( ? - $str2time AcctStartTime ) ) < 86400
563 AND ( $str2time AcctStopTime ) = 0
564 OR AcctStopTime IS NULL )";
565 $sth = $dbh->prepare($query) or die $dbh->errstr;
566 $sth->execute($end, $username, $start, $end, $end)
567 or die $sth->errstr. " executing query $query";
568 my $start_during = $sth->fetchrow_arrayref->[0];
570 warn "$mes finding closed sessions which start before the range but stop during\n"
573 #count range start->session end
574 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
577 AND $str2time AcctStartTime ) < ?
578 AND $str2time AcctStopTime ) >= ?
579 AND $str2time AcctStopTime ) < ?
580 AND $str2time AcctStopTime ) > 0
581 AND AcctStopTime IS NOT NULL"
582 ) or die $dbh->errstr;
583 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
584 my $end_during = $sth->fetchrow_arrayref->[0];
586 warn "$mes finding closed sessions which start before the range but stop after\n"
589 # count range start->range end
590 # don't count open sessions anymore (probably missing stop record)
591 $sth = $dbh->prepare("SELECT COUNT(*)
594 AND $str2time AcctStartTime ) < ?
595 AND ( $str2time AcctStopTime ) >= ?
597 # OR AcctStopTime = 0
598 # OR AcctStopTime IS NULL )"
599 ) or die $dbh->errstr;
600 $sth->execute($username, $start, $end ) or die $sth->errstr;
601 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
603 $seconds += $regular + $end_during + $start_during + $entire_range;
605 warn "$mes done finding sessions\n"
614 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
616 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
617 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
618 for records where B<svcdb> is not "svc_acct".
622 #note: implementation here, POD in FS::svc_acct
623 #(false laziness w/seconds_since_sqlradacct above)
624 sub attribute_since_sqlradacct {
625 my($self, $start, $end, $attrib) = @_;
627 my $mes = "$me attribute_since_sqlradacct:";
629 my $svc_x = $self->svc_x;
631 my @part_export = $self->part_svc->part_export_usage;
632 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
633 " service definition"
639 foreach my $part_export ( @part_export ) {
641 next if $part_export->option('ignore_accounting');
643 warn "$mes connecting to sqlradius database\n"
646 my $dbh = DBI->connect( map { $part_export->option($_) }
647 qw(datasrc username password) )
648 or die "can't connect to sqlradius database: ". $DBI::errstr;
650 warn "$mes connected to sqlradius database\n"
653 #select a unix time conversion function based on database type
654 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
656 my $username = $part_export->export_username($svc_x);
658 warn "$mes SUMing $attrib sessions\n"
661 my $sth = $dbh->prepare("SELECT SUM($attrib)
664 AND $str2time AcctStopTime ) >= ?
665 AND $str2time AcctStopTime ) < ?
666 AND AcctStopTime IS NOT NULL"
667 ) or die $dbh->errstr;
668 $sth->execute($username, $start, $end) or die $sth->errstr;
670 my $row = $sth->fetchrow_arrayref;
671 $sum += $row->[0] if defined($row->[0]);
673 warn "$mes done SUMing sessions\n"
682 =item get_session_history TIMESTAMP_START TIMESTAMP_END
684 See L<FS::svc_acct/get_session_history>. Equivalent to
685 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
686 records where B<svcdb> is not "svc_acct".
690 sub get_session_history {
691 my($self, $start, $end, $attrib) = @_;
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 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
712 =item get_cdrs_for_update
714 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
715 objects (see L<FS::cdr>) associated with this service.
717 CDRs are associated with svc_phone services via svc_phone.phonenum
721 sub get_cdrs_for_update {
723 $self->get_cdrs( 'freesidestatus' => '',
730 my($self, %options) = @_;
732 my @fields = ( 'charged_party' );
733 push @fields, 'src' unless $options{'disable_src'};
735 my $for_update = $options{'for_update'} ? 'FOR UPDATE' : '';
738 $hash{'freesidestatus'} = $options{'freesidestatus'}
739 if exists($options{'freesidestatus'});
741 #CDRs are associated with svc_phone services via svc_phone.phonenum
743 #return () unless $self->svc_x->isa('FS::svc_phone');
744 return () unless $self->part_svc->svcdb eq 'svc_phone';
745 my $number = $self->svc_x->phonenum;
747 my $prefix = $options{'default_prefix'};
749 my @orwhere = map " $_ = '$number' ", @fields;
750 push @orwhere, map " $_ = '$prefix$number' ", @fields
752 if ( $prefix =~ /^\+(\d+)$/ ) {
753 push @orwhere, map " $_ = '$1$number' ", @fields
756 my @where = ( ' ( '. join(' OR ', @orwhere ). ' ) ' );
758 if ( $options{'begin'} ) {
759 push @where, 'startdate >= '. $options{'begin'};
761 if ( $options{'end'} ) {
762 push @where, 'startdate < '. $options{'end'};
765 my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where );
771 'extra_sql' => $extra_sql,
772 'order_by' => "ORDER BY startdate $for_update",
782 Behaviour of changing the svcpart of cust_svc records is undefined and should
783 possibly be prohibited, and pkg_svc records are not checked.
785 pkg_svc records are not checked in general (here).
787 Deleting this record doesn't check or delete the svc_* record associated
790 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
791 a DBI database handle is not yet implemented.
795 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
796 schema.html from the base documentation