6 use FS::Record qw( qsearch qsearchs dbh );
14 use FS::domain_record;
17 @ISA = qw( FS::Record );
21 my ( $hashref, $cache ) = @_;
22 if ( $hashref->{'username'} ) {
23 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
25 if ( $hashref->{'svc'} ) {
26 $self->{'_svcpart'} = FS::part_svc->new($hashref);
32 FS::cust_svc - Object method for cust_svc objects
38 $record = new FS::cust_svc \%hash
39 $record = new FS::cust_svc { 'column' => 'value' };
41 $error = $record->insert;
43 $error = $new_record->replace($old_record);
45 $error = $record->delete;
47 $error = $record->check;
49 ($label, $value) = $record->label;
53 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
54 The following fields are currently supported:
58 =item svcnum - primary key (assigned automatically for new services)
60 =item pkgnum - Package (see L<FS::cust_pkg>)
62 =item svcpart - Service definition (see L<FS::part_svc>)
72 Creates a new service. To add the refund to the database, see L<"insert">.
73 Services are normally created by creating FS::svc_ objects (see
74 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
78 sub table { 'cust_svc'; }
82 Adds this service to the database. If there is an error, returns the error,
83 otherwise returns false.
87 Deletes this service from the database. If there is an error, returns the
88 error, otherwise returns false. Note that this only removes the cust_svc
89 record - you should probably use the B<cancel> method instead.
93 Cancels the relevant service by calling the B<cancel> method of the associated
94 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
95 deleting the FS::svc_XXX record and then deleting this record.
97 If there is an error, returns the error, otherwise returns false.
104 local $SIG{HUP} = 'IGNORE';
105 local $SIG{INT} = 'IGNORE';
106 local $SIG{QUIT} = 'IGNORE';
107 local $SIG{TERM} = 'IGNORE';
108 local $SIG{TSTP} = 'IGNORE';
109 local $SIG{PIPE} = 'IGNORE';
111 my $oldAutoCommit = $FS::UID::AutoCommit;
112 local $FS::UID::AutoCommit = 0;
115 my $part_svc = $self->part_svc;
117 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
118 $dbh->rollback if $oldAutoCommit;
119 return "Illegal svcdb value in part_svc!";
122 require "FS/$svcdb.pm";
124 my $svc = $self->svc_x;
126 my $error = $svc->cancel;
128 $dbh->rollback if $oldAutoCommit;
129 return "Error canceling service: $error";
131 $error = $svc->delete;
133 $dbh->rollback if $oldAutoCommit;
134 return "Error deleting service: $error";
138 my $error = $self->delete;
140 $dbh->rollback if $oldAutoCommit;
141 return "Error deleting cust_svc: $error";
144 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
150 =item replace OLD_RECORD
152 Replaces the OLD_RECORD with this one in the database. If there is an error,
153 returns the error, otherwise returns false.
158 my ( $new, $old ) = ( shift, shift );
160 local $SIG{HUP} = 'IGNORE';
161 local $SIG{INT} = 'IGNORE';
162 local $SIG{QUIT} = 'IGNORE';
163 local $SIG{TERM} = 'IGNORE';
164 local $SIG{TSTP} = 'IGNORE';
165 local $SIG{PIPE} = 'IGNORE';
167 my $oldAutoCommit = $FS::UID::AutoCommit;
168 local $FS::UID::AutoCommit = 0;
171 my $error = $new->SUPER::replace($old);
173 $dbh->rollback if $oldAutoCommit;
174 return $error if $error;
177 if ( $new->svcpart != $old->svcpart ) {
178 my $svc_x = $new->svc_x;
179 my $new_svc_x = ref($svc_x)->new({$svc_x->hash});
180 my $error = $new_svc_x->replace($svc_x);
182 $dbh->rollback if $oldAutoCommit;
183 return $error if $error;
187 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
194 Checks all fields to make sure this is a valid service. If there is an error,
195 returns the error, otehrwise returns false. Called by the insert and
204 $self->ut_numbern('svcnum')
205 || $self->ut_numbern('pkgnum')
206 || $self->ut_number('svcpart')
208 return $error if $error;
210 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
211 return "Unknown svcpart" unless $part_svc;
213 if ( $self->pkgnum ) {
214 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
215 return "Unknown pkgnum" unless $cust_pkg;
216 my $pkg_svc = qsearchs( 'pkg_svc', {
217 'pkgpart' => $cust_pkg->pkgpart,
218 'svcpart' => $self->svcpart,
220 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
221 # 'svcpart' => $self->svcpart,
222 # 'quantity' => 0 } );
223 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
225 my @cust_svc = qsearch('cust_svc', {
226 'pkgnum' => $self->pkgnum,
227 'svcpart' => $self->svcpart,
229 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
230 " services for pkgnum ". $self->pkgnum
231 if scalar(@cust_svc) >= $quantity;
239 Returns the definition for this service, as a FS::part_svc object (see
247 ? $self->{'_svcpart'}
248 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
253 Returns the definition for this service, as a FS::part_svc object (see
260 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
265 Returns a list consisting of:
266 - The name of this service (from part_svc)
267 - A meaningful identifier (username, domain, or mail alias)
268 - The table name (i.e. svc_domain) for this service
274 my $svcdb = $self->part_svc->svcdb;
275 my $svc_x = $self->svc_x
276 or die "can't find $svcdb.svcnum ". $self->svcnum;
278 if ( $svcdb eq 'svc_acct' ) {
279 $tag = $svc_x->email;
280 } elsif ( $svcdb eq 'svc_forward' ) {
281 my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
282 $tag = $svc_acct->email. '->';
283 if ( $svc_x->dstsvc ) {
284 $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
285 $tag .= $svc_acct->email;
289 } elsif ( $svcdb eq 'svc_domain' ) {
290 $tag = $svc_x->getfield('domain');
291 } elsif ( $svcdb eq 'svc_www' ) {
292 my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
293 $tag = $domain->zone;
294 } elsif ( $svcdb eq 'svc_broadband' ) {
295 $tag = $svc_x->ip_addr;
297 cluck "warning: asked for label of unsupported svcdb; using svcnum";
298 $tag = $svc_x->getfield('svcnum');
300 $self->part_svc->svc, $tag, $svcdb;
305 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
306 FS::svc_domain object, etc.)
312 my $svcdb = $self->part_svc->svcdb;
313 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
314 $self->{'_svc_acct'};
316 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
320 =item seconds_since TIMESTAMP
322 See L<FS::svc_acct/seconds_since>. Equivalent to
323 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
324 where B<svcdb> is not "svc_acct".
328 #note: implementation here, POD in FS::svc_acct
330 my($self, $since) = @_;
332 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
335 AND logout IS NOT NULL'
336 ) or die $dbh->errstr;
337 $sth->execute($self->svcnum, $since) or die $sth->errstr;
338 $sth->fetchrow_arrayref->[0];
341 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
343 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
344 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
345 for records where B<svcdb> is not "svc_acct".
349 #note: implementation here, POD in FS::svc_acct
350 sub seconds_since_sqlradacct {
351 my($self, $start, $end) = @_;
353 my $username = $self->svc_x->username;
355 my @part_export = $self->part_svc->part_export('sqlradius')
356 or die "no sqlradius export configured for this service type";
360 foreach my $part_export ( @part_export ) {
362 my $dbh = DBI->connect( map { $part_export->option($_) }
363 qw(datasrc username password) )
364 or die "can't connect to sqlradius database: ". $DBI::errstr;
366 #select a unix time conversion function based on database type
368 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
369 $str2time = 'UNIX_TIMESTAMP(';
370 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
371 $str2time = 'EXTRACT( EPOCH FROM ';
373 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
374 "; guessing how to convert to UNIX timestamps";
375 $str2time = 'extract(epoch from ';
380 #find closed sessions completely within the given range
381 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
384 AND $str2time AcctStartTime) >= ?
385 AND $str2time AcctStopTime ) < ?
386 AND $str2time AcctStopTime ) > 0
387 AND AcctStopTime IS NOT NULL"
388 ) or die $dbh->errstr;
389 $sth->execute($username, $start, $end) or die $sth->errstr;
390 my $regular = $sth->fetchrow_arrayref->[0];
392 #find open sessions which start in the range, count session start->range end
393 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
396 AND $str2time AcctStartTime ) >= ?
397 AND $str2time AcctStartTime ) < ?
398 AND ( ? - $str2time AcctStartTime ) ) < 86400
399 AND ( $str2time AcctStopTime ) = 0
400 OR AcctStopTime IS NULL )";
401 $sth = $dbh->prepare($query) or die $dbh->errstr;
402 $sth->execute($end, $username, $start, $end, $end)
403 or die $sth->errstr. " executing query $query";
404 my $start_during = $sth->fetchrow_arrayref->[0];
406 #find closed sessions which start before the range but stop during,
407 #count range start->session end
408 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
411 AND $str2time AcctStartTime ) < ?
412 AND $str2time AcctStopTime ) >= ?
413 AND $str2time AcctStopTime ) < ?
414 AND $str2time AcctStopTime ) > 0
415 AND AcctStopTime IS NOT NULL"
416 ) or die $dbh->errstr;
417 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
418 my $end_during = $sth->fetchrow_arrayref->[0];
420 #find closed (not anymore - or open) sessions which start before the range
421 # but stop after, or are still open, count range start->range end
422 # don't count open sessions (probably missing stop record)
423 $sth = $dbh->prepare("SELECT COUNT(*)
426 AND $str2time AcctStartTime ) < ?
427 AND ( $str2time AcctStopTime ) >= ?
429 # OR AcctStopTime = 0
430 # OR AcctStopTime IS NULL )"
431 ) or die $dbh->errstr;
432 $sth->execute($username, $start, $end ) or die $sth->errstr;
433 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
435 $seconds += $regular + $end_during + $start_during + $entire_range;
443 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
445 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
446 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
447 for records where B<svcdb> is not "svc_acct".
451 #note: implementation here, POD in FS::svc_acct
452 #(false laziness w/seconds_since_sqlradacct above)
453 sub attribute_since_sqlradacct {
454 my($self, $start, $end, $attrib) = @_;
456 my $username = $self->svc_x->username;
458 my @part_export = $self->part_svc->part_export('sqlradius')
459 or die "no sqlradius export configured for this service type";
464 foreach my $part_export ( @part_export ) {
466 my $dbh = DBI->connect( map { $part_export->option($_) }
467 qw(datasrc username password) )
468 or die "can't connect to sqlradius database: ". $DBI::errstr;
470 #select a unix time conversion function based on database type
472 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
473 $str2time = 'UNIX_TIMESTAMP(';
474 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
475 $str2time = 'EXTRACT( EPOCH FROM ';
477 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
478 "; guessing how to convert to UNIX timestamps";
479 $str2time = 'extract(epoch from ';
482 my $sth = $dbh->prepare("SELECT SUM($attrib)
485 AND $str2time AcctStopTime ) >= ?
486 AND $str2time AcctStopTime ) < ?
487 AND AcctStopTime IS NOT NULL"
488 ) or die $dbh->errstr;
489 $sth->execute($username, $start, $end) or die $sth->errstr;
491 $sum += $sth->fetchrow_arrayref->[0];
503 Behaviour of changing the svcpart of cust_svc records is undefined and should
504 possibly be prohibited, and pkg_svc records are not checked.
506 pkg_svc records are not checked in general (here).
508 Deleting this record doesn't check or delete the svc_* record associated
511 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
512 a DBI database handle is not yet implemented.
516 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
517 schema.html from the base documentation