4 use vars qw( @ISA $ignore_quantity );
6 use FS::Record qw( qsearch qsearchs dbh );
14 use FS::svc_broadband;
16 use FS::domain_record;
19 @ISA = qw( FS::Record );
25 my ( $hashref, $cache ) = @_;
26 if ( $hashref->{'username'} ) {
27 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
29 if ( $hashref->{'svc'} ) {
30 $self->{'_svcpart'} = FS::part_svc->new($hashref);
36 FS::cust_svc - Object method for cust_svc objects
42 $record = new FS::cust_svc \%hash
43 $record = new FS::cust_svc { 'column' => 'value' };
45 $error = $record->insert;
47 $error = $new_record->replace($old_record);
49 $error = $record->delete;
51 $error = $record->check;
53 ($label, $value) = $record->label;
57 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
58 The following fields are currently supported:
62 =item svcnum - primary key (assigned automatically for new services)
64 =item pkgnum - Package (see L<FS::cust_pkg>)
66 =item svcpart - Service definition (see L<FS::part_svc>)
76 Creates a new service. To add the refund to the database, see L<"insert">.
77 Services are normally created by creating FS::svc_ objects (see
78 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
82 sub table { 'cust_svc'; }
86 Adds this service to the database. If there is an error, returns the error,
87 otherwise returns false.
91 Deletes this service from the database. If there is an error, returns the
92 error, otherwise returns false. Note that this only removes the cust_svc
93 record - you should probably use the B<cancel> method instead.
97 Cancels the relevant service by calling the B<cancel> method of the associated
98 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
99 deleting the FS::svc_XXX record and then deleting this record.
101 If there is an error, returns the error, otherwise returns false.
108 local $SIG{HUP} = 'IGNORE';
109 local $SIG{INT} = 'IGNORE';
110 local $SIG{QUIT} = 'IGNORE';
111 local $SIG{TERM} = 'IGNORE';
112 local $SIG{TSTP} = 'IGNORE';
113 local $SIG{PIPE} = 'IGNORE';
115 my $oldAutoCommit = $FS::UID::AutoCommit;
116 local $FS::UID::AutoCommit = 0;
119 my $part_svc = $self->part_svc;
121 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
122 $dbh->rollback if $oldAutoCommit;
123 return "Illegal svcdb value in part_svc!";
126 require "FS/$svcdb.pm";
128 my $svc = $self->svc_x;
130 my $error = $svc->cancel;
132 $dbh->rollback if $oldAutoCommit;
133 return "Error canceling service: $error";
135 $error = $svc->delete;
137 $dbh->rollback if $oldAutoCommit;
138 return "Error deleting service: $error";
142 my $error = $self->delete;
144 $dbh->rollback if $oldAutoCommit;
145 return "Error deleting cust_svc: $error";
148 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
154 =item replace OLD_RECORD
156 Replaces the OLD_RECORD with this one in the database. If there is an error,
157 returns the error, otherwise returns false.
162 my ( $new, $old ) = ( shift, shift );
164 local $SIG{HUP} = 'IGNORE';
165 local $SIG{INT} = 'IGNORE';
166 local $SIG{QUIT} = 'IGNORE';
167 local $SIG{TERM} = 'IGNORE';
168 local $SIG{TSTP} = 'IGNORE';
169 local $SIG{PIPE} = 'IGNORE';
171 my $oldAutoCommit = $FS::UID::AutoCommit;
172 local $FS::UID::AutoCommit = 0;
175 if ( $new->svcpart != $old->svcpart ) {
176 my $svc_x = $new->svc_x;
177 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
178 my $error = $new_svc_x->replace($svc_x);
180 $dbh->rollback if $oldAutoCommit;
181 return $error if $error;
185 my $error = $new->SUPER::replace($old);
187 $dbh->rollback if $oldAutoCommit;
188 return $error if $error;
191 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
198 Checks all fields to make sure this is a valid service. If there is an error,
199 returns the error, otehrwise returns false. Called by the insert and
208 $self->ut_numbern('svcnum')
209 || $self->ut_numbern('pkgnum')
210 || $self->ut_number('svcpart')
212 return $error if $error;
214 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
215 return "Unknown svcpart" unless $part_svc;
217 if ( $self->pkgnum ) {
218 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
219 return "Unknown pkgnum" unless $cust_pkg;
220 my $pkg_svc = qsearchs( 'pkg_svc', {
221 'pkgpart' => $cust_pkg->pkgpart,
222 'svcpart' => $self->svcpart,
224 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
225 # 'svcpart' => $self->svcpart,
226 # 'quantity' => 0 } );
227 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
229 my @cust_svc = qsearch('cust_svc', {
230 'pkgnum' => $self->pkgnum,
231 'svcpart' => $self->svcpart,
233 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
234 " services for pkgnum ". $self->pkgnum
235 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
243 Returns the definition for this service, as a FS::part_svc object (see
251 ? $self->{'_svcpart'}
252 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
257 Returns the definition for this service, as a FS::part_svc object (see
264 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
269 Returns a list consisting of:
270 - The name of this service (from part_svc)
271 - A meaningful identifier (username, domain, or mail alias)
272 - The table name (i.e. svc_domain) for this service
278 my $svcdb = $self->part_svc->svcdb;
279 my $svc_x = $self->svc_x
280 or die "can't find $svcdb.svcnum ". $self->svcnum;
282 if ( $svcdb eq 'svc_acct' ) {
283 $tag = $svc_x->email;
284 } elsif ( $svcdb eq 'svc_forward' ) {
285 if ( $svc_x->srcsvc ) {
286 my $svc_acct = $svc_x->srcsvc_acct;
287 $tag = $svc_acct->email;
292 if ( $svc_x->dstsvc ) {
293 my $svc_acct = $svc_x->dstsvc_acct;
294 $tag .= $svc_acct->email;
298 } elsif ( $svcdb eq 'svc_domain' ) {
299 $tag = $svc_x->getfield('domain');
300 } elsif ( $svcdb eq 'svc_www' ) {
301 my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
302 $tag = $domain->zone;
303 } elsif ( $svcdb eq 'svc_broadband' ) {
304 $tag = $svc_x->ip_addr;
305 } elsif ( $svcdb eq 'svc_external' ) {
306 $tag = $svc_x->id. ': '. $svc_x->title;
308 cluck "warning: asked for label of unsupported svcdb; using svcnum";
309 $tag = $svc_x->getfield('svcnum');
311 $self->part_svc->svc, $tag, $svcdb;
316 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
317 FS::svc_domain object, etc.)
323 my $svcdb = $self->part_svc->svcdb;
324 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
325 $self->{'_svc_acct'};
327 #require "FS/$svcdb.pm";
328 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
332 =item seconds_since TIMESTAMP
334 See L<FS::svc_acct/seconds_since>. Equivalent to
335 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
336 where B<svcdb> is not "svc_acct".
340 #note: implementation here, POD in FS::svc_acct
342 my($self, $since) = @_;
344 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
347 AND logout IS NOT NULL'
348 ) or die $dbh->errstr;
349 $sth->execute($self->svcnum, $since) or die $sth->errstr;
350 $sth->fetchrow_arrayref->[0];
353 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
355 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
356 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
357 for records where B<svcdb> is not "svc_acct".
361 #note: implementation here, POD in FS::svc_acct
362 sub seconds_since_sqlradacct {
363 my($self, $start, $end) = @_;
365 my $svc_x = $self->svc_x;
367 my @part_export = $self->part_svc->part_export('sqlradius');
368 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
369 die "no sqlradius or sqlradius_withdomain export configured for this".
375 foreach my $part_export ( @part_export ) {
377 next if $part_export->option('ignore_accounting');
379 my $dbh = DBI->connect( map { $part_export->option($_) }
380 qw(datasrc username password) )
381 or die "can't connect to sqlradius database: ". $DBI::errstr;
383 #select a unix time conversion function based on database type
385 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
386 $str2time = 'UNIX_TIMESTAMP(';
387 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
388 $str2time = 'EXTRACT( EPOCH FROM ';
390 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
391 "; guessing how to convert to UNIX timestamps";
392 $str2time = 'extract(epoch from ';
396 if ( $part_export->exporttype eq 'sqlradius' ) {
397 $username = $svc_x->username;
398 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
399 $username = $svc_x->email;
401 die 'unknown exporttype '. $part_export->exporttype;
406 #find closed sessions completely within the given range
407 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
410 AND $str2time AcctStartTime) >= ?
411 AND $str2time AcctStopTime ) < ?
412 AND $str2time AcctStopTime ) > 0
413 AND AcctStopTime IS NOT NULL"
414 ) or die $dbh->errstr;
415 $sth->execute($username, $start, $end) or die $sth->errstr;
416 my $regular = $sth->fetchrow_arrayref->[0];
418 #find open sessions which start in the range, count session start->range end
419 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
422 AND $str2time AcctStartTime ) >= ?
423 AND $str2time AcctStartTime ) < ?
424 AND ( ? - $str2time AcctStartTime ) ) < 86400
425 AND ( $str2time AcctStopTime ) = 0
426 OR AcctStopTime IS NULL )";
427 $sth = $dbh->prepare($query) or die $dbh->errstr;
428 $sth->execute($end, $username, $start, $end, $end)
429 or die $sth->errstr. " executing query $query";
430 my $start_during = $sth->fetchrow_arrayref->[0];
432 #find closed sessions which start before the range but stop during,
433 #count range start->session end
434 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
437 AND $str2time AcctStartTime ) < ?
438 AND $str2time AcctStopTime ) >= ?
439 AND $str2time AcctStopTime ) < ?
440 AND $str2time AcctStopTime ) > 0
441 AND AcctStopTime IS NOT NULL"
442 ) or die $dbh->errstr;
443 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
444 my $end_during = $sth->fetchrow_arrayref->[0];
446 #find closed (not anymore - or open) sessions which start before the range
447 # but stop after, or are still open, count range start->range end
448 # don't count open sessions (probably missing stop record)
449 $sth = $dbh->prepare("SELECT COUNT(*)
452 AND $str2time AcctStartTime ) < ?
453 AND ( $str2time AcctStopTime ) >= ?
455 # OR AcctStopTime = 0
456 # OR AcctStopTime IS NULL )"
457 ) or die $dbh->errstr;
458 $sth->execute($username, $start, $end ) or die $sth->errstr;
459 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
461 $seconds += $regular + $end_during + $start_during + $entire_range;
469 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
471 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
472 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
473 for records where B<svcdb> is not "svc_acct".
477 #note: implementation here, POD in FS::svc_acct
478 #(false laziness w/seconds_since_sqlradacct above)
479 sub attribute_since_sqlradacct {
480 my($self, $start, $end, $attrib) = @_;
482 my $svc_x = $self->svc_x;
484 my @part_export = $self->part_svc->part_export('sqlradius');
485 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
486 die "no sqlradius or sqlradius_withdomain export configured for this".
493 foreach my $part_export ( @part_export ) {
495 next if $part_export->option('ignore_accounting');
497 my $dbh = DBI->connect( map { $part_export->option($_) }
498 qw(datasrc username password) )
499 or die "can't connect to sqlradius database: ". $DBI::errstr;
501 #select a unix time conversion function based on database type
503 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
504 $str2time = 'UNIX_TIMESTAMP(';
505 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
506 $str2time = 'EXTRACT( EPOCH FROM ';
508 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
509 "; guessing how to convert to UNIX timestamps";
510 $str2time = 'extract(epoch from ';
514 if ( $part_export->exporttype eq 'sqlradius' ) {
515 $username = $svc_x->username;
516 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
517 $username = $svc_x->email;
519 die 'unknown exporttype '. $part_export->exporttype;
522 my $sth = $dbh->prepare("SELECT SUM($attrib)
525 AND $str2time AcctStopTime ) >= ?
526 AND $str2time AcctStopTime ) < ?
527 AND AcctStopTime IS NOT NULL"
528 ) or die $dbh->errstr;
529 $sth->execute($username, $start, $end) or die $sth->errstr;
531 $sum += $sth->fetchrow_arrayref->[0];
539 =item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END
541 See L<FS::svc_acct/get_session_history_sqlradacct>. Equivalent to
542 $cust_svc->svc_x->get_session_history_sqlradacct, but more efficient.
543 Meaningless for records where B<svcdb> is not "svc_acct".
547 sub get_session_history {
548 my($self, $start, $end, $attrib) = @_;
550 my $username = $self->svc_x->username;
552 my @part_export = $self->part_svc->part_export('sqlradius')
553 or die "no sqlradius export configured for this service type";
558 foreach my $part_export ( @part_export ) {
560 my $dbh = DBI->connect( map { $part_export->option($_) }
561 qw(datasrc username password) )
562 or die "can't connect to sqlradius database: ". $DBI::errstr;
564 #select a unix time conversion function based on database type
566 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
567 $str2time = 'UNIX_TIMESTAMP(';
568 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
569 $str2time = 'EXTRACT( EPOCH FROM ';
571 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
572 "; guessing how to convert to UNIX timestamps";
573 $str2time = 'extract(epoch from ';
576 my @fields = qw( acctstarttime acctstoptime acctsessiontime
577 acctinputoctets acctoutputoctets framedipaddress );
579 my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
582 AND $str2time AcctStopTime ) >= ?
583 AND $str2time AcctStopTime ) <= ?
584 ORDER BY AcctStartTime DESC
585 ") or die $dbh->errstr;
586 $sth->execute($username, $start, $end) or die $sth->errstr;
588 push @sessions, map { { %$_ } } @{ $sth->fetchall_arrayref({}) };
597 Returns the pkg_svc record for for this service, if applicable.
603 my $cust_pkg = $self->cust_pkg;
604 return undef unless $cust_pkg;
606 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
607 'pkgpart' => $cust_pkg->pkgpart,
616 Behaviour of changing the svcpart of cust_svc records is undefined and should
617 possibly be prohibited, and pkg_svc records are not checked.
619 pkg_svc records are not checked in general (here).
621 Deleting this record doesn't check or delete the svc_* record associated
624 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
625 a DBI database handle is not yet implemented.
629 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
630 schema.html from the base documentation