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;
20 @ISA = qw( 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>)
79 Creates a new service. To add the refund to the database, see L<"insert">.
80 Services are normally created by creating FS::svc_ objects (see
81 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
85 sub table { 'cust_svc'; }
89 Adds this service to the database. If there is an error, returns the error,
90 otherwise returns false.
94 Deletes this service from the database. If there is an error, returns the
95 error, otherwise returns false. Note that this only removes the cust_svc
96 record - you should probably use the B<cancel> method instead.
100 Cancels the relevant service by calling the B<cancel> method of the associated
101 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
102 deleting the FS::svc_XXX record and then deleting this record.
104 If there is an error, returns the error, otherwise returns false.
111 local $SIG{HUP} = 'IGNORE';
112 local $SIG{INT} = 'IGNORE';
113 local $SIG{QUIT} = 'IGNORE';
114 local $SIG{TERM} = 'IGNORE';
115 local $SIG{TSTP} = 'IGNORE';
116 local $SIG{PIPE} = 'IGNORE';
118 my $oldAutoCommit = $FS::UID::AutoCommit;
119 local $FS::UID::AutoCommit = 0;
122 my $part_svc = $self->part_svc;
124 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
125 $dbh->rollback if $oldAutoCommit;
126 return "Illegal svcdb value in part_svc!";
129 require "FS/$svcdb.pm";
131 my $svc = $self->svc_x;
133 my $error = $svc->cancel;
135 $dbh->rollback if $oldAutoCommit;
136 return "Error canceling service: $error";
138 $error = $svc->delete;
140 $dbh->rollback if $oldAutoCommit;
141 return "Error deleting service: $error";
145 my $error = $self->delete;
147 $dbh->rollback if $oldAutoCommit;
148 return "Error deleting cust_svc: $error";
151 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
157 =item replace OLD_RECORD
159 Replaces the OLD_RECORD with this one in the database. If there is an error,
160 returns the error, otherwise returns false.
165 my ( $new, $old ) = ( shift, shift );
167 local $SIG{HUP} = 'IGNORE';
168 local $SIG{INT} = 'IGNORE';
169 local $SIG{QUIT} = 'IGNORE';
170 local $SIG{TERM} = 'IGNORE';
171 local $SIG{TSTP} = 'IGNORE';
172 local $SIG{PIPE} = 'IGNORE';
174 my $oldAutoCommit = $FS::UID::AutoCommit;
175 local $FS::UID::AutoCommit = 0;
178 if ( $new->svcpart != $old->svcpart ) {
179 my $svc_x = $new->svc_x;
180 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
181 my $error = $new_svc_x->replace($svc_x);
183 $dbh->rollback if $oldAutoCommit;
184 return $error if $error;
188 my $error = $new->SUPER::replace($old);
190 $dbh->rollback if $oldAutoCommit;
191 return $error if $error;
194 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
201 Checks all fields to make sure this is a valid service. If there is an error,
202 returns the error, otehrwise returns false. Called by the insert and
211 $self->ut_numbern('svcnum')
212 || $self->ut_numbern('pkgnum')
213 || $self->ut_number('svcpart')
215 return $error if $error;
217 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
218 return "Unknown svcpart" unless $part_svc;
220 if ( $self->pkgnum ) {
221 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
222 return "Unknown pkgnum" unless $cust_pkg;
223 my $pkg_svc = qsearchs( 'pkg_svc', {
224 'pkgpart' => $cust_pkg->pkgpart,
225 'svcpart' => $self->svcpart,
227 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
228 # 'svcpart' => $self->svcpart,
229 # 'quantity' => 0 } );
230 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
232 my @cust_svc = qsearch('cust_svc', {
233 'pkgnum' => $self->pkgnum,
234 'svcpart' => $self->svcpart,
236 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
237 " services for pkgnum ". $self->pkgnum
238 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
246 Returns the definition for this service, as a FS::part_svc object (see
254 ? $self->{'_svcpart'}
255 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
260 Returns the definition for this service, as a FS::part_svc object (see
267 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
272 Returns a list consisting of:
273 - The name of this service (from part_svc)
274 - A meaningful identifier (username, domain, or mail alias)
275 - The table name (i.e. svc_domain) for this service
281 carp "FS::cust_svc::label called on $self" if $DEBUG;
282 my $svc_x = $self->svc_x
283 or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
284 $self->_svc_label($svc_x);
288 my( $self, $svc_x ) = ( shift, shift );
289 my $svcdb = $self->part_svc->svcdb;
292 if ( $svcdb eq 'svc_acct' ) {
293 $tag = $svc_x->email(@_);
294 } elsif ( $svcdb eq 'svc_forward' ) {
295 if ( $svc_x->srcsvc ) {
296 my $svc_acct = $svc_x->srcsvc_acct(@_);
297 $tag = $svc_acct->email(@_);
302 if ( $svc_x->dstsvc ) {
303 my $svc_acct = $svc_x->dstsvc_acct(@_);
304 $tag .= $svc_acct->email(@_);
308 } elsif ( $svcdb eq 'svc_domain' ) {
309 $tag = $svc_x->getfield('domain');
310 } elsif ( $svcdb eq 'svc_www' ) {
311 my $domain_record = $svc_x->domain_record;
312 $tag = $domain_record->zone;
313 } elsif ( $svcdb eq 'svc_broadband' ) {
314 $tag = $svc_x->ip_addr;
315 } elsif ( $svcdb eq 'svc_external' ) {
316 my $conf = new FS::Conf;
317 if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
318 $tag = sprintf('%010d', $svc_x->id). '-'. sprintf('%010d', $svc_x->title);
320 $tag = $svc_x->id. ': '. $svc_x->title;
323 cluck "warning: asked for label of unsupported svcdb; using svcnum";
324 $tag = $svc_x->getfield('svcnum');
327 $self->part_svc->svc, $tag, $svcdb;
333 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
334 FS::svc_domain object, etc.)
340 my $svcdb = $self->part_svc->svcdb;
341 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
342 $self->{'_svc_acct'};
344 #require "FS/$svcdb.pm";
345 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
349 =item seconds_since TIMESTAMP
351 See L<FS::svc_acct/seconds_since>. Equivalent to
352 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
353 where B<svcdb> is not "svc_acct".
357 #note: implementation here, POD in FS::svc_acct
359 my($self, $since) = @_;
361 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
364 AND logout IS NOT NULL'
365 ) or die $dbh->errstr;
366 $sth->execute($self->svcnum, $since) or die $sth->errstr;
367 $sth->fetchrow_arrayref->[0];
370 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
372 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
373 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
374 for records where B<svcdb> is not "svc_acct".
378 #note: implementation here, POD in FS::svc_acct
379 sub seconds_since_sqlradacct {
380 my($self, $start, $end) = @_;
382 my $svc_x = $self->svc_x;
384 my @part_export = $self->part_svc->part_export('sqlradius');
385 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
386 die "no sqlradius or sqlradius_withdomain export configured for this".
392 foreach my $part_export ( @part_export ) {
394 next if $part_export->option('ignore_accounting');
396 my $dbh = DBI->connect( map { $part_export->option($_) }
397 qw(datasrc username password) )
398 or die "can't connect to sqlradius database: ". $DBI::errstr;
400 #select a unix time conversion function based on database type
402 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
403 $str2time = 'UNIX_TIMESTAMP(';
404 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
405 $str2time = 'EXTRACT( EPOCH FROM ';
407 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
408 "; guessing how to convert to UNIX timestamps";
409 $str2time = 'extract(epoch from ';
413 if ( $part_export->exporttype eq 'sqlradius' ) {
414 $username = $svc_x->username;
415 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
416 $username = $svc_x->email;
418 die 'unknown exporttype '. $part_export->exporttype;
423 #find closed sessions completely within the given range
424 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
427 AND $str2time AcctStartTime) >= ?
428 AND $str2time AcctStopTime ) < ?
429 AND $str2time AcctStopTime ) > 0
430 AND AcctStopTime IS NOT NULL"
431 ) or die $dbh->errstr;
432 $sth->execute($username, $start, $end) or die $sth->errstr;
433 my $regular = $sth->fetchrow_arrayref->[0];
435 #find open sessions which start in the range, count session start->range end
436 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
439 AND $str2time AcctStartTime ) >= ?
440 AND $str2time AcctStartTime ) < ?
441 AND ( ? - $str2time AcctStartTime ) ) < 86400
442 AND ( $str2time AcctStopTime ) = 0
443 OR AcctStopTime IS NULL )";
444 $sth = $dbh->prepare($query) or die $dbh->errstr;
445 $sth->execute($end, $username, $start, $end, $end)
446 or die $sth->errstr. " executing query $query";
447 my $start_during = $sth->fetchrow_arrayref->[0];
449 #find closed sessions which start before the range but stop during,
450 #count range start->session end
451 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
454 AND $str2time AcctStartTime ) < ?
455 AND $str2time AcctStopTime ) >= ?
456 AND $str2time AcctStopTime ) < ?
457 AND $str2time AcctStopTime ) > 0
458 AND AcctStopTime IS NOT NULL"
459 ) or die $dbh->errstr;
460 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
461 my $end_during = $sth->fetchrow_arrayref->[0];
463 #find closed (not anymore - or open) sessions which start before the range
464 # but stop after, or are still open, count range start->range end
465 # don't count open sessions (probably missing stop record)
466 $sth = $dbh->prepare("SELECT COUNT(*)
469 AND $str2time AcctStartTime ) < ?
470 AND ( $str2time AcctStopTime ) >= ?
472 # OR AcctStopTime = 0
473 # OR AcctStopTime IS NULL )"
474 ) or die $dbh->errstr;
475 $sth->execute($username, $start, $end ) or die $sth->errstr;
476 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
478 $seconds += $regular + $end_during + $start_during + $entire_range;
486 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
488 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
489 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
490 for records where B<svcdb> is not "svc_acct".
494 #note: implementation here, POD in FS::svc_acct
495 #(false laziness w/seconds_since_sqlradacct above)
496 sub attribute_since_sqlradacct {
497 my($self, $start, $end, $attrib) = @_;
499 my $svc_x = $self->svc_x;
501 my @part_export = $self->part_svc->part_export('sqlradius');
502 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
503 die "no sqlradius or sqlradius_withdomain export configured for this".
510 foreach my $part_export ( @part_export ) {
512 next if $part_export->option('ignore_accounting');
514 my $dbh = DBI->connect( map { $part_export->option($_) }
515 qw(datasrc username password) )
516 or die "can't connect to sqlradius database: ". $DBI::errstr;
518 #select a unix time conversion function based on database type
520 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
521 $str2time = 'UNIX_TIMESTAMP(';
522 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
523 $str2time = 'EXTRACT( EPOCH FROM ';
525 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
526 "; guessing how to convert to UNIX timestamps";
527 $str2time = 'extract(epoch from ';
531 if ( $part_export->exporttype eq 'sqlradius' ) {
532 $username = $svc_x->username;
533 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
534 $username = $svc_x->email;
536 die 'unknown exporttype '. $part_export->exporttype;
539 my $sth = $dbh->prepare("SELECT SUM($attrib)
542 AND $str2time AcctStopTime ) >= ?
543 AND $str2time AcctStopTime ) < ?
544 AND AcctStopTime IS NOT NULL"
545 ) or die $dbh->errstr;
546 $sth->execute($username, $start, $end) or die $sth->errstr;
548 $sum += $sth->fetchrow_arrayref->[0];
556 =item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END
558 See L<FS::svc_acct/get_session_history_sqlradacct>. Equivalent to
559 $cust_svc->svc_x->get_session_history_sqlradacct, but more efficient.
560 Meaningless for records where B<svcdb> is not "svc_acct".
564 sub get_session_history {
565 my($self, $start, $end, $attrib) = @_;
569 #my @part_export = $cust_svc->part_svc->part_export->can('usage_sessions');
570 my @part_export = $self->part_svc->part_export('sqlradius');
571 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
572 die "no sqlradius or sqlradius_withdomain export configured for this".
579 foreach my $part_export ( @part_export ) {
580 push @sessions, $part_export->usage_sessions( $start, $end, $self->svc_x );
589 Returns the pkg_svc record for for this service, if applicable.
595 my $cust_pkg = $self->cust_pkg;
596 return undef unless $cust_pkg;
598 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
599 'pkgpart' => $cust_pkg->pkgpart,
608 Behaviour of changing the svcpart of cust_svc records is undefined and should
609 possibly be prohibited, and pkg_svc records are not checked.
611 pkg_svc records are not checked in general (here).
613 Deleting this record doesn't check or delete the svc_* record associated
616 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
617 a DBI database handle is not yet implemented.
621 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
622 schema.html from the base documentation