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;
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
431 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
433 my $username = $part_export->export_username($svc_x);
437 #find closed sessions completely within the given range
438 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
441 AND $str2time AcctStartTime) >= ?
442 AND $str2time AcctStopTime ) < ?
443 AND $str2time AcctStopTime ) > 0
444 AND AcctStopTime IS NOT NULL"
445 ) or die $dbh->errstr;
446 $sth->execute($username, $start, $end) or die $sth->errstr;
447 my $regular = $sth->fetchrow_arrayref->[0];
449 #find open sessions which start in the range, count session start->range end
450 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
453 AND $str2time AcctStartTime ) >= ?
454 AND $str2time AcctStartTime ) < ?
455 AND ( ? - $str2time AcctStartTime ) ) < 86400
456 AND ( $str2time AcctStopTime ) = 0
457 OR AcctStopTime IS NULL )";
458 $sth = $dbh->prepare($query) or die $dbh->errstr;
459 $sth->execute($end, $username, $start, $end, $end)
460 or die $sth->errstr. " executing query $query";
461 my $start_during = $sth->fetchrow_arrayref->[0];
463 #find closed sessions which start before the range but stop during,
464 #count range start->session end
465 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
468 AND $str2time AcctStartTime ) < ?
469 AND $str2time AcctStopTime ) >= ?
470 AND $str2time AcctStopTime ) < ?
471 AND $str2time AcctStopTime ) > 0
472 AND AcctStopTime IS NOT NULL"
473 ) or die $dbh->errstr;
474 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
475 my $end_during = $sth->fetchrow_arrayref->[0];
477 #find closed (not anymore - or open) sessions which start before the range
478 # but stop after, or are still open, count range start->range end
479 # don't count open sessions (probably missing stop record)
480 $sth = $dbh->prepare("SELECT COUNT(*)
483 AND $str2time AcctStartTime ) < ?
484 AND ( $str2time AcctStopTime ) >= ?
486 # OR AcctStopTime = 0
487 # OR AcctStopTime IS NULL )"
488 ) or die $dbh->errstr;
489 $sth->execute($username, $start, $end ) or die $sth->errstr;
490 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
492 $seconds += $regular + $end_during + $start_during + $entire_range;
500 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
502 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
503 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
504 for records where B<svcdb> is not "svc_acct".
508 #note: implementation here, POD in FS::svc_acct
509 #(false laziness w/seconds_since_sqlradacct above)
510 sub attribute_since_sqlradacct {
511 my($self, $start, $end, $attrib) = @_;
513 my $svc_x = $self->svc_x;
515 my @part_export = $self->part_svc->part_export_usage;
516 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
517 " service definition"
523 foreach my $part_export ( @part_export ) {
525 next if $part_export->option('ignore_accounting');
527 my $dbh = DBI->connect( map { $part_export->option($_) }
528 qw(datasrc username password) )
529 or die "can't connect to sqlradius database: ". $DBI::errstr;
531 #select a unix time conversion function based on database type
532 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
534 my $username = $part_export->export_username($svc_x);
536 my $sth = $dbh->prepare("SELECT SUM($attrib)
539 AND $str2time AcctStopTime ) >= ?
540 AND $str2time AcctStopTime ) < ?
541 AND AcctStopTime IS NOT NULL"
542 ) or die $dbh->errstr;
543 $sth->execute($username, $start, $end) or die $sth->errstr;
545 $sum += $sth->fetchrow_arrayref->[0];
553 =item get_session_history TIMESTAMP_START TIMESTAMP_END
555 See L<FS::svc_acct/get_session_history>. Equivalent to
556 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
557 records where B<svcdb> is not "svc_acct".
561 sub get_session_history {
562 my($self, $start, $end, $attrib) = @_;
566 my @part_export = $self->part_svc->part_export_usage;
567 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
568 " service definition"
574 foreach my $part_export ( @part_export ) {
576 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
583 =item get_cdrs_for_update
585 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
586 objects (see L<FS::cdr>) associated with this service.
588 CDRs are associated with svc_phone services via svc_phone.phonenum
592 sub get_cdrs_for_update {
593 my($self, %options) = @_;
595 my $default_prefix = $options{'default_prefix'};
597 #CDRs are now associated with svc_phone services via svc_phone.phonenum
598 #return () unless $self->svc_x->isa('FS::svc_phone');
599 return () unless $self->part_svc->svcdb eq 'svc_phone';
600 my $number = $self->svc_x->phonenum;
605 'hashref' => { 'freesidestatus' => '',
606 'charged_party' => $number
608 'extra_sql' => 'FOR UPDATE',
611 if ( length($default_prefix) ) {
615 'hashref' => { 'freesidestatus' => '',
616 'charged_party' => "$default_prefix$number",
618 'extra_sql' => 'FOR UPDATE',
622 #astricon hack? config option?
626 'hashref' => { 'freesidestatus' => '',
629 'extra_sql' => 'FOR UPDATE',
632 if ( length($default_prefix) ) {
636 'hashref' => { 'freesidestatus' => '',
637 'src' => "$default_prefix$number",
639 'extra_sql' => 'FOR UPDATE',
648 Returns the pkg_svc record for for this service, if applicable.
654 my $cust_pkg = $self->cust_pkg;
655 return undef unless $cust_pkg;
657 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
658 'pkgpart' => $cust_pkg->pkgpart,
667 Behaviour of changing the svcpart of cust_svc records is undefined and should
668 possibly be prohibited, and pkg_svc records are not checked.
670 pkg_svc records are not checked in general (here).
672 Deleting this record doesn't check or delete the svc_* record associated
675 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
676 a DBI database handle is not yet implemented.
680 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
681 schema.html from the base documentation