4 use vars qw( @ISA $ignore_quantity );
6 use FS::Record qw( qsearch qsearchs dbh );
15 use FS::domain_record;
18 @ISA = qw( FS::Record );
24 my ( $hashref, $cache ) = @_;
25 if ( $hashref->{'username'} ) {
26 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
28 if ( $hashref->{'svc'} ) {
29 $self->{'_svcpart'} = FS::part_svc->new($hashref);
35 FS::cust_svc - Object method for cust_svc objects
41 $record = new FS::cust_svc \%hash
42 $record = new FS::cust_svc { 'column' => 'value' };
44 $error = $record->insert;
46 $error = $new_record->replace($old_record);
48 $error = $record->delete;
50 $error = $record->check;
52 ($label, $value) = $record->label;
56 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
57 The following fields are currently supported:
61 =item svcnum - primary key (assigned automatically for new services)
63 =item pkgnum - Package (see L<FS::cust_pkg>)
65 =item svcpart - Service definition (see L<FS::part_svc>)
75 Creates a new service. To add the refund to the database, see L<"insert">.
76 Services are normally created by creating FS::svc_ objects (see
77 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
81 sub table { 'cust_svc'; }
85 Adds this service to the database. If there is an error, returns the error,
86 otherwise returns false.
90 Deletes this service from the database. If there is an error, returns the
91 error, otherwise returns false. Note that this only removes the cust_svc
92 record - you should probably use the B<cancel> method instead.
96 Cancels the relevant service by calling the B<cancel> method of the associated
97 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
98 deleting the FS::svc_XXX record and then deleting this record.
100 If there is an error, returns the error, otherwise returns false.
107 local $SIG{HUP} = 'IGNORE';
108 local $SIG{INT} = 'IGNORE';
109 local $SIG{QUIT} = 'IGNORE';
110 local $SIG{TERM} = 'IGNORE';
111 local $SIG{TSTP} = 'IGNORE';
112 local $SIG{PIPE} = 'IGNORE';
114 my $oldAutoCommit = $FS::UID::AutoCommit;
115 local $FS::UID::AutoCommit = 0;
118 my $part_svc = $self->part_svc;
120 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
121 $dbh->rollback if $oldAutoCommit;
122 return "Illegal svcdb value in part_svc!";
125 require "FS/$svcdb.pm";
127 my $svc = $self->svc_x;
129 my $error = $svc->cancel;
131 $dbh->rollback if $oldAutoCommit;
132 return "Error canceling service: $error";
134 $error = $svc->delete;
136 $dbh->rollback if $oldAutoCommit;
137 return "Error deleting service: $error";
141 my $error = $self->delete;
143 $dbh->rollback if $oldAutoCommit;
144 return "Error deleting cust_svc: $error";
147 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
153 =item replace OLD_RECORD
155 Replaces the OLD_RECORD with this one in the database. If there is an error,
156 returns the error, otherwise returns false.
161 my ( $new, $old ) = ( shift, shift );
163 local $SIG{HUP} = 'IGNORE';
164 local $SIG{INT} = 'IGNORE';
165 local $SIG{QUIT} = 'IGNORE';
166 local $SIG{TERM} = 'IGNORE';
167 local $SIG{TSTP} = 'IGNORE';
168 local $SIG{PIPE} = 'IGNORE';
170 my $oldAutoCommit = $FS::UID::AutoCommit;
171 local $FS::UID::AutoCommit = 0;
174 my $error = $new->SUPER::replace($old);
176 $dbh->rollback if $oldAutoCommit;
177 return $error if $error;
180 if ( $new->svcpart != $old->svcpart ) {
181 my $svc_x = $new->svc_x;
182 my $new_svc_x = ref($svc_x)->new({$svc_x->hash});
183 my $error = $new_svc_x->replace($svc_x);
185 $dbh->rollback if $oldAutoCommit;
186 return $error if $error;
190 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
197 Checks all fields to make sure this is a valid service. If there is an error,
198 returns the error, otehrwise returns false. Called by the insert and
207 $self->ut_numbern('svcnum')
208 || $self->ut_numbern('pkgnum')
209 || $self->ut_number('svcpart')
211 return $error if $error;
213 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
214 return "Unknown svcpart" unless $part_svc;
216 if ( $self->pkgnum ) {
217 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
218 return "Unknown pkgnum" unless $cust_pkg;
219 my $pkg_svc = qsearchs( 'pkg_svc', {
220 'pkgpart' => $cust_pkg->pkgpart,
221 'svcpart' => $self->svcpart,
223 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
224 # 'svcpart' => $self->svcpart,
225 # 'quantity' => 0 } );
226 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
228 my @cust_svc = qsearch('cust_svc', {
229 'pkgnum' => $self->pkgnum,
230 'svcpart' => $self->svcpart,
232 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
233 " services for pkgnum ". $self->pkgnum
234 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
242 Returns the definition for this service, as a FS::part_svc object (see
250 ? $self->{'_svcpart'}
251 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
256 Returns the definition for this service, as a FS::part_svc object (see
263 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
268 Returns a list consisting of:
269 - The name of this service (from part_svc)
270 - A meaningful identifier (username, domain, or mail alias)
271 - The table name (i.e. svc_domain) for this service
277 my $svcdb = $self->part_svc->svcdb;
278 my $svc_x = $self->svc_x
279 or die "can't find $svcdb.svcnum ". $self->svcnum;
281 if ( $svcdb eq 'svc_acct' ) {
282 $tag = $svc_x->email;
283 } elsif ( $svcdb eq 'svc_acct_sm' ) {
284 my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
285 my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
286 my $domain = $svc_domain->domain;
287 $tag = "$domuser\@$domain";
288 } elsif ( $svcdb eq 'svc_forward' ) {
289 my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
290 $tag = $svc_acct->email. '->';
291 if ( $svc_x->dstsvc ) {
292 $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
293 $tag .= $svc_acct->email;
297 } elsif ( $svcdb eq 'svc_domain' ) {
298 $tag = $svc_x->getfield('domain');
299 } elsif ( $svcdb eq 'svc_www' ) {
300 my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
301 $tag = $domain->zone;
303 cluck "warning: asked for label of unsupported svcdb; using svcnum";
304 $tag = $svc_x->getfield('svcnum');
306 $self->part_svc->svc, $tag, $svcdb;
311 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
312 FS::svc_domain object, etc.)
318 my $svcdb = $self->part_svc->svcdb;
319 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
320 $self->{'_svc_acct'};
322 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
326 =item seconds_since TIMESTAMP
328 See L<FS::svc_acct/seconds_since>. Equivalent to
329 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
330 where B<svcdb> is not "svc_acct".
334 #note: implementation here, POD in FS::svc_acct
336 my($self, $since) = @_;
338 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
341 AND logout IS NOT NULL'
342 ) or die $dbh->errstr;
343 $sth->execute($self->svcnum, $since) or die $sth->errstr;
344 $sth->fetchrow_arrayref->[0];
347 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
349 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
350 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
351 for records where B<svcdb> is not "svc_acct".
355 #note: implementation here, POD in FS::svc_acct
356 sub seconds_since_sqlradacct {
357 my($self, $start, $end) = @_;
359 my $svc_x = $self->svc_x;
361 my @part_export = $self->part_svc->part_export('sqlradius');
362 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
363 die "no sqlradius or sqlradius_withdomain export configured for this".
369 foreach my $part_export ( @part_export ) {
371 next if $part_export->option('ignore_accounting');
373 my $dbh = DBI->connect( map { $part_export->option($_) }
374 qw(datasrc username password) )
375 or die "can't connect to sqlradius database: ". $DBI::errstr;
377 #select a unix time conversion function based on database type
379 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
380 $str2time = 'UNIX_TIMESTAMP(';
381 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
382 $str2time = 'EXTRACT( EPOCH FROM ';
384 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
385 "; guessing how to convert to UNIX timestamps";
386 $str2time = 'extract(epoch from ';
390 if ( $part_export->exporttype eq 'sqlradius' ) {
391 $username = $svc_x->username;
392 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
393 $username = $svc_x->email;
395 die 'unknown exporttype '. $part_export->exporttype;
400 #find closed sessions completely within the given range
401 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
404 AND $str2time AcctStartTime) >= ?
405 AND $str2time AcctStopTime ) < ?
406 AND $str2time AcctStopTime ) > 0
407 AND AcctStopTime IS NOT NULL"
408 ) or die $dbh->errstr;
409 $sth->execute($username, $start, $end) or die $sth->errstr;
410 my $regular = $sth->fetchrow_arrayref->[0];
412 #find open sessions which start in the range, count session start->range end
413 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
416 AND $str2time AcctStartTime ) >= ?
417 AND $str2time AcctStartTime ) < ?
418 AND ( ? - $str2time AcctStartTime ) ) < 86400
419 AND ( $str2time AcctStopTime ) = 0
420 OR AcctStopTime IS NULL )";
421 $sth = $dbh->prepare($query) or die $dbh->errstr;
422 $sth->execute($end, $username, $start, $end, $end)
423 or die $sth->errstr. " executing query $query";
424 my $start_during = $sth->fetchrow_arrayref->[0];
426 #find closed sessions which start before the range but stop during,
427 #count range start->session end
428 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
431 AND $str2time AcctStartTime ) < ?
432 AND $str2time AcctStopTime ) >= ?
433 AND $str2time AcctStopTime ) < ?
434 AND $str2time AcctStopTime ) > 0
435 AND AcctStopTime IS NOT NULL"
436 ) or die $dbh->errstr;
437 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
438 my $end_during = $sth->fetchrow_arrayref->[0];
440 #find closed (not anymore - or open) sessions which start before the range
441 # but stop after, or are still open, count range start->range end
442 # don't count open sessions (probably missing stop record)
443 $sth = $dbh->prepare("SELECT COUNT(*)
446 AND $str2time AcctStartTime ) < ?
447 AND ( $str2time AcctStopTime ) >= ?
449 # OR AcctStopTime = 0
450 # OR AcctStopTime IS NULL )"
451 ) or die $dbh->errstr;
452 $sth->execute($username, $start, $end ) or die $sth->errstr;
453 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
455 $seconds += $regular + $end_during + $start_during + $entire_range;
463 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
465 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
466 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
467 for records where B<svcdb> is not "svc_acct".
471 #note: implementation here, POD in FS::svc_acct
472 #(false laziness w/seconds_since_sqlradacct above)
473 sub attribute_since_sqlradacct {
474 my($self, $start, $end, $attrib) = @_;
476 my $svc_x = $self->svc_x;
478 my @part_export = $self->part_svc->part_export('sqlradius');
479 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
480 die "no sqlradius or sqlradius_withdomain export configured for this".
487 foreach my $part_export ( @part_export ) {
489 next if $part_export->option('ignore_accounting');
491 my $dbh = DBI->connect( map { $part_export->option($_) }
492 qw(datasrc username password) )
493 or die "can't connect to sqlradius database: ". $DBI::errstr;
495 #select a unix time conversion function based on database type
497 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
498 $str2time = 'UNIX_TIMESTAMP(';
499 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
500 $str2time = 'EXTRACT( EPOCH FROM ';
502 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
503 "; guessing how to convert to UNIX timestamps";
504 $str2time = 'extract(epoch from ';
508 if ( $part_export->exporttype eq 'sqlradius' ) {
509 $username = $svc_x->username;
510 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
511 $username = $svc_x->email;
513 die 'unknown exporttype '. $part_export->exporttype;
516 my $sth = $dbh->prepare("SELECT SUM($attrib)
519 AND $str2time AcctStopTime ) >= ?
520 AND $str2time AcctStopTime ) < ?
521 AND AcctStopTime IS NOT NULL"
522 ) or die $dbh->errstr;
523 $sth->execute($username, $start, $end) or die $sth->errstr;
525 $sum += $sth->fetchrow_arrayref->[0];
533 =item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END
535 See L<FS::svc_acct/get_session_history_sqlradacct>. Equivalent to
536 $cust_svc->svc_x->get_session_history_sqlradacct, but more efficient.
537 Meaningless for records where B<svcdb> is not "svc_acct".
541 sub get_session_history {
542 my($self, $start, $end, $attrib) = @_;
544 my $username = $self->svc_x->username;
546 my @part_export = $self->part_svc->part_export('sqlradius')
547 or die "no sqlradius export configured for this service type";
552 foreach my $part_export ( @part_export ) {
554 my $dbh = DBI->connect( map { $part_export->option($_) }
555 qw(datasrc username password) )
556 or die "can't connect to sqlradius database: ". $DBI::errstr;
558 #select a unix time conversion function based on database type
560 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
561 $str2time = 'UNIX_TIMESTAMP(';
562 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
563 $str2time = 'EXTRACT( EPOCH FROM ';
565 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
566 "; guessing how to convert to UNIX timestamps";
567 $str2time = 'extract(epoch from ';
570 my @fields = qw( acctstarttime acctstoptime acctsessiontime
571 acctinputoctets acctoutputoctets framedipaddress );
573 my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
576 AND $str2time AcctStopTime ) >= ?
577 AND $str2time AcctStopTime ) <= ?
578 ORDER BY AcctStartTime DESC
579 ") or die $dbh->errstr;
580 $sth->execute($username, $start, $end) or die $sth->errstr;
582 push @sessions, map { { %$_ } } @{ $sth->fetchall_arrayref({}) };
593 Behaviour of changing the svcpart of cust_svc records is undefined and should
594 possibly be prohibited, and pkg_svc records are not checked.
596 pkg_svc records are not checked in general (here).
598 Deleting this record doesn't check or delete the svc_* record associated
601 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
602 a DBI database handle is not yet implemented.
606 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
607 schema.html from the base documentation