4 use vars qw( @ISA $DEBUG $me $ignore_quantity );
6 #use Scalar::Util qw( blessed );
8 use FS::Record qw( qsearch qsearchs dbh str2time_sql );
13 use FS::domain_record;
17 #most FS::svc_ classes are autoloaded in svc_x emthod
18 use FS::svc_acct; #this one is used in the cache stuff
20 @ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
29 my ( $hashref, $cache ) = @_;
30 if ( $hashref->{'username'} ) {
31 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
33 if ( $hashref->{'svc'} ) {
34 $self->{'_svcpart'} = FS::part_svc->new($hashref);
40 FS::cust_svc - Object method for cust_svc objects
46 $record = new FS::cust_svc \%hash
47 $record = new FS::cust_svc { 'column' => 'value' };
49 $error = $record->insert;
51 $error = $new_record->replace($old_record);
53 $error = $record->delete;
55 $error = $record->check;
57 ($label, $value) = $record->label;
61 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
62 The following fields are currently supported:
66 =item svcnum - primary key (assigned automatically for new services)
68 =item pkgnum - Package (see L<FS::cust_pkg>)
70 =item svcpart - Service definition (see L<FS::part_svc>)
72 =item overlimit - date the service exceeded its usage limit
82 Creates a new service. To add the refund to the database, see L<"insert">.
83 Services are normally created by creating FS::svc_ objects (see
84 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
88 sub table { 'cust_svc'; }
92 Adds this service to the database. If there is an error, returns the error,
93 otherwise returns false.
97 Deletes this service from the database. If there is an error, returns the
98 error, otherwise returns false. Note that this only removes the cust_svc
99 record - you should probably use the B<cancel> method instead.
105 my $error = $self->SUPER::delete;
106 return $error if $error;
108 if ( FS::Conf->new->config('ticket_system') eq 'RT_Internal' ) {
109 FS::TicketSystem->init;
110 my $session = FS::TicketSystem->session;
111 my $links = RT::Links->new($session->{CurrentUser});
112 my $svcnum = $self->svcnum;
113 $links->Limit(FIELD => 'Target',
114 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
115 while ( my $l = $links->Next ) {
116 my ($val, $msg) = $l->Delete;
117 # can't do anything useful on error
118 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
125 Cancels the relevant service by calling the B<cancel> method of the associated
126 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
127 deleting the FS::svc_XXX record and then deleting this record.
129 If there is an error, returns the error, otherwise returns false.
136 local $SIG{HUP} = 'IGNORE';
137 local $SIG{INT} = 'IGNORE';
138 local $SIG{QUIT} = 'IGNORE';
139 local $SIG{TERM} = 'IGNORE';
140 local $SIG{TSTP} = 'IGNORE';
141 local $SIG{PIPE} = 'IGNORE';
143 my $oldAutoCommit = $FS::UID::AutoCommit;
144 local $FS::UID::AutoCommit = 0;
147 my $part_svc = $self->part_svc;
149 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
150 $dbh->rollback if $oldAutoCommit;
151 return "Illegal svcdb value in part_svc!";
154 require "FS/$svcdb.pm";
156 my $svc = $self->svc_x;
158 if ( %opt && $opt{'date'} ) {
159 my $error = $svc->expire($opt{'date'});
161 $dbh->rollback if $oldAutoCommit;
162 return "Error expiring service: $error";
165 my $error = $svc->cancel;
167 $dbh->rollback if $oldAutoCommit;
168 return "Error canceling service: $error";
170 $error = $svc->delete; #this deletes this cust_svc record as well
172 $dbh->rollback if $oldAutoCommit;
173 return "Error deleting service: $error";
180 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
181 "; deleting cust_svc only\n";
183 my $error = $self->delete;
185 $dbh->rollback if $oldAutoCommit;
186 return "Error deleting cust_svc: $error";
191 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
197 =item overlimit [ ACTION ]
199 Retrieves or sets the overlimit date. If ACTION is absent, return
200 the present value of overlimit. If ACTION is present, it can
201 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
202 is set to the current time if it is not already set. The 'unsuspend' value
203 causes the time to be cleared.
205 If there is an error on setting, returns the error, otherwise returns false.
211 my $action = shift or return $self->getfield('overlimit');
213 local $SIG{HUP} = 'IGNORE';
214 local $SIG{INT} = 'IGNORE';
215 local $SIG{QUIT} = 'IGNORE';
216 local $SIG{TERM} = 'IGNORE';
217 local $SIG{TSTP} = 'IGNORE';
218 local $SIG{PIPE} = 'IGNORE';
220 my $oldAutoCommit = $FS::UID::AutoCommit;
221 local $FS::UID::AutoCommit = 0;
224 if ( $action eq 'suspend' ) {
225 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
226 }elsif ( $action eq 'unsuspend' ) {
227 $self->setfield('overlimit', '');
229 die "unexpected action value: $action";
232 local $ignore_quantity = 1;
233 my $error = $self->replace;
235 $dbh->rollback if $oldAutoCommit;
236 return "Error setting overlimit: $error";
239 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
245 =item replace OLD_RECORD
247 Replaces the OLD_RECORD with this one in the database. If there is an error,
248 returns the error, otherwise returns false.
255 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
257 # : $new->replace_old;
258 my ( $new, $old ) = ( shift, shift );
259 $old = $new->replace_old unless defined($old);
261 local $SIG{HUP} = 'IGNORE';
262 local $SIG{INT} = 'IGNORE';
263 local $SIG{QUIT} = 'IGNORE';
264 local $SIG{TERM} = 'IGNORE';
265 local $SIG{TSTP} = 'IGNORE';
266 local $SIG{PIPE} = 'IGNORE';
268 my $oldAutoCommit = $FS::UID::AutoCommit;
269 local $FS::UID::AutoCommit = 0;
272 if ( $new->svcpart != $old->svcpart ) {
273 my $svc_x = $new->svc_x;
274 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
275 local($FS::Record::nowarn_identical) = 1;
276 my $error = $new_svc_x->replace($svc_x);
278 $dbh->rollback if $oldAutoCommit;
279 return $error if $error;
283 # #trigger a re-export on pkgnum changes?
284 # # (of prepaid packages), for Expiration RADIUS attribute
285 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
286 # my $svc_x = $new->svc_x;
287 # local($FS::Record::nowarn_identical) = 1;
288 # my $error = $svc_x->export('replace');
290 # $dbh->rollback if $oldAutoCommit;
291 # return $error if $error;
295 #my $error = $new->SUPER::replace($old, @_);
296 my $error = $new->SUPER::replace($old);
298 $dbh->rollback if $oldAutoCommit;
299 return $error if $error;
302 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
309 Checks all fields to make sure this is a valid service. If there is an error,
310 returns the error, otherwise returns false. Called by the insert and
319 $self->ut_numbern('svcnum')
320 || $self->ut_numbern('pkgnum')
321 || $self->ut_number('svcpart')
322 || $self->ut_numbern('overlimit')
324 return $error if $error;
326 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
327 return "Unknown svcpart" unless $part_svc;
329 if ( $self->pkgnum ) {
330 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
331 return "Unknown pkgnum" unless $cust_pkg;
332 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
333 return "No svcpart ". $self->svcpart.
334 " services in pkgpart ". $cust_pkg->pkgpart
336 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
337 " services for pkgnum ". $self->pkgnum
338 if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
346 Returns the definition for this service, as a FS::part_svc object (see
354 ? $self->{'_svcpart'}
355 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
360 Returns the package this service belongs to, as a FS::cust_pkg object (see
367 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
372 Returns the pkg_svc record for for this service, if applicable.
378 my $cust_pkg = $self->cust_pkg;
379 return undef unless $cust_pkg;
381 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
382 'pkgpart' => $cust_pkg->pkgpart,
389 Returns the date this service was inserted.
395 $self->h_date('insert');
398 =item pkg_cancel_date
400 Returns the date this service's package was canceled. This normally only
401 exists for a service that's been preserved through cancellation with the
402 part_pkg.preserve flag.
406 sub pkg_cancel_date {
408 my $cust_pkg = $self->cust_pkg or return;
409 return $cust_pkg->getfield('cancel') || '';
414 Returns a list consisting of:
415 - The name of this service (from part_svc)
416 - A meaningful identifier (username, domain, or mail alias)
417 - The table name (i.e. svc_domain) for this service
422 my($label, $value, $svcdb) = $cust_svc->label;
426 Like the B<label> method, except the second item in the list ("meaningful
427 identifier") may be longer - typically, a full name is included.
431 sub label { shift->_label('svc_label', @_); }
432 sub label_long { shift->_label('svc_label_long', @_); }
437 my $svc_x = $self->svc_x
438 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
440 $self->$method($svc_x);
443 sub svc_label { shift->_svc_label('label', @_); }
444 sub svc_label_long { shift->_svc_label('label_long', @_); }
447 my( $self, $method, $svc_x ) = ( shift, shift, shift );
450 $self->part_svc->svc,
452 $self->part_svc->svcdb,
460 Returns a listref of html elements associated with this service's exports.
466 my $svc_x = $self->svc_x
467 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
469 $svc_x->export_links;
472 =item export_getsettings
474 Returns two hashrefs of settings associated with this service's exports.
478 sub export_getsettings {
480 my $svc_x = $self->svc_x
481 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
483 $svc_x->export_getsettings;
489 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
490 FS::svc_domain object, etc.)
496 my $svcdb = $self->part_svc->svcdb;
497 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
498 $self->{'_svc_acct'};
500 require "FS/$svcdb.pm";
501 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
502 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
504 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
508 =item seconds_since TIMESTAMP
510 See L<FS::svc_acct/seconds_since>. Equivalent to
511 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
512 where B<svcdb> is not "svc_acct".
516 #internal session db deprecated (or at least on hold)
517 sub seconds_since { 'internal session db deprecated'; };
518 ##note: implementation here, POD in FS::svc_acct
520 # my($self, $since) = @_;
522 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
525 # AND logout IS NOT NULL'
526 # ) or die $dbh->errstr;
527 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
528 # $sth->fetchrow_arrayref->[0];
531 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
533 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
534 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
535 for records where B<svcdb> is not "svc_acct".
539 #note: implementation here, POD in FS::svc_acct
540 sub seconds_since_sqlradacct {
541 my($self, $start, $end) = @_;
543 my $mes = "$me seconds_since_sqlradacct:";
545 my $svc_x = $self->svc_x;
547 my @part_export = $self->part_svc->part_export_usage;
548 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
549 " service definition"
554 foreach my $part_export ( @part_export ) {
556 next if $part_export->option('ignore_accounting');
558 warn "$mes connecting to sqlradius database\n"
561 my $dbh = DBI->connect( map { $part_export->option($_) }
562 qw(datasrc username password) )
563 or die "can't connect to sqlradius database: ". $DBI::errstr;
565 warn "$mes connected to sqlradius database\n"
568 #select a unix time conversion function based on database type
569 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
571 my $username = $part_export->export_username($svc_x);
575 warn "$mes finding closed sessions completely within the given range\n"
580 if ($part_export->option('process_single_realm')) {
581 $realm = 'AND Realm = ?';
582 $realmparam = $part_export->option('realm');
585 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
589 AND $str2time AcctStartTime) >= ?
590 AND $str2time AcctStopTime ) < ?
591 AND $str2time AcctStopTime ) > 0
592 AND AcctStopTime IS NOT NULL"
593 ) or die $dbh->errstr;
594 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
596 my $regular = $sth->fetchrow_arrayref->[0];
598 warn "$mes finding open sessions which start in the range\n"
601 # count session start->range end
602 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
606 AND $str2time AcctStartTime ) >= ?
607 AND $str2time AcctStartTime ) < ?
608 AND ( ? - $str2time AcctStartTime ) ) < 86400
609 AND ( $str2time AcctStopTime ) = 0
610 OR AcctStopTime IS NULL )";
611 $sth = $dbh->prepare($query) or die $dbh->errstr;
614 ($realm ? $realmparam : ()),
618 or die $sth->errstr. " executing query $query";
619 my $start_during = $sth->fetchrow_arrayref->[0];
621 warn "$mes finding closed sessions which start before the range but stop during\n"
624 #count range start->session end
625 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
629 AND $str2time AcctStartTime ) < ?
630 AND $str2time AcctStopTime ) >= ?
631 AND $str2time AcctStopTime ) < ?
632 AND $str2time AcctStopTime ) > 0
633 AND AcctStopTime IS NOT NULL"
634 ) or die $dbh->errstr;
635 $sth->execute( $start,
637 ($realm ? $realmparam : ()),
642 my $end_during = $sth->fetchrow_arrayref->[0];
644 warn "$mes finding closed sessions which start before the range but stop after\n"
647 # count range start->range end
648 # don't count open sessions anymore (probably missing stop record)
649 $sth = $dbh->prepare("SELECT COUNT(*)
653 AND $str2time AcctStartTime ) < ?
654 AND ( $str2time AcctStopTime ) >= ?
656 # OR AcctStopTime = 0
657 # OR AcctStopTime IS NULL )"
658 ) or die $dbh->errstr;
659 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
661 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
663 $seconds += $regular + $end_during + $start_during + $entire_range;
665 warn "$mes done finding sessions\n"
674 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
676 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
677 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
678 for records where B<svcdb> is not "svc_acct".
682 #note: implementation here, POD in FS::svc_acct
683 #(false laziness w/seconds_since_sqlradacct above)
684 sub attribute_since_sqlradacct {
685 my($self, $start, $end, $attrib) = @_;
687 my $mes = "$me attribute_since_sqlradacct:";
689 my $svc_x = $self->svc_x;
691 my @part_export = $self->part_svc->part_export_usage;
692 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
693 " service definition"
699 foreach my $part_export ( @part_export ) {
701 next if $part_export->option('ignore_accounting');
703 warn "$mes connecting to sqlradius database\n"
706 my $dbh = DBI->connect( map { $part_export->option($_) }
707 qw(datasrc username password) )
708 or die "can't connect to sqlradius database: ". $DBI::errstr;
710 warn "$mes connected to sqlradius database\n"
713 #select a unix time conversion function based on database type
714 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
716 my $username = $part_export->export_username($svc_x);
718 warn "$mes SUMing $attrib sessions\n"
723 if ($part_export->option('process_single_realm')) {
724 $realm = 'AND Realm = ?';
725 $realmparam = $part_export->option('realm');
728 my $sth = $dbh->prepare("SELECT SUM($attrib)
732 AND $str2time AcctStopTime ) >= ?
733 AND $str2time AcctStopTime ) < ?
734 AND AcctStopTime IS NOT NULL"
735 ) or die $dbh->errstr;
736 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
739 my $row = $sth->fetchrow_arrayref;
740 $sum += $row->[0] if defined($row->[0]);
742 warn "$mes done SUMing sessions\n"
751 =item get_session_history TIMESTAMP_START TIMESTAMP_END
753 See L<FS::svc_acct/get_session_history>. Equivalent to
754 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
755 records where B<svcdb> is not "svc_acct".
759 sub get_session_history {
760 my($self, $start, $end, $attrib) = @_;
764 my @part_export = $self->part_svc->part_export_usage;
765 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
766 " service definition"
772 foreach my $part_export ( @part_export ) {
774 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
783 Returns an array of hashes representing the tickets linked to this service.
790 my $conf = FS::Conf->new;
791 my $num = $conf->config('cust_main-max_tickets') || 10;
794 if ( $conf->config('ticket_system') ) {
795 unless ( $conf->config('ticket_system-custom_priority_field') ) {
797 @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) };
801 foreach my $priority (
802 $conf->config('ticket_system-custom_priority_field-values'), ''
804 last if scalar(@tickets) >= $num;
806 @{ FS::TicketSystem->service_tickets( $self->svcnum,
807 $num - scalar(@tickets),
824 =item smart_search OPTION => VALUE ...
826 Accepts the option I<search>, the string to search for. The string will
827 be searched for as a username, email address, IP address, MAC address,
828 phone number, and hardware serial number. Unlike the I<smart_search> on
829 customers, this always requires an exact match.
833 # though perhaps it should be fuzzy in some cases?
836 # some false laziness w/ search/cust_svc.html
837 my $string = $opt{'search'};
838 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
840 my @extra_sql = ' ( '. join(' OR ',
841 map { my $table = $_;
842 my $search_sql = "FS::$table"->search_sql($string);
844 AND 0 < ( SELECT COUNT(*) FROM $table
845 WHERE $table.svcnum = cust_svc.svcnum
850 FS::part_svc->svc_tables
852 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
853 'null_right' => 'View/link unlinked services'
855 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
857 my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'.
858 ' LEFT JOIN cust_main USING ( custnum )'.
859 ' LEFT JOIN part_svc USING ( svcpart )';
862 'table' => 'cust_svc',
863 'addl_from' => $addl_from,
865 'extra_sql' => $extra_sql,
871 Behaviour of changing the svcpart of cust_svc records is undefined and should
872 possibly be prohibited, and pkg_svc records are not checked.
874 pkg_svc records are not checked in general (here).
876 Deleting this record doesn't check or delete the svc_* record associated
879 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
880 a DBI database handle is not yet implemented.
884 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
885 schema.html from the base documentation