4 use vars qw( @ISA $ignore_quantity );
7 use FS::Record qw( qsearch qsearchs dbh );
15 use FS::svc_broadband;
17 use FS::domain_record;
20 @ISA = qw( FS::Record );
26 my ( $hashref, $cache ) = @_;
27 if ( $hashref->{'username'} ) {
28 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
30 if ( $hashref->{'svc'} ) {
31 $self->{'_svcpart'} = FS::part_svc->new($hashref);
37 FS::cust_svc - Object method for cust_svc objects
43 $record = new FS::cust_svc \%hash
44 $record = new FS::cust_svc { 'column' => 'value' };
46 $error = $record->insert;
48 $error = $new_record->replace($old_record);
50 $error = $record->delete;
52 $error = $record->check;
54 ($label, $value) = $record->label;
58 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
59 The following fields are currently supported:
63 =item svcnum - primary key (assigned automatically for new services)
65 =item pkgnum - Package (see L<FS::cust_pkg>)
67 =item svcpart - Service definition (see L<FS::part_svc>)
77 Creates a new service. To add the refund to the database, see L<"insert">.
78 Services are normally created by creating FS::svc_ objects (see
79 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
83 sub table { 'cust_svc'; }
87 Adds this service to the database. If there is an error, returns the error,
88 otherwise returns false.
92 Deletes this service from the database. If there is an error, returns the
93 error, otherwise returns false. Note that this only removes the cust_svc
94 record - you should probably use the B<cancel> method instead.
98 Cancels the relevant service by calling the B<cancel> method of the associated
99 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
100 deleting the FS::svc_XXX record and then deleting this record.
102 If there is an error, returns the error, otherwise returns false.
109 local $SIG{HUP} = 'IGNORE';
110 local $SIG{INT} = 'IGNORE';
111 local $SIG{QUIT} = 'IGNORE';
112 local $SIG{TERM} = 'IGNORE';
113 local $SIG{TSTP} = 'IGNORE';
114 local $SIG{PIPE} = 'IGNORE';
116 my $oldAutoCommit = $FS::UID::AutoCommit;
117 local $FS::UID::AutoCommit = 0;
120 my $part_svc = $self->part_svc;
122 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
123 $dbh->rollback if $oldAutoCommit;
124 return "Illegal svcdb value in part_svc!";
127 require "FS/$svcdb.pm";
129 my $svc = $self->svc_x;
131 my $error = $svc->cancel;
133 $dbh->rollback if $oldAutoCommit;
134 return "Error canceling service: $error";
136 $error = $svc->delete;
138 $dbh->rollback if $oldAutoCommit;
139 return "Error deleting service: $error";
143 my $error = $self->delete;
145 $dbh->rollback if $oldAutoCommit;
146 return "Error deleting cust_svc: $error";
149 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
155 =item replace OLD_RECORD
157 Replaces the OLD_RECORD with this one in the database. If there is an error,
158 returns the error, otherwise returns false.
163 my ( $new, $old ) = ( shift, shift );
165 local $SIG{HUP} = 'IGNORE';
166 local $SIG{INT} = 'IGNORE';
167 local $SIG{QUIT} = 'IGNORE';
168 local $SIG{TERM} = 'IGNORE';
169 local $SIG{TSTP} = 'IGNORE';
170 local $SIG{PIPE} = 'IGNORE';
172 my $oldAutoCommit = $FS::UID::AutoCommit;
173 local $FS::UID::AutoCommit = 0;
176 if ( $new->svcpart != $old->svcpart ) {
177 my $svc_x = $new->svc_x;
178 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
179 my $error = $new_svc_x->replace($svc_x);
181 $dbh->rollback if $oldAutoCommit;
182 return $error if $error;
186 my $error = $new->SUPER::replace($old);
188 $dbh->rollback if $oldAutoCommit;
189 return $error if $error;
192 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
199 Checks all fields to make sure this is a valid service. If there is an error,
200 returns the error, otehrwise returns false. Called by the insert and
209 $self->ut_numbern('svcnum')
210 || $self->ut_numbern('pkgnum')
211 || $self->ut_number('svcpart')
213 return $error if $error;
215 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
216 return "Unknown svcpart" unless $part_svc;
218 if ( $self->pkgnum ) {
219 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
220 return "Unknown pkgnum" unless $cust_pkg;
221 my $pkg_svc = qsearchs( 'pkg_svc', {
222 'pkgpart' => $cust_pkg->pkgpart,
223 'svcpart' => $self->svcpart,
225 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
226 # 'svcpart' => $self->svcpart,
227 # 'quantity' => 0 } );
228 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
230 my @cust_svc = qsearch('cust_svc', {
231 'pkgnum' => $self->pkgnum,
232 'svcpart' => $self->svcpart,
234 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
235 " services for pkgnum ". $self->pkgnum
236 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
244 Returns the definition for this service, as a FS::part_svc object (see
252 ? $self->{'_svcpart'}
253 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
258 Returns the definition for this service, as a FS::part_svc object (see
265 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
270 Returns a list consisting of:
271 - The name of this service (from part_svc)
272 - A meaningful identifier (username, domain, or mail alias)
273 - The table name (i.e. svc_domain) for this service
279 my $svcdb = $self->part_svc->svcdb;
280 my $svc_x = $self->svc_x
281 or die "can't find $svcdb.svcnum ". $self->svcnum;
283 if ( $svcdb eq 'svc_acct' ) {
284 $tag = $svc_x->email;
285 } elsif ( $svcdb eq 'svc_forward' ) {
286 if ( $svc_x->srcsvc ) {
287 my $svc_acct = $svc_x->srcsvc_acct;
288 $tag = $svc_acct->email;
293 if ( $svc_x->dstsvc ) {
294 my $svc_acct = $svc_x->dstsvc_acct;
295 $tag .= $svc_acct->email;
299 } elsif ( $svcdb eq 'svc_domain' ) {
300 $tag = $svc_x->getfield('domain');
301 } elsif ( $svcdb eq 'svc_www' ) {
302 my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
303 $tag = $domain->zone;
304 } elsif ( $svcdb eq 'svc_broadband' ) {
305 $tag = $svc_x->ip_addr;
306 } elsif ( $svcdb eq 'svc_external' ) {
307 my $conf = new FS::Conf;
308 if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
309 $tag = sprintf('%010d', $svc_x->id). '-'. $svc_x->title;
311 $tag = $svc_x->id. ': '. $svc_x->title;
314 cluck "warning: asked for label of unsupported svcdb; using svcnum";
315 $tag = $svc_x->getfield('svcnum');
317 $self->part_svc->svc, $tag, $svcdb;
322 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
323 FS::svc_domain object, etc.)
329 my $svcdb = $self->part_svc->svcdb;
330 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
331 $self->{'_svc_acct'};
333 #require "FS/$svcdb.pm";
334 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
338 =item seconds_since TIMESTAMP
340 See L<FS::svc_acct/seconds_since>. Equivalent to
341 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
342 where B<svcdb> is not "svc_acct".
346 #note: implementation here, POD in FS::svc_acct
348 my($self, $since) = @_;
350 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
353 AND logout IS NOT NULL'
354 ) or die $dbh->errstr;
355 $sth->execute($self->svcnum, $since) or die $sth->errstr;
356 $sth->fetchrow_arrayref->[0];
359 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
361 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
362 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
363 for records where B<svcdb> is not "svc_acct".
367 #note: implementation here, POD in FS::svc_acct
368 sub seconds_since_sqlradacct {
369 my($self, $start, $end) = @_;
371 my $svc_x = $self->svc_x;
373 my @part_export = $self->part_svc->part_export('sqlradius');
374 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
375 die "no sqlradius or sqlradius_withdomain export configured for this".
381 foreach my $part_export ( @part_export ) {
383 next if $part_export->option('ignore_accounting');
385 my $dbh = DBI->connect( map { $part_export->option($_) }
386 qw(datasrc username password) )
387 or die "can't connect to sqlradius database: ". $DBI::errstr;
389 #select a unix time conversion function based on database type
391 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
392 $str2time = 'UNIX_TIMESTAMP(';
393 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
394 $str2time = 'EXTRACT( EPOCH FROM ';
396 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
397 "; guessing how to convert to UNIX timestamps";
398 $str2time = 'extract(epoch from ';
402 if ( $part_export->exporttype eq 'sqlradius' ) {
403 $username = $svc_x->username;
404 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
405 $username = $svc_x->email;
407 die 'unknown exporttype '. $part_export->exporttype;
412 #find closed sessions completely within the given range
413 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
416 AND $str2time AcctStartTime) >= ?
417 AND $str2time AcctStopTime ) < ?
418 AND $str2time AcctStopTime ) > 0
419 AND AcctStopTime IS NOT NULL"
420 ) or die $dbh->errstr;
421 $sth->execute($username, $start, $end) or die $sth->errstr;
422 my $regular = $sth->fetchrow_arrayref->[0];
424 #find open sessions which start in the range, count session start->range end
425 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
428 AND $str2time AcctStartTime ) >= ?
429 AND $str2time AcctStartTime ) < ?
430 AND ( ? - $str2time AcctStartTime ) ) < 86400
431 AND ( $str2time AcctStopTime ) = 0
432 OR AcctStopTime IS NULL )";
433 $sth = $dbh->prepare($query) or die $dbh->errstr;
434 $sth->execute($end, $username, $start, $end, $end)
435 or die $sth->errstr. " executing query $query";
436 my $start_during = $sth->fetchrow_arrayref->[0];
438 #find closed sessions which start before the range but stop during,
439 #count range start->session end
440 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
443 AND $str2time AcctStartTime ) < ?
444 AND $str2time AcctStopTime ) >= ?
445 AND $str2time AcctStopTime ) < ?
446 AND $str2time AcctStopTime ) > 0
447 AND AcctStopTime IS NOT NULL"
448 ) or die $dbh->errstr;
449 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
450 my $end_during = $sth->fetchrow_arrayref->[0];
452 #find closed (not anymore - or open) sessions which start before the range
453 # but stop after, or are still open, count range start->range end
454 # don't count open sessions (probably missing stop record)
455 $sth = $dbh->prepare("SELECT COUNT(*)
458 AND $str2time AcctStartTime ) < ?
459 AND ( $str2time AcctStopTime ) >= ?
461 # OR AcctStopTime = 0
462 # OR AcctStopTime IS NULL )"
463 ) or die $dbh->errstr;
464 $sth->execute($username, $start, $end ) or die $sth->errstr;
465 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
467 $seconds += $regular + $end_during + $start_during + $entire_range;
475 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
477 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
478 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
479 for records where B<svcdb> is not "svc_acct".
483 #note: implementation here, POD in FS::svc_acct
484 #(false laziness w/seconds_since_sqlradacct above)
485 sub attribute_since_sqlradacct {
486 my($self, $start, $end, $attrib) = @_;
488 my $svc_x = $self->svc_x;
490 my @part_export = $self->part_svc->part_export('sqlradius');
491 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
492 die "no sqlradius or sqlradius_withdomain export configured for this".
499 foreach my $part_export ( @part_export ) {
501 next if $part_export->option('ignore_accounting');
503 my $dbh = DBI->connect( map { $part_export->option($_) }
504 qw(datasrc username password) )
505 or die "can't connect to sqlradius database: ". $DBI::errstr;
507 #select a unix time conversion function based on database type
509 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
510 $str2time = 'UNIX_TIMESTAMP(';
511 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
512 $str2time = 'EXTRACT( EPOCH FROM ';
514 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
515 "; guessing how to convert to UNIX timestamps";
516 $str2time = 'extract(epoch from ';
520 if ( $part_export->exporttype eq 'sqlradius' ) {
521 $username = $svc_x->username;
522 } elsif ( $part_export->exporttype eq 'sqlradius_withdomain' ) {
523 $username = $svc_x->email;
525 die 'unknown exporttype '. $part_export->exporttype;
528 my $sth = $dbh->prepare("SELECT SUM($attrib)
531 AND $str2time AcctStopTime ) >= ?
532 AND $str2time AcctStopTime ) < ?
533 AND AcctStopTime IS NOT NULL"
534 ) or die $dbh->errstr;
535 $sth->execute($username, $start, $end) or die $sth->errstr;
537 $sum += $sth->fetchrow_arrayref->[0];
545 =item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END
547 See L<FS::svc_acct/get_session_history_sqlradacct>. Equivalent to
548 $cust_svc->svc_x->get_session_history_sqlradacct, but more efficient.
549 Meaningless for records where B<svcdb> is not "svc_acct".
553 sub get_session_history {
554 my($self, $start, $end, $attrib) = @_;
558 #my @part_export = $cust_svc->part_svc->part_export->can('usage_sessions');
559 my @part_export = $self->part_svc->part_export('sqlradius');
560 push @part_export, $self->part_svc->part_export('sqlradius_withdomain');
561 die "no sqlradius or sqlradius_withdomain export configured for this".
568 foreach my $part_export ( @part_export ) {
569 push @sessions, $part_export->usage_sessions( $self->svc_x, $start, $end );
578 Returns the pkg_svc record for for this service, if applicable.
584 my $cust_pkg = $self->cust_pkg;
585 return undef unless $cust_pkg;
587 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
588 'pkgpart' => $cust_pkg->pkgpart,
597 Behaviour of changing the svcpart of cust_svc records is undefined and should
598 possibly be prohibited, and pkg_svc records are not checked.
600 pkg_svc records are not checked in general (here).
602 Deleting this record doesn't check or delete the svc_* record associated
605 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
606 a DBI database handle is not yet implemented.
610 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
611 schema.html from the base documentation