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 #my $error = $new->SUPER::replace($old, @_);
255 my $error = $new->SUPER::replace($old);
257 $dbh->rollback if $oldAutoCommit;
258 return $error if $error;
261 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
268 Checks all fields to make sure this is a valid service. If there is an error,
269 returns the error, otherwise returns false. Called by the insert and
278 $self->ut_numbern('svcnum')
279 || $self->ut_numbern('pkgnum')
280 || $self->ut_number('svcpart')
281 || $self->ut_numbern('overlimit')
283 return $error if $error;
285 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
286 return "Unknown svcpart" unless $part_svc;
288 if ( $self->pkgnum ) {
289 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
290 return "Unknown pkgnum" unless $cust_pkg;
291 my $pkg_svc = qsearchs( 'pkg_svc', {
292 'pkgpart' => $cust_pkg->pkgpart,
293 'svcpart' => $self->svcpart,
295 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
296 # 'svcpart' => $self->svcpart,
297 # 'quantity' => 0 } );
298 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
300 my @cust_svc = qsearch('cust_svc', {
301 'pkgnum' => $self->pkgnum,
302 'svcpart' => $self->svcpart,
304 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
305 " services for pkgnum ". $self->pkgnum
306 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
314 Returns the definition for this service, as a FS::part_svc object (see
322 ? $self->{'_svcpart'}
323 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
328 Returns the package this service belongs to, as a FS::cust_pkg object (see
335 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
340 Returns the pkg_svc record for for this service, if applicable.
346 my $cust_pkg = $self->cust_pkg;
347 return undef unless $cust_pkg;
349 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
350 'pkgpart' => $cust_pkg->pkgpart,
357 Returns the date this service was inserted.
363 $self->h_date('insert');
368 Returns a list consisting of:
369 - The name of this service (from part_svc)
370 - A meaningful identifier (username, domain, or mail alias)
371 - The table name (i.e. svc_domain) for this service
376 my($label, $value, $svcdb) = $cust_svc->label;
380 Like the B<label> method, except the second item in the list ("meaningful
381 identifier") may be longer - typically, a full name is included.
385 sub label { shift->_label('svc_label', @_); }
386 sub label_long { shift->_label('svc_label_long', @_); }
391 my $svc_x = $self->svc_x
392 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
394 $self->$method($svc_x);
397 sub svc_label { shift->_svc_label('label', @_); }
398 sub svc_label_long { shift->_svc_label('label_long', @_); }
401 my( $self, $method, $svc_x ) = ( shift, shift, shift );
404 $self->part_svc->svc,
406 $self->part_svc->svcdb,
414 Returns a list of html elements associated with this services exports.
420 my $svc_x = $self->svc_x
421 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
423 $svc_x->export_links;
428 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
429 FS::svc_domain object, etc.)
435 my $svcdb = $self->part_svc->svcdb;
436 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
437 $self->{'_svc_acct'};
439 require "FS/$svcdb.pm";
440 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
441 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
443 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
447 =item seconds_since TIMESTAMP
449 See L<FS::svc_acct/seconds_since>. Equivalent to
450 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
451 where B<svcdb> is not "svc_acct".
455 #note: implementation here, POD in FS::svc_acct
457 my($self, $since) = @_;
459 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
462 AND logout IS NOT NULL'
463 ) or die $dbh->errstr;
464 $sth->execute($self->svcnum, $since) or die $sth->errstr;
465 $sth->fetchrow_arrayref->[0];
468 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
470 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
471 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
472 for records where B<svcdb> is not "svc_acct".
476 #note: implementation here, POD in FS::svc_acct
477 sub seconds_since_sqlradacct {
478 my($self, $start, $end) = @_;
480 my $mes = "$me seconds_since_sqlradacct:";
482 my $svc_x = $self->svc_x;
484 my @part_export = $self->part_svc->part_export_usage;
485 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
486 " service definition"
491 foreach my $part_export ( @part_export ) {
493 next if $part_export->option('ignore_accounting');
495 warn "$mes connecting to sqlradius database\n"
498 my $dbh = DBI->connect( map { $part_export->option($_) }
499 qw(datasrc username password) )
500 or die "can't connect to sqlradius database: ". $DBI::errstr;
502 warn "$mes connected to sqlradius database\n"
505 #select a unix time conversion function based on database type
506 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
508 my $username = $part_export->export_username($svc_x);
512 warn "$mes finding closed sessions completely within the given range\n"
515 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
518 AND $str2time AcctStartTime) >= ?
519 AND $str2time AcctStopTime ) < ?
520 AND $str2time AcctStopTime ) > 0
521 AND AcctStopTime IS NOT NULL"
522 ) or die $dbh->errstr;
523 $sth->execute($username, $start, $end) or die $sth->errstr;
524 my $regular = $sth->fetchrow_arrayref->[0];
526 warn "$mes finding open sessions which start in the range\n"
529 # count session start->range end
530 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
533 AND $str2time AcctStartTime ) >= ?
534 AND $str2time AcctStartTime ) < ?
535 AND ( ? - $str2time AcctStartTime ) ) < 86400
536 AND ( $str2time AcctStopTime ) = 0
537 OR AcctStopTime IS NULL )";
538 $sth = $dbh->prepare($query) or die $dbh->errstr;
539 $sth->execute($end, $username, $start, $end, $end)
540 or die $sth->errstr. " executing query $query";
541 my $start_during = $sth->fetchrow_arrayref->[0];
543 warn "$mes finding closed sessions which start before the range but stop during\n"
546 #count range start->session end
547 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
550 AND $str2time AcctStartTime ) < ?
551 AND $str2time AcctStopTime ) >= ?
552 AND $str2time AcctStopTime ) < ?
553 AND $str2time AcctStopTime ) > 0
554 AND AcctStopTime IS NOT NULL"
555 ) or die $dbh->errstr;
556 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
557 my $end_during = $sth->fetchrow_arrayref->[0];
559 warn "$mes finding closed sessions which start before the range but stop after\n"
562 # count range start->range end
563 # don't count open sessions anymore (probably missing stop record)
564 $sth = $dbh->prepare("SELECT COUNT(*)
567 AND $str2time AcctStartTime ) < ?
568 AND ( $str2time AcctStopTime ) >= ?
570 # OR AcctStopTime = 0
571 # OR AcctStopTime IS NULL )"
572 ) or die $dbh->errstr;
573 $sth->execute($username, $start, $end ) or die $sth->errstr;
574 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
576 $seconds += $regular + $end_during + $start_during + $entire_range;
578 warn "$mes done finding sessions\n"
587 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
589 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
590 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
591 for records where B<svcdb> is not "svc_acct".
595 #note: implementation here, POD in FS::svc_acct
596 #(false laziness w/seconds_since_sqlradacct above)
597 sub attribute_since_sqlradacct {
598 my($self, $start, $end, $attrib) = @_;
600 my $mes = "$me attribute_since_sqlradacct:";
602 my $svc_x = $self->svc_x;
604 my @part_export = $self->part_svc->part_export_usage;
605 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
606 " service definition"
612 foreach my $part_export ( @part_export ) {
614 next if $part_export->option('ignore_accounting');
616 warn "$mes connecting to sqlradius database\n"
619 my $dbh = DBI->connect( map { $part_export->option($_) }
620 qw(datasrc username password) )
621 or die "can't connect to sqlradius database: ". $DBI::errstr;
623 warn "$mes connected to sqlradius database\n"
626 #select a unix time conversion function based on database type
627 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
629 my $username = $part_export->export_username($svc_x);
631 warn "$mes SUMing $attrib sessions\n"
634 my $sth = $dbh->prepare("SELECT SUM($attrib)
637 AND $str2time AcctStopTime ) >= ?
638 AND $str2time AcctStopTime ) < ?
639 AND AcctStopTime IS NOT NULL"
640 ) or die $dbh->errstr;
641 $sth->execute($username, $start, $end) or die $sth->errstr;
643 my $row = $sth->fetchrow_arrayref;
644 $sum += $row->[0] if defined($row->[0]);
646 warn "$mes done SUMing sessions\n"
655 =item get_session_history TIMESTAMP_START TIMESTAMP_END
657 See L<FS::svc_acct/get_session_history>. Equivalent to
658 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
659 records where B<svcdb> is not "svc_acct".
663 sub get_session_history {
664 my($self, $start, $end, $attrib) = @_;
668 my @part_export = $self->part_svc->part_export_usage;
669 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
670 " service definition"
676 foreach my $part_export ( @part_export ) {
678 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
685 =item get_cdrs_for_update
687 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
688 objects (see L<FS::cdr>) associated with this service.
690 CDRs are associated with svc_phone services via svc_phone.phonenum
694 sub get_cdrs_for_update {
696 $self->get_cdrs( 'freesidestatus' => '',
703 my($self, %options) = @_;
705 my @fields = ( 'charged_party' );
706 push @fields, 'src' unless $options{'disable_src'};
708 my $for_update = $options{'for_update'} ? 'FOR UPDATE' : '';
711 $hash{'freesidestatus'} = $options{'freesidestatus'}
712 if exists($options{'freesidestatus'});
714 #CDRs are associated with svc_phone services via svc_phone.phonenum
716 #return () unless $self->svc_x->isa('FS::svc_phone');
717 return () unless $self->part_svc->svcdb eq 'svc_phone';
718 my $number = $self->svc_x->phonenum;
720 my $prefix = $options{'default_prefix'};
722 my @orwhere = map " $_ = '$number' ", @fields;
723 push @orwhere, map " $_ = '$prefix$number' ", @fields
725 if ( $prefix =~ /^\+(\d+)$/ ) {
726 push @orwhere, map " $_ = '$1$number' ", @fields
729 my @where = ( ' ( '. join(' OR ', @orwhere ). ' ) ' );
731 if ( $options{'begin'} ) {
732 push @where, 'startdate >= '. $options{'begin'};
734 if ( $options{'end'} ) {
735 push @where, 'startdate < '. $options{'end'};
738 my $extra_sql = ( keys(%hash) ? ' AND ' : ' WHERE ' ). join(' AND ', @where );
744 'extra_sql' => $extra_sql,
745 'order_by' => "ORDER BY startdate $for_update",
755 Behaviour of changing the svcpart of cust_svc records is undefined and should
756 possibly be prohibited, and pkg_svc records are not checked.
758 pkg_svc records are not checked in general (here).
760 Deleting this record doesn't check or delete the svc_* record associated
763 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
764 a DBI database handle is not yet implemented.
768 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
769 schema.html from the base documentation