6 use FS::Record qw( qsearch qsearchs dbh );
15 use FS::domain_record;
18 @ISA = qw( FS::Record );
22 my ( $hashref, $cache ) = @_;
23 if ( $hashref->{'username'} ) {
24 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
26 if ( $hashref->{'svc'} ) {
27 $self->{'_svcpart'} = FS::part_svc->new($hashref);
33 FS::cust_svc - Object method for cust_svc objects
39 $record = new FS::cust_svc \%hash
40 $record = new FS::cust_svc { 'column' => 'value' };
42 $error = $record->insert;
44 $error = $new_record->replace($old_record);
46 $error = $record->delete;
48 $error = $record->check;
50 ($label, $value) = $record->label;
54 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
55 The following fields are currently supported:
59 =item svcnum - primary key (assigned automatically for new services)
61 =item pkgnum - Package (see L<FS::cust_pkg>)
63 =item svcpart - Service definition (see L<FS::part_svc>)
73 Creates a new service. To add the refund to the database, see L<"insert">.
74 Services are normally created by creating FS::svc_ objects (see
75 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
79 sub table { 'cust_svc'; }
83 Adds this service to the database. If there is an error, returns the error,
84 otherwise returns false.
88 Deletes this service from the database. If there is an error, returns the
89 error, otherwise returns false. Note that this only removes the cust_svc
90 record - you should probably use the B<cancel> method instead.
94 Cancels the relevant service by calling the B<cancel> method of the associated
95 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
96 deleting the FS::svc_XXX record and then deleting this record.
98 If there is an error, returns the error, otherwise returns false.
105 local $SIG{HUP} = 'IGNORE';
106 local $SIG{INT} = 'IGNORE';
107 local $SIG{QUIT} = 'IGNORE';
108 local $SIG{TERM} = 'IGNORE';
109 local $SIG{TSTP} = 'IGNORE';
110 local $SIG{PIPE} = 'IGNORE';
112 my $oldAutoCommit = $FS::UID::AutoCommit;
113 local $FS::UID::AutoCommit = 0;
116 my $part_svc = $self->part_svc;
118 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
119 $dbh->rollback if $oldAutoCommit;
120 return "Illegal svcdb value in part_svc!";
123 require "FS/$svcdb.pm";
125 my $svc = $self->svc_x;
127 my $error = $svc->cancel;
129 $dbh->rollback if $oldAutoCommit;
130 return "Error canceling service: $error";
132 $error = $svc->delete;
134 $dbh->rollback if $oldAutoCommit;
135 return "Error deleting service: $error";
139 my $error = $self->delete;
141 $dbh->rollback if $oldAutoCommit;
142 return "Error deleting cust_svc: $error";
145 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
151 =item replace OLD_RECORD
153 Replaces the OLD_RECORD with this one in the database. If there is an error,
154 returns the error, otherwise returns false.
159 my ( $new, $old ) = ( shift, shift );
161 local $SIG{HUP} = 'IGNORE';
162 local $SIG{INT} = 'IGNORE';
163 local $SIG{QUIT} = 'IGNORE';
164 local $SIG{TERM} = 'IGNORE';
165 local $SIG{TSTP} = 'IGNORE';
166 local $SIG{PIPE} = 'IGNORE';
168 my $oldAutoCommit = $FS::UID::AutoCommit;
169 local $FS::UID::AutoCommit = 0;
172 my $error = $new->SUPER::replace($old);
174 $dbh->rollback if $oldAutoCommit;
175 return $error if $error;
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});
181 my $error = $new_svc_x->replace($svc_x);
183 $dbh->rollback if $oldAutoCommit;
184 return $error if $error;
188 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
195 Checks all fields to make sure this is a valid service. If there is an error,
196 returns the error, otehrwise returns false. Called by the insert and
205 $self->ut_numbern('svcnum')
206 || $self->ut_numbern('pkgnum')
207 || $self->ut_number('svcpart')
209 return $error if $error;
211 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
212 return "Unknown svcpart" unless $part_svc;
214 if ( $self->pkgnum ) {
215 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
216 return "Unknown pkgnum" unless $cust_pkg;
217 my $pkg_svc = qsearchs( 'pkg_svc', {
218 'pkgpart' => $cust_pkg->pkgpart,
219 'svcpart' => $self->svcpart,
221 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
222 # 'svcpart' => $self->svcpart,
223 # 'quantity' => 0 } );
224 my $quantity = $pkg_svc ? $pkg_svc->quantity : 0;
226 my @cust_svc = qsearch('cust_svc', {
227 'pkgnum' => $self->pkgnum,
228 'svcpart' => $self->svcpart,
230 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
231 " services for pkgnum ". $self->pkgnum
232 if scalar(@cust_svc) >= $quantity;
240 Returns the definition for this service, as a FS::part_svc object (see
248 ? $self->{'_svcpart'}
249 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
254 Returns the definition for this service, as a FS::part_svc object (see
261 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
266 Returns a list consisting of:
267 - The name of this service (from part_svc)
268 - A meaningful identifier (username, domain, or mail alias)
269 - The table name (i.e. svc_domain) for this service
275 my $svcdb = $self->part_svc->svcdb;
276 my $svc_x = $self->svc_x
277 or die "can't find $svcdb.svcnum ". $self->svcnum;
279 if ( $svcdb eq 'svc_acct' ) {
280 $tag = $svc_x->email;
281 } elsif ( $svcdb eq 'svc_acct_sm' ) {
282 my $domuser = $svc_x->domuser eq '*' ? '(anything)' : $svc_x->domuser;
283 my $svc_domain = qsearchs ( 'svc_domain', { 'svcnum' => $svc_x->domsvc } );
284 my $domain = $svc_domain->domain;
285 $tag = "$domuser\@$domain";
286 } elsif ( $svcdb eq 'svc_forward' ) {
287 my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
288 $tag = $svc_acct->email. '->';
289 if ( $svc_x->dstsvc ) {
290 $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
291 $tag .= $svc_acct->email;
295 } elsif ( $svcdb eq 'svc_domain' ) {
296 $tag = $svc_x->getfield('domain');
297 } elsif ( $svcdb eq 'svc_www' ) {
298 my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
299 $tag = $domain->reczone;
301 cluck "warning: asked for label of unsupported svcdb; using svcnum";
302 $tag = $svc_x->getfield('svcnum');
304 $self->part_svc->svc, $tag, $svcdb;
309 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
310 FS::svc_domain object, etc.)
316 my $svcdb = $self->part_svc->svcdb;
317 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
318 $self->{'_svc_acct'};
320 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
324 =item seconds_since TIMESTAMP
326 See L<FS::svc_acct/seconds_since>. Equivalent to
327 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
328 where B<svcdb> is not "svc_acct".
332 #note: implementation here, POD in FS::svc_acct
334 my($self, $since) = @_;
336 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
339 AND logout IS NOT NULL'
340 ) or die $dbh->errstr;
341 $sth->execute($self->svcnum, $since) or die $sth->errstr;
342 $sth->fetchrow_arrayref->[0];
345 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
347 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
348 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
349 for records where B<svcdb> is not "svc_acct".
353 #note: implementation here, POD in FS::svc_acct
354 sub seconds_since_sqlradacct {
355 my($self, $start, $end) = @_;
357 my $username = $self->svc_x->username;
359 my @part_export = $self->part_svc->part_export('sqlradius')
360 or die "no sqlradius export configured for this service type";
364 foreach my $part_export ( @part_export ) {
366 my $dbh = DBI->connect( map { $part_export->option($_) }
367 qw(datasrc username password) )
368 or die "can't connect to sqlradius database: ". $DBI::errstr;
370 #select a unix time conversion function based on database type
372 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
373 $str2time = 'UNIX_TIMESTAMP(';
374 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
375 $str2time = 'EXTRACT( EPOCH FROM ';
377 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
378 "; guessing how to convert to UNIX timestamps";
379 $str2time = 'extract(epoch from ';
384 #find closed sessions completely within the given range
385 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
388 AND $str2time AcctStartTime) >= ?
389 AND $str2time AcctStopTime ) < ?
390 AND $str2time AcctStopTime ) > 0
391 AND AcctStopTime IS NOT NULL"
392 ) or die $dbh->errstr;
393 $sth->execute($username, $start, $end) or die $sth->errstr;
394 my $regular = $sth->fetchrow_arrayref->[0];
396 #find open sessions which start in the range, count session start->range end
397 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
400 AND $str2time AcctStartTime ) >= ?
401 AND $str2time AcctStartTime ) < ?
402 AND ( ? - $str2time AcctStartTime ) ) < 86400
403 AND ( $str2time AcctStopTime ) = 0
404 OR AcctStopTime IS NULL )";
405 $sth = $dbh->prepare($query) or die $dbh->errstr;
406 $sth->execute($end, $username, $start, $end, $end)
407 or die $sth->errstr. " executing query $query";
408 my $start_during = $sth->fetchrow_arrayref->[0];
410 #find closed sessions which start before the range but stop during,
411 #count range start->session end
412 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
415 AND $str2time AcctStartTime ) < ?
416 AND $str2time AcctStopTime ) >= ?
417 AND $str2time AcctStopTime ) < ?
418 AND $str2time AcctStopTime ) > 0
419 AND AcctStopTime IS NOT NULL"
420 ) or die $dbh->errstr;
421 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
422 my $end_during = $sth->fetchrow_arrayref->[0];
424 #find closed (not anymore - or open) sessions which start before the range
425 # but stop after, or are still open, count range start->range end
426 # don't count open sessions (probably missing stop record)
427 $sth = $dbh->prepare("SELECT COUNT(*)
430 AND $str2time AcctStartTime ) < ?
431 AND ( $str2time AcctStopTime ) >= ?
433 # OR AcctStopTime = 0
434 # OR AcctStopTime IS NULL )"
435 ) or die $dbh->errstr;
436 $sth->execute($username, $start, $end ) or die $sth->errstr;
437 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
439 $seconds += $regular + $end_during + $start_during + $entire_range;
447 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
449 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
450 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
451 for records where B<svcdb> is not "svc_acct".
455 #note: implementation here, POD in FS::svc_acct
456 #(false laziness w/seconds_since_sqlradacct above)
457 sub attribute_since_sqlradacct {
458 my($self, $start, $end, $attrib) = @_;
460 my $username = $self->svc_x->username;
462 my @part_export = $self->part_svc->part_export('sqlradius')
463 or die "no sqlradius export configured for this service type";
468 foreach my $part_export ( @part_export ) {
470 my $dbh = DBI->connect( map { $part_export->option($_) }
471 qw(datasrc username password) )
472 or die "can't connect to sqlradius database: ". $DBI::errstr;
474 #select a unix time conversion function based on database type
476 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
477 $str2time = 'UNIX_TIMESTAMP(';
478 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
479 $str2time = 'EXTRACT( EPOCH FROM ';
481 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
482 "; guessing how to convert to UNIX timestamps";
483 $str2time = 'extract(epoch from ';
486 my $sth = $dbh->prepare("SELECT SUM($attrib)
489 AND $str2time AcctStopTime ) >= ?
490 AND $str2time AcctStopTime ) < ?
491 AND AcctStopTime IS NOT NULL"
492 ) or die $dbh->errstr;
493 $sth->execute($username, $start, $end) or die $sth->errstr;
495 $sum += $sth->fetchrow_arrayref->[0];
507 Behaviour of changing the svcpart of cust_svc records is undefined and should
508 possibly be prohibited, and pkg_svc records are not checked.
510 pkg_svc records are not checked in general (here).
512 Deleting this record doesn't check or delete the svc_* record associated
515 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
516 a DBI database handle is not yet implemented.
520 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
521 schema.html from the base documentation