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 local($FS::Record::nowarn_identical) = 1;
182 my $error = $new_svc_x->replace($svc_x);
184 $dbh->rollback if $oldAutoCommit;
185 return $error if $error;
189 my $error = $new->SUPER::replace($old);
191 $dbh->rollback if $oldAutoCommit;
192 return $error if $error;
195 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
202 Checks all fields to make sure this is a valid service. If there is an error,
203 returns the error, otehrwise returns false. Called by the insert and
212 $self->ut_numbern('svcnum')
213 || $self->ut_numbern('pkgnum')
214 || $self->ut_number('svcpart')
216 return $error if $error;
218 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
219 return "Unknown svcpart" unless $part_svc;
221 if ( $self->pkgnum ) {
222 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
223 return "Unknown pkgnum" unless $cust_pkg;
224 my $pkg_svc = qsearchs( 'pkg_svc', {
225 'pkgpart' => $cust_pkg->pkgpart,
226 'svcpart' => $self->svcpart,
228 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
229 # 'svcpart' => $self->svcpart,
230 # 'quantity' => 0 } );
231 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
233 my @cust_svc = qsearch('cust_svc', {
234 'pkgnum' => $self->pkgnum,
235 'svcpart' => $self->svcpart,
237 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
238 " services for pkgnum ". $self->pkgnum
239 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
247 Returns the definition for this service, as a FS::part_svc object (see
255 ? $self->{'_svcpart'}
256 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
261 Returns the definition for this service, as a FS::part_svc object (see
268 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
273 Returns a list consisting of:
274 - The name of this service (from part_svc)
275 - A meaningful identifier (username, domain, or mail alias)
276 - The table name (i.e. svc_domain) for this service
282 carp "FS::cust_svc::label called on $self" if $DEBUG;
283 my $svc_x = $self->svc_x
284 or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
285 $self->_svc_label($svc_x);
289 my( $self, $svc_x ) = ( shift, shift );
290 my $svcdb = $self->part_svc->svcdb;
293 if ( $svcdb eq 'svc_acct' ) {
294 $tag = $svc_x->email(@_);
295 } elsif ( $svcdb eq 'svc_forward' ) {
296 if ( $svc_x->srcsvc ) {
297 my $svc_acct = $svc_x->srcsvc_acct(@_);
298 $tag = $svc_acct->email(@_);
303 if ( $svc_x->dstsvc ) {
304 my $svc_acct = $svc_x->dstsvc_acct(@_);
305 $tag .= $svc_acct->email(@_);
309 } elsif ( $svcdb eq 'svc_domain' ) {
310 $tag = $svc_x->getfield('domain');
311 } elsif ( $svcdb eq 'svc_www' ) {
312 my $domain_record = $svc_x->domain_record(@_);
313 $tag = $domain_record->zone;
314 } elsif ( $svcdb eq 'svc_broadband' ) {
315 $tag = $svc_x->ip_addr;
316 } elsif ( $svcdb eq 'svc_external' ) {
317 my $conf = new FS::Conf;
318 if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
319 $tag = sprintf('%010d', $svc_x->id). '-'.
320 substr('0000000000'.uc($svc_x->title), -10);
322 $tag = $svc_x->id. ': '. $svc_x->title;
325 cluck "warning: asked for label of unsupported svcdb; using svcnum";
326 $tag = $svc_x->getfield('svcnum');
329 $self->part_svc->svc, $tag, $svcdb;
335 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
336 FS::svc_domain object, etc.)
342 my $svcdb = $self->part_svc->svcdb;
343 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
344 $self->{'_svc_acct'};
346 #require "FS/$svcdb.pm";
347 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
351 =item seconds_since TIMESTAMP
353 See L<FS::svc_acct/seconds_since>. Equivalent to
354 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
355 where B<svcdb> is not "svc_acct".
359 #note: implementation here, POD in FS::svc_acct
361 my($self, $since) = @_;
363 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
366 AND logout IS NOT NULL'
367 ) or die $dbh->errstr;
368 $sth->execute($self->svcnum, $since) or die $sth->errstr;
369 $sth->fetchrow_arrayref->[0];
372 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
374 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
375 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
376 for records where B<svcdb> is not "svc_acct".
380 #note: implementation here, POD in FS::svc_acct
381 sub seconds_since_sqlradacct {
382 my($self, $start, $end) = @_;
384 my $svc_x = $self->svc_x;
386 my @part_export = $self->part_svc->part_export('sqlradius');
387 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
388 die "no sqlradius or sqlradius_withdomain export configured for this".
394 foreach my $part_export ( @part_export ) {
396 next if $part_export->option('ignore_accounting');
398 my $dbh = DBI->connect( map { $part_export->option($_) }
399 qw(datasrc username password) )
400 or die "can't connect to sqlradius database: ". $DBI::errstr;
402 #select a unix time conversion function based on database type
404 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
405 $str2time = 'UNIX_TIMESTAMP(';
406 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
407 $str2time = 'EXTRACT( EPOCH FROM ';
409 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
410 "; guessing how to convert to UNIX timestamps";
411 $str2time = 'extract(epoch from ';
415 if ( $part_export->exporttype eq 'sqlradius' ) {
416 $username = $svc_x->username;
417 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
418 $username = $svc_x->email;
420 die 'unknown exporttype '. $part_export->exporttype;
425 #find closed sessions completely within the given range
426 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
429 AND $str2time AcctStartTime) >= ?
430 AND $str2time AcctStopTime ) < ?
431 AND $str2time AcctStopTime ) > 0
432 AND AcctStopTime IS NOT NULL"
433 ) or die $dbh->errstr;
434 $sth->execute($username, $start, $end) or die $sth->errstr;
435 my $regular = $sth->fetchrow_arrayref->[0];
437 #find open sessions which start in the range, count session start->range end
438 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
441 AND $str2time AcctStartTime ) >= ?
442 AND $str2time AcctStartTime ) < ?
443 AND ( ? - $str2time AcctStartTime ) ) < 86400
444 AND ( $str2time AcctStopTime ) = 0
445 OR AcctStopTime IS NULL )";
446 $sth = $dbh->prepare($query) or die $dbh->errstr;
447 $sth->execute($end, $username, $start, $end, $end)
448 or die $sth->errstr. " executing query $query";
449 my $start_during = $sth->fetchrow_arrayref->[0];
451 #find closed sessions which start before the range but stop during,
452 #count range start->session end
453 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
456 AND $str2time AcctStartTime ) < ?
457 AND $str2time AcctStopTime ) >= ?
458 AND $str2time AcctStopTime ) < ?
459 AND $str2time AcctStopTime ) > 0
460 AND AcctStopTime IS NOT NULL"
461 ) or die $dbh->errstr;
462 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
463 my $end_during = $sth->fetchrow_arrayref->[0];
465 #find closed (not anymore - or open) sessions which start before the range
466 # but stop after, or are still open, count range start->range end
467 # don't count open sessions (probably missing stop record)
468 $sth = $dbh->prepare("SELECT COUNT(*)
471 AND $str2time AcctStartTime ) < ?
472 AND ( $str2time AcctStopTime ) >= ?
474 # OR AcctStopTime = 0
475 # OR AcctStopTime IS NULL )"
476 ) or die $dbh->errstr;
477 $sth->execute($username, $start, $end ) or die $sth->errstr;
478 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
480 $seconds += $regular + $end_during + $start_during + $entire_range;
488 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
490 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
491 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
492 for records where B<svcdb> is not "svc_acct".
496 #note: implementation here, POD in FS::svc_acct
497 #(false laziness w/seconds_since_sqlradacct above)
498 sub attribute_since_sqlradacct {
499 my($self, $start, $end, $attrib) = @_;
501 my $svc_x = $self->svc_x;
503 my @part_export = $self->part_svc->part_export('sqlradius');
504 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
505 die "no sqlradius or sqlradius_withdomain export configured for this".
512 foreach my $part_export ( @part_export ) {
514 next if $part_export->option('ignore_accounting');
516 my $dbh = DBI->connect( map { $part_export->option($_) }
517 qw(datasrc username password) )
518 or die "can't connect to sqlradius database: ". $DBI::errstr;
520 #select a unix time conversion function based on database type
522 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
523 $str2time = 'UNIX_TIMESTAMP(';
524 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
525 $str2time = 'EXTRACT( EPOCH FROM ';
527 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
528 "; guessing how to convert to UNIX timestamps";
529 $str2time = 'extract(epoch from ';
533 if ( $part_export->exporttype eq 'sqlradius' ) {
534 $username = $svc_x->username;
535 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
536 $username = $svc_x->email;
538 die 'unknown exporttype '. $part_export->exporttype;
541 my $sth = $dbh->prepare("SELECT SUM($attrib)
544 AND $str2time AcctStopTime ) >= ?
545 AND $str2time AcctStopTime ) < ?
546 AND AcctStopTime IS NOT NULL"
547 ) or die $dbh->errstr;
548 $sth->execute($username, $start, $end) or die $sth->errstr;
550 $sum += $sth->fetchrow_arrayref->[0];
558 =item get_session_history TIMESTAMP_START TIMESTAMP_END
560 See L<FS::svc_acct/get_session_history>. Equivalent to
561 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
562 records where B<svcdb> is not "svc_acct".
566 sub get_session_history {
567 my($self, $start, $end, $attrib) = @_;
571 #my @part_export = $cust_svc->part_svc->part_export->can('usage_sessions');
572 my @part_export = $self->part_svc->part_export('sqlradius');
573 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
574 die "no sqlradius or sqlradius_withdomain export configured for this".
581 foreach my $part_export ( @part_export ) {
583 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
592 Returns the pkg_svc record for for this service, if applicable.
598 my $cust_pkg = $self->cust_pkg;
599 return undef unless $cust_pkg;
601 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
602 'pkgpart' => $cust_pkg->pkgpart,
611 Behaviour of changing the svcpart of cust_svc records is undefined and should
612 possibly be prohibited, and pkg_svc records are not checked.
614 pkg_svc records are not checked in general (here).
616 Deleting this record doesn't check or delete the svc_* record associated
619 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
620 a DBI database handle is not yet implemented.
624 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
625 schema.html from the base documentation