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 } );
224 my @cust_svc = qsearch('cust_svc', {
225 'pkgnum' => $self->pkgnum,
226 'svcpart' => $self->svcpart,
228 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
229 " services for pkgnum ". $self->pkgnum
230 if scalar(@cust_svc) >= $pkg_svc->quantity;
238 Returns the definition for this service, as a FS::part_svc object (see
246 ? $self->{'_svcpart'}
247 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
252 Returns the definition for this service, as a FS::part_svc object (see
259 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
264 Returns a list consisting of:
265 - The name of this service (from part_svc)
266 - A meaningful identifier (username, domain, or mail alias)
267 - The table name (i.e. svc_domain) for this service
273 my $svcdb = $self->part_svc->svcdb;
274 my $svc_x = $self->svc_x
275 or die "can't find $svcdb.svcnum ". $self->svcnum;
277 if ( $svcdb eq 'svc_acct' ) {
278 $tag = $svc_x->email;
279 } elsif ( $svcdb eq 'svc_forward' ) {
280 my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
281 $tag = $svc_acct->email. '->';
282 if ( $svc_x->dstsvc ) {
283 $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
284 $tag .= $svc_acct->email;
288 } elsif ( $svcdb eq 'svc_domain' ) {
289 $tag = $svc_x->getfield('domain');
290 } elsif ( $svcdb eq 'svc_www' ) {
291 my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
292 $tag = $domain->reczone;
293 } elsif ( $svcdb eq 'svc_broadband' ) {
294 $tag = $svc_x->ip_addr . '/' . $svc_x->ip_netmask;
296 cluck "warning: asked for label of unsupported svcdb; using svcnum";
297 $tag = $svc_x->getfield('svcnum');
299 $self->part_svc->svc, $tag, $svcdb;
304 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
305 FS::svc_domain object, etc.)
311 my $svcdb = $self->part_svc->svcdb;
312 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
313 $self->{'_svc_acct'};
315 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
319 =item seconds_since TIMESTAMP
321 See L<FS::svc_acct/seconds_since>. Equivalent to
322 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
323 where B<svcdb> is not "svc_acct".
327 #note: implementation here, POD in FS::svc_acct
329 my($self, $since) = @_;
331 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
334 AND logout IS NOT NULL'
335 ) or die $dbh->errstr;
336 $sth->execute($self->svcnum, $since) or die $sth->errstr;
337 $sth->fetchrow_arrayref->[0];
340 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
342 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
343 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
344 where B<svcdb> is not "svc_acct".
348 #note: implementation here, POD in FS::svc_acct
349 sub seconds_since_sqlradacct {
350 my($self, $start, $end) = @_;
352 my $username = $self->svc_x->username;
354 my @part_export = $self->part_svc->part_export('sqlradius')
355 or die "no sqlradius export configured for this service type";
359 foreach my $part_export ( @part_export ) {
361 my $dbh = DBI->connect( map { $part_export->option($_) }
362 qw(datasrc username password) )
363 or die "can't connect to sqlradius database: ". $DBI::errstr;
365 #select a unix time conversion function based on database type
367 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
368 $str2time = 'UNIX_TIMESTAMP(';
369 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
370 $str2time = 'EXTRACT( EPOCH FROM ';
372 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
373 "; guessing how to convert to UNIX timestamps";
374 $str2time = 'extract(epoch from ';
377 #find closed sessions completely within the given range
378 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
381 AND $str2time AcctStartTime) >= ?
382 AND $str2time AcctStopTime ) < ?
383 AND AcctStopTime =! 0
384 AND AcctStopTime IS NOT NULL"
385 ) or die $dbh->errstr;
386 $sth->execute($username, $start, $end) or die $sth->errstr;
387 my $regular = $sth->fetchrow_arrayref->[0];
389 #find open sessions which start in the range, count session start->range end
390 # don't count them if they are over 1 day old (probably missing stop record)
391 $sth = $dbh->prepare("SELECT SUM( ? - $str2time AcctStartTime ) )
394 AND $str2time AcctStartTime ) >= ?
395 AND ( ? - $str2time AcctStartTime ) < 86400
396 AND ( AcctStopTime = 0
397 OR AcctStopTime IS NULL )"
398 ) or die $dbh->errstr;
399 $sth->execute($end, $username, $start, $end) or die $sth->errstr;
400 my $start_during = $sth->fetchrow_arrayref->[0];
402 #find closed sessions which start before the range but stop during,
403 #count range start->session end
404 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
407 AND $str2time AcctStartTime ) < ?
408 AND $str2time AcctStopTime ) >= ?
409 AND $str2time AcctStopTime ) < ?
410 AND AcctStopTime != 0
411 AND AcctStopTime IS NOT NULL"
412 ) or die $dbh->errstr;
413 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
414 my $end_during = $sth->fetchrow_arrayref->[0];
416 #find closed (not anymore - or open) sessions which start before the range
417 # but stop # after, or are still open, count range start->range end
418 # don't count open sessions (probably missing stop record)
419 $sth = $dbh->prepare("SELECT COUNT(*)
422 AND $str2time AcctStartTime ) < ?
423 AND ( $str2time AcctStopTime ) >= ?
425 # OR AcctStopTime = 0
426 # OR AcctStopTime IS NULL )"
427 ) or die $dbh->errstr;
428 $sth->execute($username, $start, $end ) or die $sth->errstr;
429 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
431 $seconds += $regular + $end_during + $start_during + $entire_range;
443 $Id: cust_svc.pm,v 1.19 2002-10-17 14:16:17 ivan Exp $
447 Behaviour of changing the svcpart of cust_svc records is undefined and should
448 possibly be prohibited, and pkg_svc records are not checked.
450 pkg_svc records are not checked in general (here).
452 Deleting this record doesn't check or delete the svc_* record associated
455 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
456 a DBI database handle is not yet implemented.
460 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
461 schema.html from the base documentation