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 the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
398 FS::svc_domain object, etc.)
404 my $svcdb = $self->part_svc->svcdb;
405 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
406 $self->{'_svc_acct'};
408 require "FS/$svcdb.pm";
409 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
410 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
412 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
416 =item seconds_since TIMESTAMP
418 See L<FS::svc_acct/seconds_since>. Equivalent to
419 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
420 where B<svcdb> is not "svc_acct".
424 #note: implementation here, POD in FS::svc_acct
426 my($self, $since) = @_;
428 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
431 AND logout IS NOT NULL'
432 ) or die $dbh->errstr;
433 $sth->execute($self->svcnum, $since) or die $sth->errstr;
434 $sth->fetchrow_arrayref->[0];
437 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
439 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
440 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
441 for records where B<svcdb> is not "svc_acct".
445 #note: implementation here, POD in FS::svc_acct
446 sub seconds_since_sqlradacct {
447 my($self, $start, $end) = @_;
449 my $svc_x = $self->svc_x;
451 my @part_export = $self->part_svc->part_export_usage;
452 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
453 " service definition"
458 foreach my $part_export ( @part_export ) {
460 next if $part_export->option('ignore_accounting');
462 my $dbh = DBI->connect( map { $part_export->option($_) }
463 qw(datasrc username password) )
464 or die "can't connect to sqlradius database: ". $DBI::errstr;
466 #select a unix time conversion function based on database type
467 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
469 my $username = $part_export->export_username($svc_x);
473 #find closed sessions completely within the given range
474 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
477 AND $str2time AcctStartTime) >= ?
478 AND $str2time AcctStopTime ) < ?
479 AND $str2time AcctStopTime ) > 0
480 AND AcctStopTime IS NOT NULL"
481 ) or die $dbh->errstr;
482 $sth->execute($username, $start, $end) or die $sth->errstr;
483 my $regular = $sth->fetchrow_arrayref->[0];
485 #find open sessions which start in the range, count session start->range end
486 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
489 AND $str2time AcctStartTime ) >= ?
490 AND $str2time AcctStartTime ) < ?
491 AND ( ? - $str2time AcctStartTime ) ) < 86400
492 AND ( $str2time AcctStopTime ) = 0
493 OR AcctStopTime IS NULL )";
494 $sth = $dbh->prepare($query) or die $dbh->errstr;
495 $sth->execute($end, $username, $start, $end, $end)
496 or die $sth->errstr. " executing query $query";
497 my $start_during = $sth->fetchrow_arrayref->[0];
499 #find closed sessions which start before the range but stop during,
500 #count range start->session end
501 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
504 AND $str2time AcctStartTime ) < ?
505 AND $str2time AcctStopTime ) >= ?
506 AND $str2time AcctStopTime ) < ?
507 AND $str2time AcctStopTime ) > 0
508 AND AcctStopTime IS NOT NULL"
509 ) or die $dbh->errstr;
510 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
511 my $end_during = $sth->fetchrow_arrayref->[0];
513 #find closed (not anymore - or open) sessions which start before the range
514 # but stop after, or are still open, count range start->range end
515 # don't count open sessions (probably missing stop record)
516 $sth = $dbh->prepare("SELECT COUNT(*)
519 AND $str2time AcctStartTime ) < ?
520 AND ( $str2time AcctStopTime ) >= ?
522 # OR AcctStopTime = 0
523 # OR AcctStopTime IS NULL )"
524 ) or die $dbh->errstr;
525 $sth->execute($username, $start, $end ) or die $sth->errstr;
526 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
528 $seconds += $regular + $end_during + $start_during + $entire_range;
536 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
538 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
539 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
540 for records where B<svcdb> is not "svc_acct".
544 #note: implementation here, POD in FS::svc_acct
545 #(false laziness w/seconds_since_sqlradacct above)
546 sub attribute_since_sqlradacct {
547 my($self, $start, $end, $attrib) = @_;
549 my $svc_x = $self->svc_x;
551 my @part_export = $self->part_svc->part_export_usage;
552 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
553 " service definition"
559 foreach my $part_export ( @part_export ) {
561 next if $part_export->option('ignore_accounting');
563 my $dbh = DBI->connect( map { $part_export->option($_) }
564 qw(datasrc username password) )
565 or die "can't connect to sqlradius database: ". $DBI::errstr;
567 #select a unix time conversion function based on database type
568 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
570 my $username = $part_export->export_username($svc_x);
572 my $sth = $dbh->prepare("SELECT SUM($attrib)
575 AND $str2time AcctStopTime ) >= ?
576 AND $str2time AcctStopTime ) < ?
577 AND AcctStopTime IS NOT NULL"
578 ) or die $dbh->errstr;
579 $sth->execute($username, $start, $end) or die $sth->errstr;
581 $sum += $sth->fetchrow_arrayref->[0];
589 =item get_session_history TIMESTAMP_START TIMESTAMP_END
591 See L<FS::svc_acct/get_session_history>. Equivalent to
592 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
593 records where B<svcdb> is not "svc_acct".
597 sub get_session_history {
598 my($self, $start, $end, $attrib) = @_;
602 my @part_export = $self->part_svc->part_export_usage;
603 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
604 " service definition"
610 foreach my $part_export ( @part_export ) {
612 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
619 =item get_cdrs_for_update
621 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
622 objects (see L<FS::cdr>) associated with this service.
624 CDRs are associated with svc_phone services via svc_phone.phonenum
628 sub get_cdrs_for_update {
629 my($self, %options) = @_;
631 my $default_prefix = $options{'default_prefix'};
633 #CDRs are now associated with svc_phone services via svc_phone.phonenum
634 #return () unless $self->svc_x->isa('FS::svc_phone');
635 return () unless $self->part_svc->svcdb eq 'svc_phone';
636 my $number = $self->svc_x->phonenum;
641 'hashref' => { 'freesidestatus' => '',
642 'charged_party' => $number
644 'extra_sql' => 'FOR UPDATE',
647 if ( length($default_prefix) ) {
651 'hashref' => { 'freesidestatus' => '',
652 'charged_party' => "$default_prefix$number",
654 'extra_sql' => 'FOR UPDATE',
658 #astricon hack? config option?
662 'hashref' => { 'freesidestatus' => '',
665 'extra_sql' => 'FOR UPDATE',
668 if ( length($default_prefix) ) {
672 'hashref' => { 'freesidestatus' => '',
673 'src' => "$default_prefix$number",
675 'extra_sql' => 'FOR UPDATE',
686 Behaviour of changing the svcpart of cust_svc records is undefined and should
687 possibly be prohibited, and pkg_svc records are not checked.
689 pkg_svc records are not checked in general (here).
691 Deleting this record doesn't check or delete the svc_* record associated
694 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
695 a DBI database handle is not yet implemented.
699 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
700 schema.html from the base documentation