4 use vars qw( @ISA $DEBUG $ignore_quantity );
5 use Carp qw( carp cluck );
7 use FS::Record qw( qsearch qsearchs dbh );
15 use FS::svc_broadband;
17 use FS::domain_record;
21 @ISA = qw( FS::Record );
29 my ( $hashref, $cache ) = @_;
30 if ( $hashref->{'username'} ) {
31 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
33 if ( $hashref->{'svc'} ) {
34 $self->{'_svcpart'} = FS::part_svc->new($hashref);
40 FS::cust_svc - Object method for cust_svc objects
46 $record = new FS::cust_svc \%hash
47 $record = new FS::cust_svc { 'column' => 'value' };
49 $error = $record->insert;
51 $error = $new_record->replace($old_record);
53 $error = $record->delete;
55 $error = $record->check;
57 ($label, $value) = $record->label;
61 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
62 The following fields are currently supported:
66 =item svcnum - primary key (assigned automatically for new services)
68 =item pkgnum - Package (see L<FS::cust_pkg>)
70 =item svcpart - Service definition (see L<FS::part_svc>)
80 Creates a new service. To add the refund to the database, see L<"insert">.
81 Services are normally created by creating FS::svc_ objects (see
82 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
86 sub table { 'cust_svc'; }
90 Adds this service to the database. If there is an error, returns the error,
91 otherwise returns false.
95 Deletes this service from the database. If there is an error, returns the
96 error, otherwise returns false. Note that this only removes the cust_svc
97 record - you should probably use the B<cancel> method instead.
101 Cancels the relevant service by calling the B<cancel> method of the associated
102 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
103 deleting the FS::svc_XXX record and then deleting this record.
105 If there is an error, returns the error, otherwise returns false.
112 local $SIG{HUP} = 'IGNORE';
113 local $SIG{INT} = 'IGNORE';
114 local $SIG{QUIT} = 'IGNORE';
115 local $SIG{TERM} = 'IGNORE';
116 local $SIG{TSTP} = 'IGNORE';
117 local $SIG{PIPE} = 'IGNORE';
119 my $oldAutoCommit = $FS::UID::AutoCommit;
120 local $FS::UID::AutoCommit = 0;
123 my $part_svc = $self->part_svc;
125 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
126 $dbh->rollback if $oldAutoCommit;
127 return "Illegal svcdb value in part_svc!";
130 require "FS/$svcdb.pm";
132 my $svc = $self->svc_x;
134 my $error = $svc->cancel;
136 $dbh->rollback if $oldAutoCommit;
137 return "Error canceling service: $error";
139 $error = $svc->delete;
141 $dbh->rollback if $oldAutoCommit;
142 return "Error deleting service: $error";
146 my $error = $self->delete;
148 $dbh->rollback if $oldAutoCommit;
149 return "Error deleting cust_svc: $error";
152 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
158 =item replace OLD_RECORD
160 Replaces the OLD_RECORD with this one in the database. If there is an error,
161 returns the error, otherwise returns false.
166 my ( $new, $old ) = ( shift, shift );
168 local $SIG{HUP} = 'IGNORE';
169 local $SIG{INT} = 'IGNORE';
170 local $SIG{QUIT} = 'IGNORE';
171 local $SIG{TERM} = 'IGNORE';
172 local $SIG{TSTP} = 'IGNORE';
173 local $SIG{PIPE} = 'IGNORE';
175 my $oldAutoCommit = $FS::UID::AutoCommit;
176 local $FS::UID::AutoCommit = 0;
179 if ( $new->svcpart != $old->svcpart ) {
180 my $svc_x = $new->svc_x;
181 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
182 local($FS::Record::nowarn_identical) = 1;
183 my $error = $new_svc_x->replace($svc_x);
185 $dbh->rollback if $oldAutoCommit;
186 return $error if $error;
190 my $error = $new->SUPER::replace($old);
192 $dbh->rollback if $oldAutoCommit;
193 return $error if $error;
196 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
203 Checks all fields to make sure this is a valid service. If there is an error,
204 returns the error, otherwise returns false. Called by the insert and
213 $self->ut_numbern('svcnum')
214 || $self->ut_numbern('pkgnum')
215 || $self->ut_number('svcpart')
217 return $error if $error;
219 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
220 return "Unknown svcpart" unless $part_svc;
222 if ( $self->pkgnum ) {
223 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
224 return "Unknown pkgnum" unless $cust_pkg;
225 my $pkg_svc = qsearchs( 'pkg_svc', {
226 'pkgpart' => $cust_pkg->pkgpart,
227 'svcpart' => $self->svcpart,
229 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
230 # 'svcpart' => $self->svcpart,
231 # 'quantity' => 0 } );
232 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
234 my @cust_svc = qsearch('cust_svc', {
235 'pkgnum' => $self->pkgnum,
236 'svcpart' => $self->svcpart,
238 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
239 " services for pkgnum ". $self->pkgnum
240 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
248 Returns the definition for this service, as a FS::part_svc object (see
256 ? $self->{'_svcpart'}
257 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
262 Returns the package this service belongs to, as a FS::cust_pkg object (see
269 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
274 Returns a list consisting of:
275 - The name of this service (from part_svc)
276 - A meaningful identifier (username, domain, or mail alias)
277 - The table name (i.e. svc_domain) for this service
284 carp "FS::cust_svc::label called on $self" if $DEBUG;
285 my $svc_x = $self->svc_x
286 or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
287 $self->_svc_label($svc_x);
291 my( $self, $svc_x ) = ( shift, shift );
292 my $svcdb = $self->part_svc->svcdb;
295 if ( $svcdb eq 'svc_acct' ) {
296 $tag = $svc_x->email(@_);
297 } elsif ( $svcdb eq 'svc_forward' ) {
298 if ( $svc_x->srcsvc ) {
299 my $svc_acct = $svc_x->srcsvc_acct(@_);
300 $tag = $svc_acct->email(@_);
305 if ( $svc_x->dstsvc ) {
306 my $svc_acct = $svc_x->dstsvc_acct(@_);
307 $tag .= $svc_acct->email(@_);
311 } elsif ( $svcdb eq 'svc_domain' ) {
312 $tag = $svc_x->getfield('domain');
313 } elsif ( $svcdb eq 'svc_www' ) {
314 my $domain_record = $svc_x->domain_record(@_);
315 $tag = $domain_record->zone;
316 } elsif ( $svcdb eq 'svc_broadband' ) {
317 $tag = $svc_x->ip_addr;
318 } elsif ( $svcdb eq 'svc_external' ) {
319 my $conf = new FS::Conf;
320 if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
321 $tag = sprintf('%010d', $svc_x->id). '-'.
322 substr('0000000000'.uc($svc_x->title), -10);
324 $tag = $svc_x->id. ': '. $svc_x->title;
327 cluck "warning: asked for label of unsupported svcdb; using svcnum";
328 $tag = $svc_x->getfield('svcnum');
331 $self->part_svc->svc, $tag, $svcdb, $self->svcnum;
337 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
338 FS::svc_domain object, etc.)
344 my $svcdb = $self->part_svc->svcdb;
345 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
346 $self->{'_svc_acct'};
348 #require "FS/$svcdb.pm";
349 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
353 =item seconds_since TIMESTAMP
355 See L<FS::svc_acct/seconds_since>. Equivalent to
356 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
357 where B<svcdb> is not "svc_acct".
361 #note: implementation here, POD in FS::svc_acct
363 my($self, $since) = @_;
365 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
368 AND logout IS NOT NULL'
369 ) or die $dbh->errstr;
370 $sth->execute($self->svcnum, $since) or die $sth->errstr;
371 $sth->fetchrow_arrayref->[0];
374 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
376 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
377 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
378 for records where B<svcdb> is not "svc_acct".
382 #note: implementation here, POD in FS::svc_acct
383 sub seconds_since_sqlradacct {
384 my($self, $start, $end) = @_;
386 my $svc_x = $self->svc_x;
388 my @part_export = $self->part_svc->part_export_usage;
389 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
390 " service definition"
395 foreach my $part_export ( @part_export ) {
397 next if $part_export->option('ignore_accounting');
399 my $dbh = DBI->connect( map { $part_export->option($_) }
400 qw(datasrc username password) )
401 or die "can't connect to sqlradius database: ". $DBI::errstr;
403 #select a unix time conversion function based on database type
405 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
406 $str2time = 'UNIX_TIMESTAMP(';
407 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
408 $str2time = 'EXTRACT( EPOCH FROM ';
410 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
411 "; guessing how to convert to UNIX timestamps";
412 $str2time = 'extract(epoch from ';
415 my $username = $part_export->export_username($svc_x);
419 #find closed sessions completely within the given range
420 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
423 AND $str2time AcctStartTime) >= ?
424 AND $str2time AcctStopTime ) < ?
425 AND $str2time AcctStopTime ) > 0
426 AND AcctStopTime IS NOT NULL"
427 ) or die $dbh->errstr;
428 $sth->execute($username, $start, $end) or die $sth->errstr;
429 my $regular = $sth->fetchrow_arrayref->[0];
431 #find open sessions which start in the range, count session start->range end
432 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
435 AND $str2time AcctStartTime ) >= ?
436 AND $str2time AcctStartTime ) < ?
437 AND ( ? - $str2time AcctStartTime ) ) < 86400
438 AND ( $str2time AcctStopTime ) = 0
439 OR AcctStopTime IS NULL )";
440 $sth = $dbh->prepare($query) or die $dbh->errstr;
441 $sth->execute($end, $username, $start, $end, $end)
442 or die $sth->errstr. " executing query $query";
443 my $start_during = $sth->fetchrow_arrayref->[0];
445 #find closed sessions which start before the range but stop during,
446 #count range start->session end
447 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
450 AND $str2time AcctStartTime ) < ?
451 AND $str2time AcctStopTime ) >= ?
452 AND $str2time AcctStopTime ) < ?
453 AND $str2time AcctStopTime ) > 0
454 AND AcctStopTime IS NOT NULL"
455 ) or die $dbh->errstr;
456 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
457 my $end_during = $sth->fetchrow_arrayref->[0];
459 #find closed (not anymore - or open) sessions which start before the range
460 # but stop after, or are still open, count range start->range end
461 # don't count open sessions (probably missing stop record)
462 $sth = $dbh->prepare("SELECT COUNT(*)
465 AND $str2time AcctStartTime ) < ?
466 AND ( $str2time AcctStopTime ) >= ?
468 # OR AcctStopTime = 0
469 # OR AcctStopTime IS NULL )"
470 ) or die $dbh->errstr;
471 $sth->execute($username, $start, $end ) or die $sth->errstr;
472 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
474 $seconds += $regular + $end_during + $start_during + $entire_range;
482 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
484 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
485 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
486 for records where B<svcdb> is not "svc_acct".
490 #note: implementation here, POD in FS::svc_acct
491 #(false laziness w/seconds_since_sqlradacct above)
492 sub attribute_since_sqlradacct {
493 my($self, $start, $end, $attrib) = @_;
495 my $svc_x = $self->svc_x;
497 my @part_export = $self->part_svc->part_export_usage;
498 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
499 " service definition"
505 foreach my $part_export ( @part_export ) {
507 next if $part_export->option('ignore_accounting');
509 my $dbh = DBI->connect( map { $part_export->option($_) }
510 qw(datasrc username password) )
511 or die "can't connect to sqlradius database: ". $DBI::errstr;
513 #select a unix time conversion function based on database type
515 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
516 $str2time = 'UNIX_TIMESTAMP(';
517 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
518 $str2time = 'EXTRACT( EPOCH FROM ';
520 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
521 "; guessing how to convert to UNIX timestamps";
522 $str2time = 'extract(epoch from ';
525 my $username = $part_export->export_username($svc_x);
527 my $sth = $dbh->prepare("SELECT SUM($attrib)
530 AND $str2time AcctStopTime ) >= ?
531 AND $str2time AcctStopTime ) < ?
532 AND AcctStopTime IS NOT NULL"
533 ) or die $dbh->errstr;
534 $sth->execute($username, $start, $end) or die $sth->errstr;
536 $sum += $sth->fetchrow_arrayref->[0];
544 =item get_session_history TIMESTAMP_START TIMESTAMP_END
546 See L<FS::svc_acct/get_session_history>. Equivalent to
547 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
548 records where B<svcdb> is not "svc_acct".
552 sub get_session_history {
553 my($self, $start, $end, $attrib) = @_;
557 my @part_export = $self->part_svc->part_export_usage;
558 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
559 " service definition"
565 foreach my $part_export ( @part_export ) {
567 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
574 =item get_cdrs_for_update
576 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
577 objects (see L<FS::cdr>) associated with this service.
579 Currently CDRs are associated with svc_acct services via a DID in the
580 username. This part is rather tenative and still subject to change...
584 sub get_cdrs_for_update {
585 my($self, %options) = @_;
587 my $default_prefix = $options{'default_prefix'};
589 #Currently CDRs are associated with svc_acct services via a DID in the
590 #username. This part is rather tenative and still subject to change...
591 #return () unless $self->svc_x->isa('FS::svc_acct');
592 return () unless $self->part_svc->svcdb eq 'svc_acct';
593 my $number = $self->svc_x->username;
598 'hashref' => { 'freesidestatus' => '',
599 'charged_party' => $number
601 'extra_sql' => 'FOR UPDATE',
604 if ( length($default_prefix) ) {
608 'hashref' => { 'freesidestatus' => '',
609 'charged_party' => "$default_prefix$number",
611 'extra_sql' => 'FOR UPDATE',
620 Returns the pkg_svc record for for this service, if applicable.
626 my $cust_pkg = $self->cust_pkg;
627 return undef unless $cust_pkg;
629 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
630 'pkgpart' => $cust_pkg->pkgpart,
639 Behaviour of changing the svcpart of cust_svc records is undefined and should
640 possibly be prohibited, and pkg_svc records are not checked.
642 pkg_svc records are not checked in general (here).
644 Deleting this record doesn't check or delete the svc_* record associated
647 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
648 a DBI database handle is not yet implemented.
652 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
653 schema.html from the base documentation