4 use vars qw( @ISA $DEBUG $me $ignore_quantity );
5 use Carp qw( carp cluck );
7 use FS::Record qw( qsearch qsearchs dbh );
15 use FS::svc_broadband;
18 use FS::domain_record;
22 @ISA = qw( FS::Record );
31 my ( $hashref, $cache ) = @_;
32 if ( $hashref->{'username'} ) {
33 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
35 if ( $hashref->{'svc'} ) {
36 $self->{'_svcpart'} = FS::part_svc->new($hashref);
42 FS::cust_svc - Object method for cust_svc objects
48 $record = new FS::cust_svc \%hash
49 $record = new FS::cust_svc { 'column' => 'value' };
51 $error = $record->insert;
53 $error = $new_record->replace($old_record);
55 $error = $record->delete;
57 $error = $record->check;
59 ($label, $value) = $record->label;
63 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
64 The following fields are currently supported:
68 =item svcnum - primary key (assigned automatically for new services)
70 =item pkgnum - Package (see L<FS::cust_pkg>)
72 =item svcpart - Service definition (see L<FS::part_svc>)
82 Creates a new service. To add the refund to the database, see L<"insert">.
83 Services are normally created by creating FS::svc_ objects (see
84 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
88 sub table { 'cust_svc'; }
92 Adds this service to the database. If there is an error, returns the error,
93 otherwise returns false.
97 Deletes this service from the database. If there is an error, returns the
98 error, otherwise returns false. Note that this only removes the cust_svc
99 record - you should probably use the B<cancel> method instead.
103 Cancels the relevant service by calling the B<cancel> method of the associated
104 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
105 deleting the FS::svc_XXX record and then deleting this record.
107 If there is an error, returns the error, otherwise returns false.
114 local $SIG{HUP} = 'IGNORE';
115 local $SIG{INT} = 'IGNORE';
116 local $SIG{QUIT} = 'IGNORE';
117 local $SIG{TERM} = 'IGNORE';
118 local $SIG{TSTP} = 'IGNORE';
119 local $SIG{PIPE} = 'IGNORE';
121 my $oldAutoCommit = $FS::UID::AutoCommit;
122 local $FS::UID::AutoCommit = 0;
125 my $part_svc = $self->part_svc;
127 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
128 $dbh->rollback if $oldAutoCommit;
129 return "Illegal svcdb value in part_svc!";
132 require "FS/$svcdb.pm";
134 my $svc = $self->svc_x;
136 my $error = $svc->cancel;
138 $dbh->rollback if $oldAutoCommit;
139 return "Error canceling service: $error";
141 $error = $svc->delete;
143 $dbh->rollback if $oldAutoCommit;
144 return "Error deleting service: $error";
148 my $error = $self->delete;
150 $dbh->rollback if $oldAutoCommit;
151 return "Error deleting cust_svc: $error";
154 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
160 =item replace OLD_RECORD
162 Replaces the OLD_RECORD with this one in the database. If there is an error,
163 returns the error, otherwise returns false.
168 my ( $new, $old ) = ( shift, shift );
170 local $SIG{HUP} = 'IGNORE';
171 local $SIG{INT} = 'IGNORE';
172 local $SIG{QUIT} = 'IGNORE';
173 local $SIG{TERM} = 'IGNORE';
174 local $SIG{TSTP} = 'IGNORE';
175 local $SIG{PIPE} = 'IGNORE';
177 my $oldAutoCommit = $FS::UID::AutoCommit;
178 local $FS::UID::AutoCommit = 0;
181 if ( $new->svcpart != $old->svcpart ) {
182 my $svc_x = $new->svc_x;
183 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
184 local($FS::Record::nowarn_identical) = 1;
185 my $error = $new_svc_x->replace($svc_x);
187 $dbh->rollback if $oldAutoCommit;
188 return $error if $error;
192 my $error = $new->SUPER::replace($old);
194 $dbh->rollback if $oldAutoCommit;
195 return $error if $error;
198 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
205 Checks all fields to make sure this is a valid service. If there is an error,
206 returns the error, otherwise returns false. Called by the insert and
215 $self->ut_numbern('svcnum')
216 || $self->ut_numbern('pkgnum')
217 || $self->ut_number('svcpart')
219 return $error if $error;
221 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
222 return "Unknown svcpart" unless $part_svc;
224 if ( $self->pkgnum ) {
225 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
226 return "Unknown pkgnum" unless $cust_pkg;
227 my $pkg_svc = qsearchs( 'pkg_svc', {
228 'pkgpart' => $cust_pkg->pkgpart,
229 'svcpart' => $self->svcpart,
231 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
232 # 'svcpart' => $self->svcpart,
233 # 'quantity' => 0 } );
234 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
236 my @cust_svc = qsearch('cust_svc', {
237 'pkgnum' => $self->pkgnum,
238 'svcpart' => $self->svcpart,
240 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
241 " services for pkgnum ". $self->pkgnum
242 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
250 Returns the definition for this service, as a FS::part_svc object (see
258 ? $self->{'_svcpart'}
259 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
264 Returns the package this service belongs to, as a FS::cust_pkg object (see
271 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
276 Returns a list consisting of:
277 - The name of this service (from part_svc)
278 - A meaningful identifier (username, domain, or mail alias)
279 - The table name (i.e. svc_domain) for this service
284 my($label, $value, $svcdb) = $cust_svc->label;
290 carp "FS::cust_svc::label called on $self" if $DEBUG;
291 my $svc_x = $self->svc_x
292 or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
293 $self->_svc_label($svc_x);
297 my( $self, $svc_x ) = ( shift, shift );
298 my $svcdb = $self->part_svc->svcdb;
301 if ( $svcdb eq 'svc_acct' ) {
302 $tag = $svc_x->email(@_);
303 } elsif ( $svcdb eq 'svc_forward' ) {
304 if ( $svc_x->srcsvc ) {
305 my $svc_acct = $svc_x->srcsvc_acct(@_);
306 $tag = $svc_acct->email(@_);
311 if ( $svc_x->dstsvc ) {
312 my $svc_acct = $svc_x->dstsvc_acct(@_);
313 $tag .= $svc_acct->email(@_);
317 } elsif ( $svcdb eq 'svc_domain' ) {
318 $tag = $svc_x->getfield('domain');
319 } elsif ( $svcdb eq 'svc_www' ) {
320 my $domain_record = $svc_x->domain_record(@_);
321 $tag = $domain_record->zone;
322 } elsif ( $svcdb eq 'svc_broadband' ) {
323 $tag = $svc_x->ip_addr;
324 } elsif ( $svcdb eq 'svc_phone' ) {
325 $tag = $svc_x->phonenum; #XXX format it better
326 } elsif ( $svcdb eq 'svc_external' ) {
327 my $conf = new FS::Conf;
328 if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
329 $tag = sprintf('%010d', $svc_x->id). '-'.
330 substr('0000000000'.uc($svc_x->title), -10);
332 $tag = $svc_x->id. ': '. $svc_x->title;
335 cluck "warning: asked for label of unsupported svcdb; using svcnum";
336 $tag = $svc_x->getfield('svcnum');
339 $self->part_svc->svc, $tag, $svcdb, $self->svcnum;
345 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
346 FS::svc_domain object, etc.)
352 my $svcdb = $self->part_svc->svcdb;
353 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
354 $self->{'_svc_acct'};
356 #require "FS/$svcdb.pm";
357 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
358 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
360 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
364 =item seconds_since TIMESTAMP
366 See L<FS::svc_acct/seconds_since>. Equivalent to
367 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
368 where B<svcdb> is not "svc_acct".
372 #note: implementation here, POD in FS::svc_acct
374 my($self, $since) = @_;
376 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
379 AND logout IS NOT NULL'
380 ) or die $dbh->errstr;
381 $sth->execute($self->svcnum, $since) or die $sth->errstr;
382 $sth->fetchrow_arrayref->[0];
385 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
387 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
388 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
389 for records where B<svcdb> is not "svc_acct".
393 #note: implementation here, POD in FS::svc_acct
394 sub seconds_since_sqlradacct {
395 my($self, $start, $end) = @_;
397 my $svc_x = $self->svc_x;
399 my @part_export = $self->part_svc->part_export_usage;
400 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
401 " service definition"
406 foreach my $part_export ( @part_export ) {
408 next if $part_export->option('ignore_accounting');
410 my $dbh = DBI->connect( map { $part_export->option($_) }
411 qw(datasrc username password) )
412 or die "can't connect to sqlradius database: ". $DBI::errstr;
414 #select a unix time conversion function based on database type
416 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
417 $str2time = 'UNIX_TIMESTAMP(';
418 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
419 $str2time = 'EXTRACT( EPOCH FROM ';
421 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
422 "; guessing how to convert to UNIX timestamps";
423 $str2time = 'extract(epoch from ';
426 my $username = $part_export->export_username($svc_x);
430 #find closed sessions completely within the given range
431 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
434 AND $str2time AcctStartTime) >= ?
435 AND $str2time AcctStopTime ) < ?
436 AND $str2time AcctStopTime ) > 0
437 AND AcctStopTime IS NOT NULL"
438 ) or die $dbh->errstr;
439 $sth->execute($username, $start, $end) or die $sth->errstr;
440 my $regular = $sth->fetchrow_arrayref->[0];
442 #find open sessions which start in the range, count session start->range end
443 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
446 AND $str2time AcctStartTime ) >= ?
447 AND $str2time AcctStartTime ) < ?
448 AND ( ? - $str2time AcctStartTime ) ) < 86400
449 AND ( $str2time AcctStopTime ) = 0
450 OR AcctStopTime IS NULL )";
451 $sth = $dbh->prepare($query) or die $dbh->errstr;
452 $sth->execute($end, $username, $start, $end, $end)
453 or die $sth->errstr. " executing query $query";
454 my $start_during = $sth->fetchrow_arrayref->[0];
456 #find closed sessions which start before the range but stop during,
457 #count range start->session end
458 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
461 AND $str2time AcctStartTime ) < ?
462 AND $str2time AcctStopTime ) >= ?
463 AND $str2time AcctStopTime ) < ?
464 AND $str2time AcctStopTime ) > 0
465 AND AcctStopTime IS NOT NULL"
466 ) or die $dbh->errstr;
467 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
468 my $end_during = $sth->fetchrow_arrayref->[0];
470 #find closed (not anymore - or open) sessions which start before the range
471 # but stop after, or are still open, count range start->range end
472 # don't count open sessions (probably missing stop record)
473 $sth = $dbh->prepare("SELECT COUNT(*)
476 AND $str2time AcctStartTime ) < ?
477 AND ( $str2time AcctStopTime ) >= ?
479 # OR AcctStopTime = 0
480 # OR AcctStopTime IS NULL )"
481 ) or die $dbh->errstr;
482 $sth->execute($username, $start, $end ) or die $sth->errstr;
483 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
485 $seconds += $regular + $end_during + $start_during + $entire_range;
493 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
495 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
496 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
497 for records where B<svcdb> is not "svc_acct".
501 #note: implementation here, POD in FS::svc_acct
502 #(false laziness w/seconds_since_sqlradacct above)
503 sub attribute_since_sqlradacct {
504 my($self, $start, $end, $attrib) = @_;
506 my $svc_x = $self->svc_x;
508 my @part_export = $self->part_svc->part_export_usage;
509 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
510 " service definition"
516 foreach my $part_export ( @part_export ) {
518 next if $part_export->option('ignore_accounting');
520 my $dbh = DBI->connect( map { $part_export->option($_) }
521 qw(datasrc username password) )
522 or die "can't connect to sqlradius database: ". $DBI::errstr;
524 #select a unix time conversion function based on database type
526 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
527 $str2time = 'UNIX_TIMESTAMP(';
528 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
529 $str2time = 'EXTRACT( EPOCH FROM ';
531 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
532 "; guessing how to convert to UNIX timestamps";
533 $str2time = 'extract(epoch from ';
536 my $username = $part_export->export_username($svc_x);
538 my $sth = $dbh->prepare("SELECT SUM($attrib)
541 AND $str2time AcctStopTime ) >= ?
542 AND $str2time AcctStopTime ) < ?
543 AND AcctStopTime IS NOT NULL"
544 ) or die $dbh->errstr;
545 $sth->execute($username, $start, $end) or die $sth->errstr;
547 $sum += $sth->fetchrow_arrayref->[0];
555 =item get_session_history TIMESTAMP_START TIMESTAMP_END
557 See L<FS::svc_acct/get_session_history>. Equivalent to
558 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
559 records where B<svcdb> is not "svc_acct".
563 sub get_session_history {
564 my($self, $start, $end, $attrib) = @_;
568 my @part_export = $self->part_svc->part_export_usage;
569 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
570 " service definition"
576 foreach my $part_export ( @part_export ) {
578 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
585 =item get_cdrs_for_update
587 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
588 objects (see L<FS::cdr>) associated with this service.
590 Currently CDRs are associated with svc_acct services via a DID in the
591 username. This part is rather tenative and still subject to change...
595 sub get_cdrs_for_update {
596 my($self, %options) = @_;
598 my $default_prefix = $options{'default_prefix'};
600 #CDRs are now associated with svc_phone services via svc_phone.phonenum
601 #return () unless $self->svc_x->isa('FS::svc_phone');
602 return () unless $self->part_svc->svcdb eq 'svc_phone';
603 my $number = $self->svc_x->phonenum;
608 'hashref' => { 'freesidestatus' => '',
609 'charged_party' => $number
611 'extra_sql' => 'FOR UPDATE',
614 if ( length($default_prefix) ) {
618 'hashref' => { 'freesidestatus' => '',
619 'charged_party' => "$default_prefix$number",
621 'extra_sql' => 'FOR UPDATE',
630 Returns the pkg_svc record for for this service, if applicable.
636 my $cust_pkg = $self->cust_pkg;
637 return undef unless $cust_pkg;
639 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
640 'pkgpart' => $cust_pkg->pkgpart,
649 Behaviour of changing the svcpart of cust_svc records is undefined and should
650 possibly be prohibited, and pkg_svc records are not checked.
652 pkg_svc records are not checked in general (here).
654 Deleting this record doesn't check or delete the svc_* record associated
657 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
658 a DBI database handle is not yet implemented.
662 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
663 schema.html from the base documentation