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;
18 use FS::domain_record;
22 @ISA = qw( FS::Record );
30 my ( $hashref, $cache ) = @_;
31 if ( $hashref->{'username'} ) {
32 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
34 if ( $hashref->{'svc'} ) {
35 $self->{'_svcpart'} = FS::part_svc->new($hashref);
41 FS::cust_svc - Object method for cust_svc objects
47 $record = new FS::cust_svc \%hash
48 $record = new FS::cust_svc { 'column' => 'value' };
50 $error = $record->insert;
52 $error = $new_record->replace($old_record);
54 $error = $record->delete;
56 $error = $record->check;
58 ($label, $value) = $record->label;
62 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
63 The following fields are currently supported:
67 =item svcnum - primary key (assigned automatically for new services)
69 =item pkgnum - Package (see L<FS::cust_pkg>)
71 =item svcpart - Service definition (see L<FS::part_svc>)
81 Creates a new service. To add the refund to the database, see L<"insert">.
82 Services are normally created by creating FS::svc_ objects (see
83 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
87 sub table { 'cust_svc'; }
91 Adds this service to the database. If there is an error, returns the error,
92 otherwise returns false.
96 Deletes this service from the database. If there is an error, returns the
97 error, otherwise returns false. Note that this only removes the cust_svc
98 record - you should probably use the B<cancel> method instead.
102 Cancels the relevant service by calling the B<cancel> method of the associated
103 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
104 deleting the FS::svc_XXX record and then deleting this record.
106 If there is an error, returns the error, otherwise returns false.
113 local $SIG{HUP} = 'IGNORE';
114 local $SIG{INT} = 'IGNORE';
115 local $SIG{QUIT} = 'IGNORE';
116 local $SIG{TERM} = 'IGNORE';
117 local $SIG{TSTP} = 'IGNORE';
118 local $SIG{PIPE} = 'IGNORE';
120 my $oldAutoCommit = $FS::UID::AutoCommit;
121 local $FS::UID::AutoCommit = 0;
124 my $part_svc = $self->part_svc;
126 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
127 $dbh->rollback if $oldAutoCommit;
128 return "Illegal svcdb value in part_svc!";
131 require "FS/$svcdb.pm";
133 my $svc = $self->svc_x;
135 my $error = $svc->cancel;
137 $dbh->rollback if $oldAutoCommit;
138 return "Error canceling service: $error";
140 $error = $svc->delete;
142 $dbh->rollback if $oldAutoCommit;
143 return "Error deleting service: $error";
147 my $error = $self->delete;
149 $dbh->rollback if $oldAutoCommit;
150 return "Error deleting cust_svc: $error";
153 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
159 =item replace OLD_RECORD
161 Replaces the OLD_RECORD with this one in the database. If there is an error,
162 returns the error, otherwise returns false.
167 my ( $new, $old ) = ( shift, shift );
169 local $SIG{HUP} = 'IGNORE';
170 local $SIG{INT} = 'IGNORE';
171 local $SIG{QUIT} = 'IGNORE';
172 local $SIG{TERM} = 'IGNORE';
173 local $SIG{TSTP} = 'IGNORE';
174 local $SIG{PIPE} = 'IGNORE';
176 my $oldAutoCommit = $FS::UID::AutoCommit;
177 local $FS::UID::AutoCommit = 0;
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, svcpart=>$new->svcpart });
183 local($FS::Record::nowarn_identical) = 1;
184 my $error = $new_svc_x->replace($svc_x);
186 $dbh->rollback if $oldAutoCommit;
187 return $error if $error;
191 my $error = $new->SUPER::replace($old);
193 $dbh->rollback if $oldAutoCommit;
194 return $error if $error;
197 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
204 Checks all fields to make sure this is a valid service. If there is an error,
205 returns the error, otherwise returns false. Called by the insert and
214 $self->ut_numbern('svcnum')
215 || $self->ut_numbern('pkgnum')
216 || $self->ut_number('svcpart')
218 return $error if $error;
220 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
221 return "Unknown svcpart" unless $part_svc;
223 if ( $self->pkgnum ) {
224 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
225 return "Unknown pkgnum" unless $cust_pkg;
226 my $pkg_svc = qsearchs( 'pkg_svc', {
227 'pkgpart' => $cust_pkg->pkgpart,
228 'svcpart' => $self->svcpart,
230 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
231 # 'svcpart' => $self->svcpart,
232 # 'quantity' => 0 } );
233 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
235 my @cust_svc = qsearch('cust_svc', {
236 'pkgnum' => $self->pkgnum,
237 'svcpart' => $self->svcpart,
239 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
240 " services for pkgnum ". $self->pkgnum
241 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
249 Returns the definition for this service, as a FS::part_svc object (see
257 ? $self->{'_svcpart'}
258 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
263 Returns the package this service belongs to, as a FS::cust_pkg object (see
270 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
275 Returns a list consisting of:
276 - The name of this service (from part_svc)
277 - A meaningful identifier (username, domain, or mail alias)
278 - The table name (i.e. svc_domain) for this service
283 my($label, $value, $svcdb) = $cust_svc->label;
289 carp "FS::cust_svc::label called on $self" if $DEBUG;
290 my $svc_x = $self->svc_x
291 or die "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
292 $self->_svc_label($svc_x);
296 my( $self, $svc_x ) = ( shift, shift );
297 my $svcdb = $self->part_svc->svcdb;
300 if ( $svcdb eq 'svc_acct' ) {
301 $tag = $svc_x->email(@_);
302 } elsif ( $svcdb eq 'svc_forward' ) {
303 if ( $svc_x->srcsvc ) {
304 my $svc_acct = $svc_x->srcsvc_acct(@_);
305 $tag = $svc_acct->email(@_);
310 if ( $svc_x->dstsvc ) {
311 my $svc_acct = $svc_x->dstsvc_acct(@_);
312 $tag .= $svc_acct->email(@_);
316 } elsif ( $svcdb eq 'svc_domain' ) {
317 $tag = $svc_x->getfield('domain');
318 } elsif ( $svcdb eq 'svc_www' ) {
319 my $domain_record = $svc_x->domain_record(@_);
320 $tag = $domain_record->zone;
321 } elsif ( $svcdb eq 'svc_broadband' ) {
322 $tag = $svc_x->ip_addr;
323 } elsif ( $svcdb eq 'svc_phone' ) {
324 $tag = $svc_x->phonenum; #XXX format it better
325 } elsif ( $svcdb eq 'svc_external' ) {
326 my $conf = new FS::Conf;
327 if ( $conf->config('svc_external-display_type') eq 'artera_turbo' ) {
328 $tag = sprintf('%010d', $svc_x->id). '-'.
329 substr('0000000000'.uc($svc_x->title), -10);
331 $tag = $svc_x->id. ': '. $svc_x->title;
334 cluck "warning: asked for label of unsupported svcdb; using svcnum";
335 $tag = $svc_x->getfield('svcnum');
338 $self->part_svc->svc, $tag, $svcdb, $self->svcnum;
344 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
345 FS::svc_domain object, etc.)
351 my $svcdb = $self->part_svc->svcdb;
352 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
353 $self->{'_svc_acct'};
355 #require "FS/$svcdb.pm";
356 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
360 =item seconds_since TIMESTAMP
362 See L<FS::svc_acct/seconds_since>. Equivalent to
363 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
364 where B<svcdb> is not "svc_acct".
368 #note: implementation here, POD in FS::svc_acct
370 my($self, $since) = @_;
372 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
375 AND logout IS NOT NULL'
376 ) or die $dbh->errstr;
377 $sth->execute($self->svcnum, $since) or die $sth->errstr;
378 $sth->fetchrow_arrayref->[0];
381 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
383 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
384 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
385 for records where B<svcdb> is not "svc_acct".
389 #note: implementation here, POD in FS::svc_acct
390 sub seconds_since_sqlradacct {
391 my($self, $start, $end) = @_;
393 my $svc_x = $self->svc_x;
395 my @part_export = $self->part_svc->part_export_usage;
396 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
397 " service definition"
402 foreach my $part_export ( @part_export ) {
404 next if $part_export->option('ignore_accounting');
406 my $dbh = DBI->connect( map { $part_export->option($_) }
407 qw(datasrc username password) )
408 or die "can't connect to sqlradius database: ". $DBI::errstr;
410 #select a unix time conversion function based on database type
412 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
413 $str2time = 'UNIX_TIMESTAMP(';
414 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
415 $str2time = 'EXTRACT( EPOCH FROM ';
417 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
418 "; guessing how to convert to UNIX timestamps";
419 $str2time = 'extract(epoch from ';
422 my $username = $part_export->export_username($svc_x);
426 #find closed sessions completely within the given range
427 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
430 AND $str2time AcctStartTime) >= ?
431 AND $str2time AcctStopTime ) < ?
432 AND $str2time AcctStopTime ) > 0
433 AND AcctStopTime IS NOT NULL"
434 ) or die $dbh->errstr;
435 $sth->execute($username, $start, $end) or die $sth->errstr;
436 my $regular = $sth->fetchrow_arrayref->[0];
438 #find open sessions which start in the range, count session start->range end
439 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
442 AND $str2time AcctStartTime ) >= ?
443 AND $str2time AcctStartTime ) < ?
444 AND ( ? - $str2time AcctStartTime ) ) < 86400
445 AND ( $str2time AcctStopTime ) = 0
446 OR AcctStopTime IS NULL )";
447 $sth = $dbh->prepare($query) or die $dbh->errstr;
448 $sth->execute($end, $username, $start, $end, $end)
449 or die $sth->errstr. " executing query $query";
450 my $start_during = $sth->fetchrow_arrayref->[0];
452 #find closed sessions which start before the range but stop during,
453 #count range start->session end
454 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
457 AND $str2time AcctStartTime ) < ?
458 AND $str2time AcctStopTime ) >= ?
459 AND $str2time AcctStopTime ) < ?
460 AND $str2time AcctStopTime ) > 0
461 AND AcctStopTime IS NOT NULL"
462 ) or die $dbh->errstr;
463 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
464 my $end_during = $sth->fetchrow_arrayref->[0];
466 #find closed (not anymore - or open) sessions which start before the range
467 # but stop after, or are still open, count range start->range end
468 # don't count open sessions (probably missing stop record)
469 $sth = $dbh->prepare("SELECT COUNT(*)
472 AND $str2time AcctStartTime ) < ?
473 AND ( $str2time AcctStopTime ) >= ?
475 # OR AcctStopTime = 0
476 # OR AcctStopTime IS NULL )"
477 ) or die $dbh->errstr;
478 $sth->execute($username, $start, $end ) or die $sth->errstr;
479 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
481 $seconds += $regular + $end_during + $start_during + $entire_range;
489 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
491 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
492 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
493 for records where B<svcdb> is not "svc_acct".
497 #note: implementation here, POD in FS::svc_acct
498 #(false laziness w/seconds_since_sqlradacct above)
499 sub attribute_since_sqlradacct {
500 my($self, $start, $end, $attrib) = @_;
502 my $svc_x = $self->svc_x;
504 my @part_export = $self->part_svc->part_export_usage;
505 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
506 " service definition"
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 ';
532 my $username = $part_export->export_username($svc_x);
534 my $sth = $dbh->prepare("SELECT SUM($attrib)
537 AND $str2time AcctStopTime ) >= ?
538 AND $str2time AcctStopTime ) < ?
539 AND AcctStopTime IS NOT NULL"
540 ) or die $dbh->errstr;
541 $sth->execute($username, $start, $end) or die $sth->errstr;
543 $sum += $sth->fetchrow_arrayref->[0];
551 =item get_session_history TIMESTAMP_START TIMESTAMP_END
553 See L<FS::svc_acct/get_session_history>. Equivalent to
554 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
555 records where B<svcdb> is not "svc_acct".
559 sub get_session_history {
560 my($self, $start, $end, $attrib) = @_;
564 my @part_export = $self->part_svc->part_export_usage;
565 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
566 " service definition"
572 foreach my $part_export ( @part_export ) {
574 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
581 =item get_cdrs_for_update
583 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
584 objects (see L<FS::cdr>) associated with this service.
586 Currently CDRs are associated with svc_acct services via a DID in the
587 username. This part is rather tenative and still subject to change...
591 sub get_cdrs_for_update {
592 my($self, %options) = @_;
594 my $default_prefix = $options{'default_prefix'};
596 #CDRs are now associated with svc_phone services via svc_phone.phonenum
597 #return () unless $self->svc_x->isa('FS::svc_phone');
598 return () unless $self->part_svc->svcdb eq 'svc_phone';
599 my $number = $self->svc_x->phonenum;
604 'hashref' => { 'freesidestatus' => '',
605 'charged_party' => $number
607 'extra_sql' => 'FOR UPDATE',
610 if ( length($default_prefix) ) {
614 'hashref' => { 'freesidestatus' => '',
615 'charged_party' => "$default_prefix$number",
617 'extra_sql' => 'FOR UPDATE',
626 Returns the pkg_svc record for for this service, if applicable.
632 my $cust_pkg = $self->cust_pkg;
633 return undef unless $cust_pkg;
635 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
636 'pkgpart' => $cust_pkg->pkgpart,
645 Behaviour of changing the svcpart of cust_svc records is undefined and should
646 possibly be prohibited, and pkg_svc records are not checked.
648 pkg_svc records are not checked in general (here).
650 Deleting this record doesn't check or delete the svc_* record associated
653 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
654 a DBI database handle is not yet implemented.
658 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
659 schema.html from the base documentation