6 use FS::Record qw( qsearch qsearchs dbh );
14 use FS::domain_record;
16 @ISA = qw( FS::Record );
20 my ( $hashref, $cache ) = @_;
21 if ( $hashref->{'username'} ) {
22 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
24 if ( $hashref->{'svc'} ) {
25 $self->{'_svcpart'} = FS::part_svc->new($hashref);
31 FS::cust_svc - Object method for cust_svc objects
37 $record = new FS::cust_svc \%hash
38 $record = new FS::cust_svc { 'column' => 'value' };
40 $error = $record->insert;
42 $error = $new_record->replace($old_record);
44 $error = $record->delete;
46 $error = $record->check;
48 ($label, $value) = $record->label;
52 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
53 The following fields are currently supported:
57 =item svcnum - primary key (assigned automatically for new services)
59 =item pkgnum - Package (see L<FS::cust_pkg>)
61 =item svcpart - Service definition (see L<FS::part_svc>)
71 Creates a new service. To add the refund to the database, see L<"insert">.
72 Services are normally created by creating FS::svc_ objects (see
73 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
77 sub table { 'cust_svc'; }
81 Adds this service to the database. If there is an error, returns the error,
82 otherwise returns false.
86 Deletes this service from the database. If there is an error, returns the
87 error, otherwise returns false. Note that this only removes the cust_svc
88 record - you should probably use the B<cancel> method instead.
92 Cancels the relevant service by calling the B<cancel> method of the associated
93 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
94 deleting the FS::svc_XXX record and then deleting this record.
96 If there is an error, returns the error, otherwise returns false.
103 local $SIG{HUP} = 'IGNORE';
104 local $SIG{INT} = 'IGNORE';
105 local $SIG{QUIT} = 'IGNORE';
106 local $SIG{TERM} = 'IGNORE';
107 local $SIG{TSTP} = 'IGNORE';
108 local $SIG{PIPE} = 'IGNORE';
110 my $oldAutoCommit = $FS::UID::AutoCommit;
111 local $FS::UID::AutoCommit = 0;
114 my $part_svc = $self->part_svc;
116 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
117 $dbh->rollback if $oldAutoCommit;
118 return "Illegal svcdb value in part_svc!";
121 require "FS/$svcdb.pm";
123 my $svc = $self->svc_x;
125 my $error = $svc->cancel;
127 $dbh->rollback if $oldAutoCommit;
128 return "Error canceling service: $error";
130 $error = $svc->delete;
132 $dbh->rollback if $oldAutoCommit;
133 return "Error deleting service: $error";
137 my $error = $self->delete;
139 $dbh->rollback if $oldAutoCommit;
140 return "Error deleting cust_svc: $error";
143 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
149 =item replace OLD_RECORD
151 Replaces the OLD_RECORD with this one in the database. If there is an error,
152 returns the error, otherwise returns false.
157 my ( $new, $old ) = ( shift, shift );
159 local $SIG{HUP} = 'IGNORE';
160 local $SIG{INT} = 'IGNORE';
161 local $SIG{QUIT} = 'IGNORE';
162 local $SIG{TERM} = 'IGNORE';
163 local $SIG{TSTP} = 'IGNORE';
164 local $SIG{PIPE} = 'IGNORE';
166 my $oldAutoCommit = $FS::UID::AutoCommit;
167 local $FS::UID::AutoCommit = 0;
170 my $error = $new->SUPER::replace($old);
172 $dbh->rollback if $oldAutoCommit;
173 return $error if $error;
176 if ( $new->svcpart != $old->svcpart ) {
177 my $svc_x = $new->svc_x;
178 my $new_svc_x = ref($svc_x)->new({$svc_x->hash});
179 my $error = $new_svc_x->replace($svc_x);
181 $dbh->rollback if $oldAutoCommit;
182 return $error if $error;
186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
193 Checks all fields to make sure this is a valid service. If there is an error,
194 returns the error, otehrwise returns false. Called by the insert and
203 $self->ut_numbern('svcnum')
204 || $self->ut_numbern('pkgnum')
205 || $self->ut_number('svcpart')
207 return $error if $error;
209 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
210 return "Unknown svcpart" unless $part_svc;
212 if ( $self->pkgnum ) {
213 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
214 return "Unknown pkgnum" unless $cust_pkg;
215 my $pkg_svc = qsearchs( 'pkg_svc', {
216 'pkgpart' => $cust_pkg->pkgpart,
217 'svcpart' => $self->svcpart,
219 # or new FS::pkg_svc ( { 'pkgpart' => $cust_pkg->pkgpart,
220 # 'svcpart' => $self->svcpart,
221 # 'quantity' => 0 } );
223 my @cust_svc = qsearch('cust_svc', {
224 'pkgnum' => $self->pkgnum,
225 'svcpart' => $self->svcpart,
227 return "Already ". scalar(@cust_svc). " ". $part_svc->svc.
228 " services for pkgnum ". $self->pkgnum
229 if scalar(@cust_svc) >= $pkg_svc->quantity;
237 Returns the definition for this service, as a FS::part_svc object (see
245 ? $self->{'_svcpart'}
246 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
251 Returns the definition for this service, as a FS::part_svc object (see
258 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
263 Returns a list consisting of:
264 - The name of this service (from part_svc)
265 - A meaningful identifier (username, domain, or mail alias)
266 - The table name (i.e. svc_domain) for this service
272 my $svcdb = $self->part_svc->svcdb;
273 my $svc_x = $self->svc_x
274 or die "can't find $svcdb.svcnum ". $self->svcnum;
276 if ( $svcdb eq 'svc_acct' ) {
277 $tag = $svc_x->email;
278 } elsif ( $svcdb eq 'svc_forward' ) {
279 my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } );
280 $tag = $svc_acct->email. '->';
281 if ( $svc_x->dstsvc ) {
282 $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } );
283 $tag .= $svc_acct->email;
287 } elsif ( $svcdb eq 'svc_domain' ) {
288 $tag = $svc_x->getfield('domain');
289 } elsif ( $svcdb eq 'svc_www' ) {
290 my $domain = qsearchs( 'domain_record', { 'recnum' => $svc_x->recnum } );
291 $tag = $domain->reczone;
292 } elsif ( $svcdb eq 'svc_broadband' ) {
293 $tag = $svc_x->ip_addr . '/' . $svc_x->ip_netmask;
295 cluck "warning: asked for label of unsupported svcdb; using svcnum";
296 $tag = $svc_x->getfield('svcnum');
298 $self->part_svc->svc, $tag, $svcdb;
303 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
304 FS::svc_domain object, etc.)
310 my $svcdb = $self->part_svc->svcdb;
311 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
312 $self->{'_svc_acct'};
314 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
318 =item seconds_since TIMESTAMP
320 See L<FS::svc_acct/seconds_since>. Equivalent to
321 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
322 where B<svcdb> is not "svc_acct".
326 #note: implementation here, POD in FS::svc_acct
328 my($self, $since) = @_;
330 my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
333 AND logout IS NOT NULL'
334 ) or die $dbh->errstr;
335 $sth->execute($self->svcnum, $since) or die $sth->errstr;
336 $sth->fetchrow_arrayref->[0];
339 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ( DBI_DATABASE_HANDLE | DATASRC DB_USERNAME DB_PASSWORD )
341 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
342 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
343 where B<svcdb> is not "svc_acct".
345 NOTE: specifying a DATASRC/USERNAME/PASSWORD instead of a DBI database handle
346 is not yet implemented.
350 #note: implementation here, POD in FS::svc_acct
351 sub seconds_since_sqlradacct {
352 my($self, $start, $end, $dbh) = @_;
354 my $username = $self->svc_x->username;
356 #select a unix time conversion function based on database type
358 if ( $dbh->{Driver}->{Name} eq 'mysql' ) {
359 $str2time = 'UNIX_TIMESTAMP(';
360 } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
361 $str2time = 'EXTRACT( EPOCH FROM ';
363 warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
364 "; guessing how to convert to UNIX timestamps";
365 $str2time = 'extract(epoch from ';
368 #find sessions completely within the given range
369 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
372 AND $str2time AcctStartTime) >= ?
373 AND $str2time AcctStopTime ) < ?
374 AND AcctStopTime =! 0
375 AND AcctStopTime IS NOT NULL"
376 ) or die $dbh->errstr;
377 $sth->execute($username, $start, $end) or die $sth->errstr;
378 my $regular = $sth->fetchrow_arrayref->[0];
380 #find open sessions which start in the range, count session start->range end
381 $sth = $dbh->prepare("SELECT SUM( ? - $str2time AcctStartTime ) )
384 AND AcctStartTime >= ?
385 AND ( AcctStopTime = 0
386 OR AcctStopTime IS NULL )"
387 ) or die $dbh->errstr;
388 $sth->execute($end, $username, $start) or die $sth->errstr;
389 my $start_during = $sth->fetchrow_arrayref->[0];
391 #find closed sessions which start before the range but stop during,
392 #count range start->session end
393 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
396 AND AcctStartTime < ?
397 AND AcctStopTime >= ?
399 AND AcctStopTime != 0
400 AND AcctStopTime IS NOT NULL"
401 ) or die $dbh->errstr;
402 $sth->execute($start, $username, $start, $start, $end ) or die $sth->errstr;
403 my $end_during = $sth->fetchrow_arrayref->[0];
405 #find closed or open sessions which start before the range but stop
406 # after, or are still open, count range start->range end
407 $sth = $dbh->prepare("SELECT COUNT(*)
410 AND AcctStartTime < ?
411 AND ( AcctStopTime >= ?
413 OR AcctStopTime IS NULL )"
414 ) or die $dbh->errstr;
415 $sth->execute($username, $start, $end ) or die $sth->errstr;
416 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
418 $regular + $end_during + $start_during + $entire_range;
425 $Id: cust_svc.pm,v 1.18 2002-10-12 13:26:45 ivan Exp $
429 Behaviour of changing the svcpart of cust_svc records is undefined and should
430 possibly be prohibited, and pkg_svc records are not checked.
432 pkg_svc records are not checked in general (here).
434 Deleting this record doesn't check or delete the svc_* record associated
437 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
438 a DBI database handle is not yet implemented.
442 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
443 schema.html from the base documentation