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 the pkg_svc record for for this service, if applicable.
332 my $cust_pkg = $self->cust_pkg;
333 return undef unless $cust_pkg;
335 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
336 'pkgpart' => $cust_pkg->pkgpart,
343 Returns the date this service was inserted.
349 $self->h_date('insert');
354 Returns a list consisting of:
355 - The name of this service (from part_svc)
356 - A meaningful identifier (username, domain, or mail alias)
357 - The table name (i.e. svc_domain) for this service
362 my($label, $value, $svcdb) = $cust_svc->label;
368 carp "FS::cust_svc::label called on $self" if $DEBUG;
369 my $svc_x = $self->svc_x
370 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
372 $self->_svc_label($svc_x);
376 my( $self, $svc_x ) = ( shift, shift );
379 $self->part_svc->svc,
381 $self->part_svc->svcdb,
389 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
390 FS::svc_domain object, etc.)
396 my $svcdb = $self->part_svc->svcdb;
397 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
398 $self->{'_svc_acct'};
400 require "FS/$svcdb.pm";
401 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
402 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
404 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
408 =item seconds_since TIMESTAMP
410 See L<FS::svc_acct/seconds_since>. Equivalent to
411 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
412 where B<svcdb> is not "svc_acct".
416 #note: implementation here, POD in FS::svc_acct
418 my($self, $since) = @_;
420 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
423 AND logout IS NOT NULL'
424 ) or die $dbh->errstr;
425 $sth->execute($self->svcnum, $since) or die $sth->errstr;
426 $sth->fetchrow_arrayref->[0];
429 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
431 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
432 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
433 for records where B<svcdb> is not "svc_acct".
437 #note: implementation here, POD in FS::svc_acct
438 sub seconds_since_sqlradacct {
439 my($self, $start, $end) = @_;
441 my $svc_x = $self->svc_x;
443 my @part_export = $self->part_svc->part_export_usage;
444 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
445 " service definition"
450 foreach my $part_export ( @part_export ) {
452 next if $part_export->option('ignore_accounting');
454 my $dbh = DBI->connect( map { $part_export->option($_) }
455 qw(datasrc username password) )
456 or die "can't connect to sqlradius database: ". $DBI::errstr;
458 #select a unix time conversion function based on database type
459 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
461 my $username = $part_export->export_username($svc_x);
465 #find closed sessions completely within the given range
466 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
469 AND $str2time AcctStartTime) >= ?
470 AND $str2time AcctStopTime ) < ?
471 AND $str2time AcctStopTime ) > 0
472 AND AcctStopTime IS NOT NULL"
473 ) or die $dbh->errstr;
474 $sth->execute($username, $start, $end) or die $sth->errstr;
475 my $regular = $sth->fetchrow_arrayref->[0];
477 #find open sessions which start in the range, count session start->range end
478 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
481 AND $str2time AcctStartTime ) >= ?
482 AND $str2time AcctStartTime ) < ?
483 AND ( ? - $str2time AcctStartTime ) ) < 86400
484 AND ( $str2time AcctStopTime ) = 0
485 OR AcctStopTime IS NULL )";
486 $sth = $dbh->prepare($query) or die $dbh->errstr;
487 $sth->execute($end, $username, $start, $end, $end)
488 or die $sth->errstr. " executing query $query";
489 my $start_during = $sth->fetchrow_arrayref->[0];
491 #find closed sessions which start before the range but stop during,
492 #count range start->session end
493 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
496 AND $str2time AcctStartTime ) < ?
497 AND $str2time AcctStopTime ) >= ?
498 AND $str2time AcctStopTime ) < ?
499 AND $str2time AcctStopTime ) > 0
500 AND AcctStopTime IS NOT NULL"
501 ) or die $dbh->errstr;
502 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
503 my $end_during = $sth->fetchrow_arrayref->[0];
505 #find closed (not anymore - or open) sessions which start before the range
506 # but stop after, or are still open, count range start->range end
507 # don't count open sessions (probably missing stop record)
508 $sth = $dbh->prepare("SELECT COUNT(*)
511 AND $str2time AcctStartTime ) < ?
512 AND ( $str2time AcctStopTime ) >= ?
514 # OR AcctStopTime = 0
515 # OR AcctStopTime IS NULL )"
516 ) or die $dbh->errstr;
517 $sth->execute($username, $start, $end ) or die $sth->errstr;
518 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
520 $seconds += $regular + $end_during + $start_during + $entire_range;
528 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
530 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
531 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
532 for records where B<svcdb> is not "svc_acct".
536 #note: implementation here, POD in FS::svc_acct
537 #(false laziness w/seconds_since_sqlradacct above)
538 sub attribute_since_sqlradacct {
539 my($self, $start, $end, $attrib) = @_;
541 my $svc_x = $self->svc_x;
543 my @part_export = $self->part_svc->part_export_usage;
544 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
545 " service definition"
551 foreach my $part_export ( @part_export ) {
553 next if $part_export->option('ignore_accounting');
555 my $dbh = DBI->connect( map { $part_export->option($_) }
556 qw(datasrc username password) )
557 or die "can't connect to sqlradius database: ". $DBI::errstr;
559 #select a unix time conversion function based on database type
560 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
562 my $username = $part_export->export_username($svc_x);
564 my $sth = $dbh->prepare("SELECT SUM($attrib)
567 AND $str2time AcctStopTime ) >= ?
568 AND $str2time AcctStopTime ) < ?
569 AND AcctStopTime IS NOT NULL"
570 ) or die $dbh->errstr;
571 $sth->execute($username, $start, $end) or die $sth->errstr;
573 $sum += $sth->fetchrow_arrayref->[0];
581 =item get_session_history TIMESTAMP_START TIMESTAMP_END
583 See L<FS::svc_acct/get_session_history>. Equivalent to
584 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
585 records where B<svcdb> is not "svc_acct".
589 sub get_session_history {
590 my($self, $start, $end, $attrib) = @_;
594 my @part_export = $self->part_svc->part_export_usage;
595 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
596 " service definition"
602 foreach my $part_export ( @part_export ) {
604 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
611 =item get_cdrs_for_update
613 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
614 objects (see L<FS::cdr>) associated with this service.
616 CDRs are associated with svc_phone services via svc_phone.phonenum
620 sub get_cdrs_for_update {
621 my($self, %options) = @_;
623 my $default_prefix = $options{'default_prefix'};
625 #CDRs are now associated with svc_phone services via svc_phone.phonenum
626 #return () unless $self->svc_x->isa('FS::svc_phone');
627 return () unless $self->part_svc->svcdb eq 'svc_phone';
628 my $number = $self->svc_x->phonenum;
633 'hashref' => { 'freesidestatus' => '',
634 'charged_party' => $number
636 'extra_sql' => 'FOR UPDATE',
639 if ( length($default_prefix) ) {
643 'hashref' => { 'freesidestatus' => '',
644 'charged_party' => "$default_prefix$number",
646 'extra_sql' => 'FOR UPDATE',
650 #astricon hack? config option?
654 'hashref' => { 'freesidestatus' => '',
657 'extra_sql' => 'FOR UPDATE',
660 if ( length($default_prefix) ) {
664 'hashref' => { 'freesidestatus' => '',
665 'src' => "$default_prefix$number",
667 'extra_sql' => 'FOR UPDATE',
678 Behaviour of changing the svcpart of cust_svc records is undefined and should
679 possibly be prohibited, and pkg_svc records are not checked.
681 pkg_svc records are not checked in general (here).
683 Deleting this record doesn't check or delete the svc_* record associated
686 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
687 a DBI database handle is not yet implemented.
691 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
692 schema.html from the base documentation