4 use vars qw( @ISA $DEBUG $me $ignore_quantity );
7 use FS::Record qw( qsearch qsearchs dbh str2time_sql );
12 use FS::domain_record;
16 #most FS::svc_ classes are autoloaded in svc_x emthod
17 use FS::svc_acct; #this one is used in the cache stuff
19 @ISA = qw( FS::cust_main_Mixin FS::Record );
28 my ( $hashref, $cache ) = @_;
29 if ( $hashref->{'username'} ) {
30 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
32 if ( $hashref->{'svc'} ) {
33 $self->{'_svcpart'} = FS::part_svc->new($hashref);
39 FS::cust_svc - Object method for cust_svc objects
45 $record = new FS::cust_svc \%hash
46 $record = new FS::cust_svc { 'column' => 'value' };
48 $error = $record->insert;
50 $error = $new_record->replace($old_record);
52 $error = $record->delete;
54 $error = $record->check;
56 ($label, $value) = $record->label;
60 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
61 The following fields are currently supported:
65 =item svcnum - primary key (assigned automatically for new services)
67 =item pkgnum - Package (see L<FS::cust_pkg>)
69 =item svcpart - Service definition (see L<FS::part_svc>)
71 =item overlimit - date the service exceeded its usage limit
81 Creates a new service. To add the refund to the database, see L<"insert">.
82 Services are normally created by creating FS::svc_ objects (see
83 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
87 sub table { 'cust_svc'; }
91 Adds this service to the database. If there is an error, returns the error,
92 otherwise returns false.
96 Deletes this service from the database. If there is an error, returns the
97 error, otherwise returns false. Note that this only removes the cust_svc
98 record - you should probably use the B<cancel> method instead.
102 Cancels the relevant service by calling the B<cancel> method of the associated
103 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
104 deleting the FS::svc_XXX record and then deleting this record.
106 If there is an error, returns the error, otherwise returns false.
113 local $SIG{HUP} = 'IGNORE';
114 local $SIG{INT} = 'IGNORE';
115 local $SIG{QUIT} = 'IGNORE';
116 local $SIG{TERM} = 'IGNORE';
117 local $SIG{TSTP} = 'IGNORE';
118 local $SIG{PIPE} = 'IGNORE';
120 my $oldAutoCommit = $FS::UID::AutoCommit;
121 local $FS::UID::AutoCommit = 0;
124 my $part_svc = $self->part_svc;
126 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
127 $dbh->rollback if $oldAutoCommit;
128 return "Illegal svcdb value in part_svc!";
131 require "FS/$svcdb.pm";
133 my $svc = $self->svc_x;
136 my $error = $svc->cancel;
138 $dbh->rollback if $oldAutoCommit;
139 return "Error canceling service: $error";
141 $error = $svc->delete; #this deletes this cust_svc record as well
143 $dbh->rollback if $oldAutoCommit;
144 return "Error deleting service: $error";
150 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
151 "; deleting cust_svc only\n";
153 my $error = $self->delete;
155 $dbh->rollback if $oldAutoCommit;
156 return "Error deleting cust_svc: $error";
161 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
167 =item overlimit [ ACTION ]
169 Retrieves or sets the overlimit date. If ACTION is absent, return
170 the present value of overlimit. If ACTION is present, it can
171 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
172 is set to the current time if it is not already set. The 'unsuspend' value
173 causes the time to be cleared.
175 If there is an error on setting, returns the error, otherwise returns false.
181 my $action = shift or return $self->getfield('overlimit');
183 local $SIG{HUP} = 'IGNORE';
184 local $SIG{INT} = 'IGNORE';
185 local $SIG{QUIT} = 'IGNORE';
186 local $SIG{TERM} = 'IGNORE';
187 local $SIG{TSTP} = 'IGNORE';
188 local $SIG{PIPE} = 'IGNORE';
190 my $oldAutoCommit = $FS::UID::AutoCommit;
191 local $FS::UID::AutoCommit = 0;
194 if ( $action eq 'suspend' ) {
195 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
196 }elsif ( $action eq 'unsuspend' ) {
197 $self->setfield('overlimit', '');
199 die "unexpected action value: $action";
202 local $ignore_quantity = 1;
203 my $error = $self->replace;
205 $dbh->rollback if $oldAutoCommit;
206 return "Error setting overlimit: $error";
209 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
215 =item replace OLD_RECORD
217 Replaces the OLD_RECORD with this one in the database. If there is an error,
218 returns the error, otherwise returns false.
223 my ( $new, $old ) = ( shift, shift );
225 local $SIG{HUP} = 'IGNORE';
226 local $SIG{INT} = 'IGNORE';
227 local $SIG{QUIT} = 'IGNORE';
228 local $SIG{TERM} = 'IGNORE';
229 local $SIG{TSTP} = 'IGNORE';
230 local $SIG{PIPE} = 'IGNORE';
232 my $oldAutoCommit = $FS::UID::AutoCommit;
233 local $FS::UID::AutoCommit = 0;
236 $old = $new->replace_old unless defined($old);
238 if ( $new->svcpart != $old->svcpart ) {
239 my $svc_x = $new->svc_x;
240 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
241 local($FS::Record::nowarn_identical) = 1;
242 my $error = $new_svc_x->replace($svc_x);
244 $dbh->rollback if $oldAutoCommit;
245 return $error if $error;
249 my $error = $new->SUPER::replace($old);
251 $dbh->rollback if $oldAutoCommit;
252 return $error if $error;
255 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
262 Checks all fields to make sure this is a valid service. If there is an error,
263 returns the error, otherwise returns false. Called by the insert and
272 $self->ut_numbern('svcnum')
273 || $self->ut_numbern('pkgnum')
274 || $self->ut_number('svcpart')
275 || $self->ut_numbern('overlimit')
277 return $error if $error;
279 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
280 return "Unknown svcpart" unless $part_svc;
282 if ( $self->pkgnum ) {
283 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
284 return "Unknown pkgnum" unless $cust_pkg;
285 my $pkg_svc = qsearchs( 'pkg_svc', {
286 'pkgpart' => $cust_pkg->pkgpart,
287 'svcpart' => $self->svcpart,
289 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
290 # 'svcpart' => $self->svcpart,
291 # 'quantity' => 0 } );
292 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
294 my @cust_svc = qsearch('cust_svc', {
295 'pkgnum' => $self->pkgnum,
296 'svcpart' => $self->svcpart,
298 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
299 " services for pkgnum ". $self->pkgnum
300 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
308 Returns the definition for this service, as a FS::part_svc object (see
316 ? $self->{'_svcpart'}
317 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
322 Returns the package this service belongs to, as a FS::cust_pkg object (see
329 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
334 Returns the pkg_svc record for for this service, if applicable.
340 my $cust_pkg = $self->cust_pkg;
341 return undef unless $cust_pkg;
343 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
344 'pkgpart' => $cust_pkg->pkgpart,
351 Returns the date this service was inserted.
357 $self->h_date('insert');
362 Returns a list consisting of:
363 - The name of this service (from part_svc)
364 - A meaningful identifier (username, domain, or mail alias)
365 - The table name (i.e. svc_domain) for this service
370 my($label, $value, $svcdb) = $cust_svc->label;
376 carp "FS::cust_svc::label called on $self" if $DEBUG;
377 my $svc_x = $self->svc_x
378 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
380 $self->_svc_label($svc_x);
384 my( $self, $svc_x ) = ( shift, shift );
387 $self->part_svc->svc,
389 $self->part_svc->svcdb,
397 Returns a list of html elements associated with this services exports.
403 my $svc_x = $self->svc_x
404 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
406 $svc_x->export_links;
411 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
412 FS::svc_domain object, etc.)
418 my $svcdb = $self->part_svc->svcdb;
419 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
420 $self->{'_svc_acct'};
422 require "FS/$svcdb.pm";
423 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
424 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
426 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
430 =item seconds_since TIMESTAMP
432 See L<FS::svc_acct/seconds_since>. Equivalent to
433 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
434 where B<svcdb> is not "svc_acct".
438 #note: implementation here, POD in FS::svc_acct
440 my($self, $since) = @_;
442 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
445 AND logout IS NOT NULL'
446 ) or die $dbh->errstr;
447 $sth->execute($self->svcnum, $since) or die $sth->errstr;
448 $sth->fetchrow_arrayref->[0];
451 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
453 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
454 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
455 for records where B<svcdb> is not "svc_acct".
459 #note: implementation here, POD in FS::svc_acct
460 sub seconds_since_sqlradacct {
461 my($self, $start, $end) = @_;
463 my $svc_x = $self->svc_x;
465 my @part_export = $self->part_svc->part_export_usage;
466 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
467 " service definition"
472 foreach my $part_export ( @part_export ) {
474 next if $part_export->option('ignore_accounting');
476 my $dbh = DBI->connect( map { $part_export->option($_) }
477 qw(datasrc username password) )
478 or die "can't connect to sqlradius database: ". $DBI::errstr;
480 #select a unix time conversion function based on database type
481 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
483 my $username = $part_export->export_username($svc_x);
487 #find closed sessions completely within the given range
488 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
491 AND $str2time AcctStartTime) >= ?
492 AND $str2time AcctStopTime ) < ?
493 AND $str2time AcctStopTime ) > 0
494 AND AcctStopTime IS NOT NULL"
495 ) or die $dbh->errstr;
496 $sth->execute($username, $start, $end) or die $sth->errstr;
497 my $regular = $sth->fetchrow_arrayref->[0];
499 #find open sessions which start in the range, count session start->range end
500 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
503 AND $str2time AcctStartTime ) >= ?
504 AND $str2time AcctStartTime ) < ?
505 AND ( ? - $str2time AcctStartTime ) ) < 86400
506 AND ( $str2time AcctStopTime ) = 0
507 OR AcctStopTime IS NULL )";
508 $sth = $dbh->prepare($query) or die $dbh->errstr;
509 $sth->execute($end, $username, $start, $end, $end)
510 or die $sth->errstr. " executing query $query";
511 my $start_during = $sth->fetchrow_arrayref->[0];
513 #find closed sessions which start before the range but stop during,
514 #count range start->session end
515 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
518 AND $str2time AcctStartTime ) < ?
519 AND $str2time AcctStopTime ) >= ?
520 AND $str2time AcctStopTime ) < ?
521 AND $str2time AcctStopTime ) > 0
522 AND AcctStopTime IS NOT NULL"
523 ) or die $dbh->errstr;
524 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
525 my $end_during = $sth->fetchrow_arrayref->[0];
527 #find closed (not anymore - or open) sessions which start before the range
528 # but stop after, or are still open, count range start->range end
529 # don't count open sessions (probably missing stop record)
530 $sth = $dbh->prepare("SELECT COUNT(*)
533 AND $str2time AcctStartTime ) < ?
534 AND ( $str2time AcctStopTime ) >= ?
536 # OR AcctStopTime = 0
537 # OR AcctStopTime IS NULL )"
538 ) or die $dbh->errstr;
539 $sth->execute($username, $start, $end ) or die $sth->errstr;
540 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
542 $seconds += $regular + $end_during + $start_during + $entire_range;
550 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
552 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
553 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
554 for records where B<svcdb> is not "svc_acct".
558 #note: implementation here, POD in FS::svc_acct
559 #(false laziness w/seconds_since_sqlradacct above)
560 sub attribute_since_sqlradacct {
561 my($self, $start, $end, $attrib) = @_;
563 my $svc_x = $self->svc_x;
565 my @part_export = $self->part_svc->part_export_usage;
566 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
567 " service definition"
573 foreach my $part_export ( @part_export ) {
575 next if $part_export->option('ignore_accounting');
577 my $dbh = DBI->connect( map { $part_export->option($_) }
578 qw(datasrc username password) )
579 or die "can't connect to sqlradius database: ". $DBI::errstr;
581 #select a unix time conversion function based on database type
582 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
584 my $username = $part_export->export_username($svc_x);
586 my $sth = $dbh->prepare("SELECT SUM($attrib)
589 AND $str2time AcctStopTime ) >= ?
590 AND $str2time AcctStopTime ) < ?
591 AND AcctStopTime IS NOT NULL"
592 ) or die $dbh->errstr;
593 $sth->execute($username, $start, $end) or die $sth->errstr;
595 $sum += $sth->fetchrow_arrayref->[0];
603 =item get_session_history TIMESTAMP_START TIMESTAMP_END
605 See L<FS::svc_acct/get_session_history>. Equivalent to
606 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
607 records where B<svcdb> is not "svc_acct".
611 sub get_session_history {
612 my($self, $start, $end, $attrib) = @_;
616 my @part_export = $self->part_svc->part_export_usage;
617 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
618 " service definition"
624 foreach my $part_export ( @part_export ) {
626 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
633 =item get_cdrs_for_update
635 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
636 objects (see L<FS::cdr>) associated with this service.
638 CDRs are associated with svc_phone services via svc_phone.phonenum
642 sub get_cdrs_for_update {
643 my($self, %options) = @_;
645 my @fields = ( 'charged_party' );
646 push @fields, 'src' unless $options{'disable_src'};
648 #CDRs are now associated with svc_phone services via svc_phone.phonenum
649 #return () unless $self->svc_x->isa('FS::svc_phone');
650 return () unless $self->part_svc->svcdb eq 'svc_phone';
651 my $number = $self->svc_x->phonenum;
653 my $prefix = $options{'default_prefix'};
655 my @where = map " $_ = '$number' ", @fields;
656 push @where, map " $_ = '$prefix$number' ", @fields
659 my $extra_sql = ' AND ( '. join(' OR ', @where ). ' ) ';
664 'hashref' => { 'freesidestatus' => '', },
665 'extra_sql' => "$extra_sql FOR UPDATE",
675 Behaviour of changing the svcpart of cust_svc records is undefined and should
676 possibly be prohibited, and pkg_svc records are not checked.
678 pkg_svc records are not checked in general (here).
680 Deleting this record doesn't check or delete the svc_* record associated
683 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
684 a DBI database handle is not yet implemented.
688 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
689 schema.html from the base documentation