4 use vars qw( @ISA $DEBUG $me $ignore_quantity );
7 use FS::Record qw( qsearch qsearchs dbh );
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;
135 my $error = $svc->cancel;
137 $dbh->rollback if $oldAutoCommit;
138 return "Error canceling service: $error";
140 $error = $svc->delete;
142 $dbh->rollback if $oldAutoCommit;
143 return "Error deleting service: $error";
147 my $error = $self->delete;
149 $dbh->rollback if $oldAutoCommit;
150 return "Error deleting cust_svc: $error";
153 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
159 =item overlimit [ ACTION ]
161 Retrieves or sets the overlimit date. If ACTION is absent, return
162 the present value of overlimit. If ACTION is present, it can
163 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
164 is set to the current time if it is not already set. The 'unsuspend' value
165 causes the time to be cleared.
167 If there is an error on setting, returns the error, otherwise returns false.
173 my $action = shift or return $self->getfield('overlimit');
175 local $SIG{HUP} = 'IGNORE';
176 local $SIG{INT} = 'IGNORE';
177 local $SIG{QUIT} = 'IGNORE';
178 local $SIG{TERM} = 'IGNORE';
179 local $SIG{TSTP} = 'IGNORE';
180 local $SIG{PIPE} = 'IGNORE';
182 my $oldAutoCommit = $FS::UID::AutoCommit;
183 local $FS::UID::AutoCommit = 0;
186 if ( $action eq 'suspend' ) {
187 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
188 }elsif ( $action eq 'unsuspend' ) {
189 $self->setfield('overlimit', '');
191 die "unexpected action value: $action";
194 local $ignore_quantity = 1;
195 my $error = $self->replace;
197 $dbh->rollback if $oldAutoCommit;
198 return "Error setting overlimit: $error";
201 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
207 =item replace OLD_RECORD
209 Replaces the OLD_RECORD with this one in the database. If there is an error,
210 returns the error, otherwise returns false.
215 my ( $new, $old ) = ( shift, shift );
217 local $SIG{HUP} = 'IGNORE';
218 local $SIG{INT} = 'IGNORE';
219 local $SIG{QUIT} = 'IGNORE';
220 local $SIG{TERM} = 'IGNORE';
221 local $SIG{TSTP} = 'IGNORE';
222 local $SIG{PIPE} = 'IGNORE';
224 my $oldAutoCommit = $FS::UID::AutoCommit;
225 local $FS::UID::AutoCommit = 0;
228 $old = $new->replace_old unless defined($old);
230 if ( $new->svcpart != $old->svcpart ) {
231 my $svc_x = $new->svc_x;
232 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
233 local($FS::Record::nowarn_identical) = 1;
234 my $error = $new_svc_x->replace($svc_x);
236 $dbh->rollback if $oldAutoCommit;
237 return $error if $error;
241 my $error = $new->SUPER::replace($old);
243 $dbh->rollback if $oldAutoCommit;
244 return $error if $error;
247 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
254 Checks all fields to make sure this is a valid service. If there is an error,
255 returns the error, otherwise returns false. Called by the insert and
264 $self->ut_numbern('svcnum')
265 || $self->ut_numbern('pkgnum')
266 || $self->ut_number('svcpart')
267 || $self->ut_numbern('overlimit')
269 return $error if $error;
271 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
272 return "Unknown svcpart" unless $part_svc;
274 if ( $self->pkgnum ) {
275 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
276 return "Unknown pkgnum" unless $cust_pkg;
277 my $pkg_svc = qsearchs( 'pkg_svc', {
278 'pkgpart' => $cust_pkg->pkgpart,
279 'svcpart' => $self->svcpart,
281 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
282 # 'svcpart' => $self->svcpart,
283 # 'quantity' => 0 } );
284 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
286 my @cust_svc = qsearch('cust_svc', {
287 'pkgnum' => $self->pkgnum,
288 'svcpart' => $self->svcpart,
290 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
291 " services for pkgnum ". $self->pkgnum
292 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
300 Returns the definition for this service, as a FS::part_svc object (see
308 ? $self->{'_svcpart'}
309 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
314 Returns the package this service belongs to, as a FS::cust_pkg object (see
321 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
326 Returns a list consisting of:
327 - The name of this service (from part_svc)
328 - A meaningful identifier (username, domain, or mail alias)
329 - The table name (i.e. svc_domain) for this service
334 my($label, $value, $svcdb) = $cust_svc->label;
340 carp "FS::cust_svc::label called on $self" if $DEBUG;
341 my $svc_x = $self->svc_x
342 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
344 $self->_svc_label($svc_x);
348 my( $self, $svc_x ) = ( shift, shift );
351 $self->part_svc->svc,
353 $self->part_svc->svcdb,
361 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
362 FS::svc_domain object, etc.)
368 my $svcdb = $self->part_svc->svcdb;
369 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
370 $self->{'_svc_acct'};
372 require "FS/$svcdb.pm";
373 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
374 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
376 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
380 =item seconds_since TIMESTAMP
382 See L<FS::svc_acct/seconds_since>. Equivalent to
383 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
384 where B<svcdb> is not "svc_acct".
388 #note: implementation here, POD in FS::svc_acct
390 my($self, $since) = @_;
392 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
395 AND logout IS NOT NULL'
396 ) or die $dbh->errstr;
397 $sth->execute($self->svcnum, $since) or die $sth->errstr;
398 $sth->fetchrow_arrayref->[0];
401 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
403 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
404 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
405 for records where B<svcdb> is not "svc_acct".
409 #note: implementation here, POD in FS::svc_acct
410 sub seconds_since_sqlradacct {
411 my($self, $start, $end) = @_;
413 my $svc_x = $self->svc_x;
415 my @part_export = $self->part_svc->part_export_usage;
416 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
417 " service definition"
422 foreach my $part_export ( @part_export ) {
424 next if $part_export->option('ignore_accounting');
426 my $dbh = DBI->connect( map { $part_export->option($_) }
427 qw(datasrc username password) )
428 or die "can't connect to sqlradius database: ". $DBI::errstr;
430 #select a unix time conversion function based on database type
432 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
433 $str2time = 'UNIX_TIMESTAMP(';
434 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
435 $str2time = 'EXTRACT( EPOCH FROM ';
437 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
438 "; guessing how to convert to UNIX timestamps";
439 $str2time = 'extract(epoch from ';
442 my $username = $part_export->export_username($svc_x);
446 #find closed sessions completely within the given range
447 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
450 AND $str2time AcctStartTime) >= ?
451 AND $str2time AcctStopTime ) < ?
452 AND $str2time AcctStopTime ) > 0
453 AND AcctStopTime IS NOT NULL"
454 ) or die $dbh->errstr;
455 $sth->execute($username, $start, $end) or die $sth->errstr;
456 my $regular = $sth->fetchrow_arrayref->[0];
458 #find open sessions which start in the range, count session start->range end
459 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
462 AND $str2time AcctStartTime ) >= ?
463 AND $str2time AcctStartTime ) < ?
464 AND ( ? - $str2time AcctStartTime ) ) < 86400
465 AND ( $str2time AcctStopTime ) = 0
466 OR AcctStopTime IS NULL )";
467 $sth = $dbh->prepare($query) or die $dbh->errstr;
468 $sth->execute($end, $username, $start, $end, $end)
469 or die $sth->errstr. " executing query $query";
470 my $start_during = $sth->fetchrow_arrayref->[0];
472 #find closed sessions which start before the range but stop during,
473 #count range start->session end
474 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
477 AND $str2time AcctStartTime ) < ?
478 AND $str2time AcctStopTime ) >= ?
479 AND $str2time AcctStopTime ) < ?
480 AND $str2time AcctStopTime ) > 0
481 AND AcctStopTime IS NOT NULL"
482 ) or die $dbh->errstr;
483 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
484 my $end_during = $sth->fetchrow_arrayref->[0];
486 #find closed (not anymore - or open) sessions which start before the range
487 # but stop after, or are still open, count range start->range end
488 # don't count open sessions (probably missing stop record)
489 $sth = $dbh->prepare("SELECT COUNT(*)
492 AND $str2time AcctStartTime ) < ?
493 AND ( $str2time AcctStopTime ) >= ?
495 # OR AcctStopTime = 0
496 # OR AcctStopTime IS NULL )"
497 ) or die $dbh->errstr;
498 $sth->execute($username, $start, $end ) or die $sth->errstr;
499 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
501 $seconds += $regular + $end_during + $start_during + $entire_range;
509 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
511 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
512 $cust_svc->svc_x->attribute_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 #(false laziness w/seconds_since_sqlradacct above)
519 sub attribute_since_sqlradacct {
520 my($self, $start, $end, $attrib) = @_;
522 my $svc_x = $self->svc_x;
524 my @part_export = $self->part_svc->part_export_usage;
525 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
526 " service definition"
532 foreach my $part_export ( @part_export ) {
534 next if $part_export->option('ignore_accounting');
536 my $dbh = DBI->connect( map { $part_export->option($_) }
537 qw(datasrc username password) )
538 or die "can't connect to sqlradius database: ". $DBI::errstr;
540 #select a unix time conversion function based on database type
542 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
543 $str2time = 'UNIX_TIMESTAMP(';
544 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
545 $str2time = 'EXTRACT( EPOCH FROM ';
547 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
548 "; guessing how to convert to UNIX timestamps";
549 $str2time = 'extract(epoch from ';
552 my $username = $part_export->export_username($svc_x);
554 my $sth = $dbh->prepare("SELECT SUM($attrib)
557 AND $str2time AcctStopTime ) >= ?
558 AND $str2time AcctStopTime ) < ?
559 AND AcctStopTime IS NOT NULL"
560 ) or die $dbh->errstr;
561 $sth->execute($username, $start, $end) or die $sth->errstr;
563 $sum += $sth->fetchrow_arrayref->[0];
571 =item get_session_history TIMESTAMP_START TIMESTAMP_END
573 See L<FS::svc_acct/get_session_history>. Equivalent to
574 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
575 records where B<svcdb> is not "svc_acct".
579 sub get_session_history {
580 my($self, $start, $end, $attrib) = @_;
584 my @part_export = $self->part_svc->part_export_usage;
585 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
586 " service definition"
592 foreach my $part_export ( @part_export ) {
594 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
601 =item get_cdrs_for_update
603 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
604 objects (see L<FS::cdr>) associated with this service.
606 CDRs are associated with svc_phone services via svc_phone.phonenum
610 sub get_cdrs_for_update {
611 my($self, %options) = @_;
613 my $default_prefix = $options{'default_prefix'};
615 #CDRs are now associated with svc_phone services via svc_phone.phonenum
616 #return () unless $self->svc_x->isa('FS::svc_phone');
617 return () unless $self->part_svc->svcdb eq 'svc_phone';
618 my $number = $self->svc_x->phonenum;
623 'hashref' => { 'freesidestatus' => '',
624 'charged_party' => $number
626 'extra_sql' => 'FOR UPDATE',
629 if ( length($default_prefix) ) {
633 'hashref' => { 'freesidestatus' => '',
634 'charged_party' => "$default_prefix$number",
636 'extra_sql' => 'FOR UPDATE',
645 Returns the pkg_svc record for for this service, if applicable.
651 my $cust_pkg = $self->cust_pkg;
652 return undef unless $cust_pkg;
654 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
655 'pkgpart' => $cust_pkg->pkgpart,
664 Behaviour of changing the svcpart of cust_svc records is undefined and should
665 possibly be prohibited, and pkg_svc records are not checked.
667 pkg_svc records are not checked in general (here).
669 Deleting this record doesn't check or delete the svc_* record associated
672 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
673 a DBI database handle is not yet implemented.
677 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
678 schema.html from the base documentation