4 use vars qw( @ISA $DEBUG $me $ignore_quantity );
7 use FS::Record qw( qsearch qsearchs dbh );
12 use FS::domain_record;
16 #most FS::svc_ classes are autoloaded in svc_x emthod
17 use FS::svc_acct; #this one is used in the cache stuff
19 @ISA = qw( FS::cust_main_Mixin FS::Record );
28 my ( $hashref, $cache ) = @_;
29 if ( $hashref->{'username'} ) {
30 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
32 if ( $hashref->{'svc'} ) {
33 $self->{'_svcpart'} = FS::part_svc->new($hashref);
39 FS::cust_svc - Object method for cust_svc objects
45 $record = new FS::cust_svc \%hash
46 $record = new FS::cust_svc { 'column' => 'value' };
48 $error = $record->insert;
50 $error = $new_record->replace($old_record);
52 $error = $record->delete;
54 $error = $record->check;
56 ($label, $value) = $record->label;
60 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
61 The following fields are currently supported:
65 =item svcnum - primary key (assigned automatically for new services)
67 =item pkgnum - Package (see L<FS::cust_pkg>)
69 =item svcpart - Service definition (see L<FS::part_svc>)
79 Creates a new service. To add the refund to the database, see L<"insert">.
80 Services are normally created by creating FS::svc_ objects (see
81 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
85 sub table { 'cust_svc'; }
89 Adds this service to the database. If there is an error, returns the error,
90 otherwise returns false.
94 Deletes this service from the database. If there is an error, returns the
95 error, otherwise returns false. Note that this only removes the cust_svc
96 record - you should probably use the B<cancel> method instead.
100 Cancels the relevant service by calling the B<cancel> method of the associated
101 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
102 deleting the FS::svc_XXX record and then deleting this record.
104 If there is an error, returns the error, otherwise returns false.
111 local $SIG{HUP} = 'IGNORE';
112 local $SIG{INT} = 'IGNORE';
113 local $SIG{QUIT} = 'IGNORE';
114 local $SIG{TERM} = 'IGNORE';
115 local $SIG{TSTP} = 'IGNORE';
116 local $SIG{PIPE} = 'IGNORE';
118 my $oldAutoCommit = $FS::UID::AutoCommit;
119 local $FS::UID::AutoCommit = 0;
122 my $part_svc = $self->part_svc;
124 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
125 $dbh->rollback if $oldAutoCommit;
126 return "Illegal svcdb value in part_svc!";
129 require "FS/$svcdb.pm";
131 my $svc = $self->svc_x;
133 my $error = $svc->cancel;
135 $dbh->rollback if $oldAutoCommit;
136 return "Error canceling service: $error";
138 $error = $svc->delete;
140 $dbh->rollback if $oldAutoCommit;
141 return "Error deleting service: $error";
145 my $error = $self->delete;
147 $dbh->rollback if $oldAutoCommit;
148 return "Error deleting cust_svc: $error";
151 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
157 =item replace OLD_RECORD
159 Replaces the OLD_RECORD with this one in the database. If there is an error,
160 returns the error, otherwise returns false.
165 my ( $new, $old ) = ( shift, shift );
167 local $SIG{HUP} = 'IGNORE';
168 local $SIG{INT} = 'IGNORE';
169 local $SIG{QUIT} = 'IGNORE';
170 local $SIG{TERM} = 'IGNORE';
171 local $SIG{TSTP} = 'IGNORE';
172 local $SIG{PIPE} = 'IGNORE';
174 my $oldAutoCommit = $FS::UID::AutoCommit;
175 local $FS::UID::AutoCommit = 0;
178 if ( $new->svcpart != $old->svcpart ) {
179 my $svc_x = $new->svc_x;
180 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
181 local($FS::Record::nowarn_identical) = 1;
182 my $error = $new_svc_x->replace($svc_x);
184 $dbh->rollback if $oldAutoCommit;
185 return $error if $error;
189 my $error = $new->SUPER::replace($old);
191 $dbh->rollback if $oldAutoCommit;
192 return $error if $error;
195 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
202 Checks all fields to make sure this is a valid service. If there is an error,
203 returns the error, otherwise returns false. Called by the insert and
212 $self->ut_numbern('svcnum')
213 || $self->ut_numbern('pkgnum')
214 || $self->ut_number('svcpart')
216 return $error if $error;
218 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
219 return "Unknown svcpart" unless $part_svc;
221 if ( $self->pkgnum ) {
222 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
223 return "Unknown pkgnum" unless $cust_pkg;
224 my $pkg_svc = qsearchs( 'pkg_svc', {
225 'pkgpart' => $cust_pkg->pkgpart,
226 'svcpart' => $self->svcpart,
228 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
229 # 'svcpart' => $self->svcpart,
230 # 'quantity' => 0 } );
231 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
233 my @cust_svc = qsearch('cust_svc', {
234 'pkgnum' => $self->pkgnum,
235 'svcpart' => $self->svcpart,
237 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
238 " services for pkgnum ". $self->pkgnum
239 if scalar(@cust_svc) >= $quantity && !$ignore_quantity;
247 Returns the definition for this service, as a FS::part_svc object (see
255 ? $self->{'_svcpart'}
256 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
261 Returns the package this service belongs to, as a FS::cust_pkg object (see
268 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
273 Returns a list consisting of:
274 - The name of this service (from part_svc)
275 - A meaningful identifier (username, domain, or mail alias)
276 - The table name (i.e. svc_domain) for this service
281 my($label, $value, $svcdb) = $cust_svc->label;
287 carp "FS::cust_svc::label called on $self" if $DEBUG;
288 my $svc_x = $self->svc_x
289 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
291 $self->_svc_label($svc_x);
295 my( $self, $svc_x ) = ( shift, shift );
298 $self->part_svc->svc,
300 $self->part_svc->svcdb,
308 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
309 FS::svc_domain object, etc.)
315 my $svcdb = $self->part_svc->svcdb;
316 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
317 $self->{'_svc_acct'};
319 require "FS/$svcdb.pm";
320 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
321 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
323 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
327 =item seconds_since TIMESTAMP
329 See L<FS::svc_acct/seconds_since>. Equivalent to
330 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
331 where B<svcdb> is not "svc_acct".
335 #note: implementation here, POD in FS::svc_acct
337 my($self, $since) = @_;
339 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
342 AND logout IS NOT NULL'
343 ) or die $dbh->errstr;
344 $sth->execute($self->svcnum, $since) or die $sth->errstr;
345 $sth->fetchrow_arrayref->[0];
348 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
350 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
351 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
352 for records where B<svcdb> is not "svc_acct".
356 #note: implementation here, POD in FS::svc_acct
357 sub seconds_since_sqlradacct {
358 my($self, $start, $end) = @_;
360 my $svc_x = $self->svc_x;
362 my @part_export = $self->part_svc->part_export_usage;
363 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
364 " service definition"
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} =~ /^mysql(PP)?$/ ) {
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 ';
389 my $username = $part_export->export_username($svc_x);
393 #find closed sessions completely within the given range
394 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
397 AND $str2time AcctStartTime) >= ?
398 AND $str2time AcctStopTime ) < ?
399 AND $str2time AcctStopTime ) > 0
400 AND AcctStopTime IS NOT NULL"
401 ) or die $dbh->errstr;
402 $sth->execute($username, $start, $end) or die $sth->errstr;
403 my $regular = $sth->fetchrow_arrayref->[0];
405 #find open sessions which start in the range, count session start->range end
406 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
409 AND $str2time AcctStartTime ) >= ?
410 AND $str2time AcctStartTime ) < ?
411 AND ( ? - $str2time AcctStartTime ) ) < 86400
412 AND ( $str2time AcctStopTime ) = 0
413 OR AcctStopTime IS NULL )";
414 $sth = $dbh->prepare($query) or die $dbh->errstr;
415 $sth->execute($end, $username, $start, $end, $end)
416 or die $sth->errstr. " executing query $query";
417 my $start_during = $sth->fetchrow_arrayref->[0];
419 #find closed sessions which start before the range but stop during,
420 #count range start->session end
421 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
424 AND $str2time AcctStartTime ) < ?
425 AND $str2time AcctStopTime ) >= ?
426 AND $str2time AcctStopTime ) < ?
427 AND $str2time AcctStopTime ) > 0
428 AND AcctStopTime IS NOT NULL"
429 ) or die $dbh->errstr;
430 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
431 my $end_during = $sth->fetchrow_arrayref->[0];
433 #find closed (not anymore - or open) sessions which start before the range
434 # but stop after, or are still open, count range start->range end
435 # don't count open sessions (probably missing stop record)
436 $sth = $dbh->prepare("SELECT COUNT(*)
439 AND $str2time AcctStartTime ) < ?
440 AND ( $str2time AcctStopTime ) >= ?
442 # OR AcctStopTime = 0
443 # OR AcctStopTime IS NULL )"
444 ) or die $dbh->errstr;
445 $sth->execute($username, $start, $end ) or die $sth->errstr;
446 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
448 $seconds += $regular + $end_during + $start_during + $entire_range;
456 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
458 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
459 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
460 for records where B<svcdb> is not "svc_acct".
464 #note: implementation here, POD in FS::svc_acct
465 #(false laziness w/seconds_since_sqlradacct above)
466 sub attribute_since_sqlradacct {
467 my($self, $start, $end, $attrib) = @_;
469 my $svc_x = $self->svc_x;
471 my @part_export = $self->part_svc->part_export_usage;
472 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
473 " service definition"
479 foreach my $part_export ( @part_export ) {
481 next if $part_export->option('ignore_accounting');
483 my $dbh = DBI->connect( map { $part_export->option($_) }
484 qw(datasrc username password) )
485 or die "can't connect to sqlradius database: ". $DBI::errstr;
487 #select a unix time conversion function based on database type
489 if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
490 $str2time = 'UNIX_TIMESTAMP(';
491 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
492 $str2time = 'EXTRACT( EPOCH FROM ';
494 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
495 "; guessing how to convert to UNIX timestamps";
496 $str2time = 'extract(epoch from ';
499 my $username = $part_export->export_username($svc_x);
501 my $sth = $dbh->prepare("SELECT SUM($attrib)
504 AND $str2time AcctStopTime ) >= ?
505 AND $str2time AcctStopTime ) < ?
506 AND AcctStopTime IS NOT NULL"
507 ) or die $dbh->errstr;
508 $sth->execute($username, $start, $end) or die $sth->errstr;
510 $sum += $sth->fetchrow_arrayref->[0];
518 =item get_session_history TIMESTAMP_START TIMESTAMP_END
520 See L<FS::svc_acct/get_session_history>. Equivalent to
521 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
522 records where B<svcdb> is not "svc_acct".
526 sub get_session_history {
527 my($self, $start, $end, $attrib) = @_;
531 my @part_export = $self->part_svc->part_export_usage;
532 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
533 " service definition"
539 foreach my $part_export ( @part_export ) {
541 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
548 =item get_cdrs_for_update
550 Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
551 objects (see L<FS::cdr>) associated with this service.
553 Currently CDRs are associated with svc_acct services via a DID in the
554 username. This part is rather tenative and still subject to change...
558 sub get_cdrs_for_update {
559 my($self, %options) = @_;
561 my $default_prefix = $options{'default_prefix'};
563 #CDRs are now associated with svc_phone services via svc_phone.phonenum
564 #return () unless $self->svc_x->isa('FS::svc_phone');
565 return () unless $self->part_svc->svcdb eq 'svc_phone';
566 my $number = $self->svc_x->phonenum;
571 'hashref' => { 'freesidestatus' => '',
572 'charged_party' => $number
574 'extra_sql' => 'FOR UPDATE',
577 if ( length($default_prefix) ) {
581 'hashref' => { 'freesidestatus' => '',
582 'charged_party' => "$default_prefix$number",
584 'extra_sql' => 'FOR UPDATE',
593 Returns the pkg_svc record for for this service, if applicable.
599 my $cust_pkg = $self->cust_pkg;
600 return undef unless $cust_pkg;
602 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
603 'pkgpart' => $cust_pkg->pkgpart,
612 Behaviour of changing the svcpart of cust_svc records is undefined and should
613 possibly be prohibited, and pkg_svc records are not checked.
615 pkg_svc records are not checked in general (here).
617 Deleting this record doesn't check or delete the svc_* record associated
620 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
621 a DBI database handle is not yet implemented.
625 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
626 schema.html from the base documentation