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 agent_svcid - Optional legacy service ID
74 =item overlimit - date the service exceeded its usage limit
84 Creates a new service. To add the refund to the database, see L<"insert">.
85 Services are normally created by creating FS::svc_ objects (see
86 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
90 sub table { 'cust_svc'; }
94 Adds this service to the database. If there is an error, returns the error,
95 otherwise returns false.
99 Deletes this service from the database. If there is an error, returns the
100 error, otherwise returns false. Note that this only removes the cust_svc
101 record - you should probably use the B<cancel> method instead.
107 my $error = $self->SUPER::delete;
108 return $error if $error;
110 if ( FS::Conf->new->config('ticket_system') eq 'RT_Internal' ) {
111 FS::TicketSystem->init;
112 my $session = FS::TicketSystem->session;
113 my $links = RT::Links->new($session->{CurrentUser});
114 my $svcnum = $self->svcnum;
115 $links->Limit(FIELD => 'Target',
116 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
117 while ( my $l = $links->Next ) {
118 my ($val, $msg) = $l->Delete;
119 # can't do anything useful on error
120 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
127 Cancels the relevant service by calling the B<cancel> method of the associated
128 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
129 deleting the FS::svc_XXX record and then deleting this record.
131 If there is an error, returns the error, otherwise returns false.
138 local $SIG{HUP} = 'IGNORE';
139 local $SIG{INT} = 'IGNORE';
140 local $SIG{QUIT} = 'IGNORE';
141 local $SIG{TERM} = 'IGNORE';
142 local $SIG{TSTP} = 'IGNORE';
143 local $SIG{PIPE} = 'IGNORE';
145 my $oldAutoCommit = $FS::UID::AutoCommit;
146 local $FS::UID::AutoCommit = 0;
149 my $part_svc = $self->part_svc;
151 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
152 $dbh->rollback if $oldAutoCommit;
153 return "Illegal svcdb value in part_svc!";
156 require "FS/$svcdb.pm";
158 my $svc = $self->svc_x;
160 if ( %opt && $opt{'date'} ) {
161 my $error = $svc->expire($opt{'date'});
163 $dbh->rollback if $oldAutoCommit;
164 return "Error expiring service: $error";
167 my $error = $svc->cancel;
169 $dbh->rollback if $oldAutoCommit;
170 return "Error canceling service: $error";
172 $error = $svc->delete; #this deletes this cust_svc record as well
174 $dbh->rollback if $oldAutoCommit;
175 return "Error deleting service: $error";
182 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
183 "; deleting cust_svc only\n";
185 my $error = $self->delete;
187 $dbh->rollback if $oldAutoCommit;
188 return "Error deleting cust_svc: $error";
193 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
199 =item overlimit [ ACTION ]
201 Retrieves or sets the overlimit date. If ACTION is absent, return
202 the present value of overlimit. If ACTION is present, it can
203 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
204 is set to the current time if it is not already set. The 'unsuspend' value
205 causes the time to be cleared.
207 If there is an error on setting, returns the error, otherwise returns false.
213 my $action = shift or return $self->getfield('overlimit');
215 local $SIG{HUP} = 'IGNORE';
216 local $SIG{INT} = 'IGNORE';
217 local $SIG{QUIT} = 'IGNORE';
218 local $SIG{TERM} = 'IGNORE';
219 local $SIG{TSTP} = 'IGNORE';
220 local $SIG{PIPE} = 'IGNORE';
222 my $oldAutoCommit = $FS::UID::AutoCommit;
223 local $FS::UID::AutoCommit = 0;
226 if ( $action eq 'suspend' ) {
227 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
228 }elsif ( $action eq 'unsuspend' ) {
229 $self->setfield('overlimit', '');
231 die "unexpected action value: $action";
234 local $ignore_quantity = 1;
235 my $error = $self->replace;
237 $dbh->rollback if $oldAutoCommit;
238 return "Error setting overlimit: $error";
241 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
247 =item replace OLD_RECORD
249 Replaces the OLD_RECORD with this one in the database. If there is an error,
250 returns the error, otherwise returns false.
257 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
259 # : $new->replace_old;
260 my ( $new, $old ) = ( shift, shift );
261 $old = $new->replace_old unless defined($old);
263 local $SIG{HUP} = 'IGNORE';
264 local $SIG{INT} = 'IGNORE';
265 local $SIG{QUIT} = 'IGNORE';
266 local $SIG{TERM} = 'IGNORE';
267 local $SIG{TSTP} = 'IGNORE';
268 local $SIG{PIPE} = 'IGNORE';
270 my $oldAutoCommit = $FS::UID::AutoCommit;
271 local $FS::UID::AutoCommit = 0;
274 if ( $new->svcpart != $old->svcpart ) {
275 my $svc_x = $new->svc_x;
276 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
277 local($FS::Record::nowarn_identical) = 1;
278 my $error = $new_svc_x->replace($svc_x);
280 $dbh->rollback if $oldAutoCommit;
281 return $error if $error;
285 # #trigger a re-export on pkgnum changes?
286 # # (of prepaid packages), for Expiration RADIUS attribute
287 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
288 # my $svc_x = $new->svc_x;
289 # local($FS::Record::nowarn_identical) = 1;
290 # my $error = $svc_x->export('replace');
292 # $dbh->rollback if $oldAutoCommit;
293 # return $error if $error;
297 #my $error = $new->SUPER::replace($old, @_);
298 my $error = $new->SUPER::replace($old);
300 $dbh->rollback if $oldAutoCommit;
301 return $error if $error;
304 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
311 Checks all fields to make sure this is a valid service. If there is an error,
312 returns the error, otherwise returns false. Called by the insert and
321 $self->ut_numbern('svcnum')
322 || $self->ut_numbern('pkgnum')
323 || $self->ut_number('svcpart')
324 || $self->ut_numbern('agent_svcid')
325 || $self->ut_numbern('overlimit')
327 return $error if $error;
329 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
330 return "Unknown svcpart" unless $part_svc;
332 if ( $self->pkgnum ) {
333 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
334 return "Unknown pkgnum" unless $cust_pkg;
335 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
336 return "No svcpart ". $self->svcpart.
337 " services in pkgpart ". $cust_pkg->pkgpart
339 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
340 " services for pkgnum ". $self->pkgnum
341 if $part_svc->get('num_avail') == 0 and !$ignore_quantity;
349 Returns the definition for this service, as a FS::part_svc object (see
357 ? $self->{'_svcpart'}
358 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
363 Returns the package this service belongs to, as a FS::cust_pkg object (see
370 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
375 Returns the pkg_svc record for for this service, if applicable.
381 my $cust_pkg = $self->cust_pkg;
382 return undef unless $cust_pkg;
384 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
385 'pkgpart' => $cust_pkg->pkgpart,
392 Returns the date this service was inserted.
398 $self->h_date('insert');
401 =item pkg_cancel_date
403 Returns the date this service's package was canceled. This normally only
404 exists for a service that's been preserved through cancellation with the
405 part_pkg.preserve flag.
409 sub pkg_cancel_date {
411 my $cust_pkg = $self->cust_pkg or return;
412 return $cust_pkg->getfield('cancel') || '';
417 Returns a list consisting of:
418 - The name of this service (from part_svc)
419 - A meaningful identifier (username, domain, or mail alias)
420 - The table name (i.e. svc_domain) for this service
425 my($label, $value, $svcdb) = $cust_svc->label;
429 Like the B<label> method, except the second item in the list ("meaningful
430 identifier") may be longer - typically, a full name is included.
434 sub label { shift->_label('svc_label', @_); }
435 sub label_long { shift->_label('svc_label_long', @_); }
440 my $svc_x = $self->svc_x
441 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
443 $self->$method($svc_x);
446 sub svc_label { shift->_svc_label('label', @_); }
447 sub svc_label_long { shift->_svc_label('label_long', @_); }
450 my( $self, $method, $svc_x ) = ( shift, shift, shift );
452 my $identifier = $svc_x->$method(@_);
453 $identifier = '['.$self->agent_svcid.']'. $identifier if $self->agent_svcid;
456 $self->part_svc->svc,
458 $self->part_svc->svcdb,
466 Returns a listref of html elements associated with this service's exports.
472 my $svc_x = $self->svc_x
473 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
475 $svc_x->export_links;
478 =item export_getsettings
480 Returns two hashrefs of settings associated with this service's exports.
484 sub export_getsettings {
486 my $svc_x = $self->svc_x
487 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
489 $svc_x->export_getsettings;
495 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
496 FS::svc_domain object, etc.)
502 my $svcdb = $self->part_svc->svcdb;
503 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
504 $self->{'_svc_acct'};
506 require "FS/$svcdb.pm";
507 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
508 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
510 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
514 =item seconds_since TIMESTAMP
516 See L<FS::svc_acct/seconds_since>. Equivalent to
517 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
518 where B<svcdb> is not "svc_acct".
522 #internal session db deprecated (or at least on hold)
523 sub seconds_since { 'internal session db deprecated'; };
524 ##note: implementation here, POD in FS::svc_acct
526 # my($self, $since) = @_;
528 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
531 # AND logout IS NOT NULL'
532 # ) or die $dbh->errstr;
533 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
534 # $sth->fetchrow_arrayref->[0];
537 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
539 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
540 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
541 for records where B<svcdb> is not "svc_acct".
545 #note: implementation here, POD in FS::svc_acct
546 sub seconds_since_sqlradacct {
547 my($self, $start, $end) = @_;
549 my $mes = "$me seconds_since_sqlradacct:";
551 my $svc_x = $self->svc_x;
553 my @part_export = $self->part_svc->part_export_usage;
554 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
555 " service definition"
560 foreach my $part_export ( @part_export ) {
562 next if $part_export->option('ignore_accounting');
564 warn "$mes connecting to sqlradius database\n"
567 my $dbh = DBI->connect( map { $part_export->option($_) }
568 qw(datasrc username password) )
569 or die "can't connect to sqlradius database: ". $DBI::errstr;
571 warn "$mes connected to sqlradius database\n"
574 #select a unix time conversion function based on database type
575 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
577 my $username = $part_export->export_username($svc_x);
581 warn "$mes finding closed sessions completely within the given range\n"
586 if ($part_export->option('process_single_realm')) {
587 $realm = 'AND Realm = ?';
588 $realmparam = $part_export->option('realm');
591 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
595 AND $str2time AcctStartTime) >= ?
596 AND $str2time AcctStopTime ) < ?
597 AND $str2time AcctStopTime ) > 0
598 AND AcctStopTime IS NOT NULL"
599 ) or die $dbh->errstr;
600 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
602 my $regular = $sth->fetchrow_arrayref->[0];
604 warn "$mes finding open sessions which start in the range\n"
607 # count session start->range end
608 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
612 AND $str2time AcctStartTime ) >= ?
613 AND $str2time AcctStartTime ) < ?
614 AND ( ? - $str2time AcctStartTime ) ) < 86400
615 AND ( $str2time AcctStopTime ) = 0
616 OR AcctStopTime IS NULL )";
617 $sth = $dbh->prepare($query) or die $dbh->errstr;
620 ($realm ? $realmparam : ()),
624 or die $sth->errstr. " executing query $query";
625 my $start_during = $sth->fetchrow_arrayref->[0];
627 warn "$mes finding closed sessions which start before the range but stop during\n"
630 #count range start->session end
631 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
635 AND $str2time AcctStartTime ) < ?
636 AND $str2time AcctStopTime ) >= ?
637 AND $str2time AcctStopTime ) < ?
638 AND $str2time AcctStopTime ) > 0
639 AND AcctStopTime IS NOT NULL"
640 ) or die $dbh->errstr;
641 $sth->execute( $start,
643 ($realm ? $realmparam : ()),
648 my $end_during = $sth->fetchrow_arrayref->[0];
650 warn "$mes finding closed sessions which start before the range but stop after\n"
653 # count range start->range end
654 # don't count open sessions anymore (probably missing stop record)
655 $sth = $dbh->prepare("SELECT COUNT(*)
659 AND $str2time AcctStartTime ) < ?
660 AND ( $str2time AcctStopTime ) >= ?
662 # OR AcctStopTime = 0
663 # OR AcctStopTime IS NULL )"
664 ) or die $dbh->errstr;
665 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
667 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
669 $seconds += $regular + $end_during + $start_during + $entire_range;
671 warn "$mes done finding sessions\n"
680 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
682 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
683 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
684 for records where B<svcdb> is not "svc_acct".
688 #note: implementation here, POD in FS::svc_acct
689 #(false laziness w/seconds_since_sqlradacct above)
690 sub attribute_since_sqlradacct {
691 my($self, $start, $end, $attrib) = @_;
693 my $mes = "$me attribute_since_sqlradacct:";
695 my $svc_x = $self->svc_x;
697 my @part_export = $self->part_svc->part_export_usage;
698 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
699 " service definition"
705 foreach my $part_export ( @part_export ) {
707 next if $part_export->option('ignore_accounting');
709 warn "$mes connecting to sqlradius database\n"
712 my $dbh = DBI->connect( map { $part_export->option($_) }
713 qw(datasrc username password) )
714 or die "can't connect to sqlradius database: ". $DBI::errstr;
716 warn "$mes connected to sqlradius database\n"
719 #select a unix time conversion function based on database type
720 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
722 my $username = $part_export->export_username($svc_x);
724 warn "$mes SUMing $attrib sessions\n"
729 if ($part_export->option('process_single_realm')) {
730 $realm = 'AND Realm = ?';
731 $realmparam = $part_export->option('realm');
734 my $sth = $dbh->prepare("SELECT SUM($attrib)
738 AND $str2time AcctStopTime ) >= ?
739 AND $str2time AcctStopTime ) < ?
740 AND AcctStopTime IS NOT NULL"
741 ) or die $dbh->errstr;
742 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
745 my $row = $sth->fetchrow_arrayref;
746 $sum += $row->[0] if defined($row->[0]);
748 warn "$mes done SUMing sessions\n"
757 =item get_session_history TIMESTAMP_START TIMESTAMP_END
759 See L<FS::svc_acct/get_session_history>. Equivalent to
760 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
761 records where B<svcdb> is not "svc_acct".
765 sub get_session_history {
766 my($self, $start, $end, $attrib) = @_;
770 my @part_export = $self->part_svc->part_export_usage;
771 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
772 " service definition"
778 foreach my $part_export ( @part_export ) {
780 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
789 Returns an array of hashes representing the tickets linked to this service.
796 my $conf = FS::Conf->new;
797 my $num = $conf->config('cust_main-max_tickets') || 10;
800 if ( $conf->config('ticket_system') ) {
801 unless ( $conf->config('ticket_system-custom_priority_field') ) {
803 @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) };
807 foreach my $priority (
808 $conf->config('ticket_system-custom_priority_field-values'), ''
810 last if scalar(@tickets) >= $num;
812 @{ FS::TicketSystem->service_tickets( $self->svcnum,
813 $num - scalar(@tickets),
830 =item smart_search OPTION => VALUE ...
832 Accepts the option I<search>, the string to search for. The string will
833 be searched for as a username, email address, IP address, MAC address,
834 phone number, and hardware serial number. Unlike the I<smart_search> on
835 customers, this always requires an exact match.
839 # though perhaps it should be fuzzy in some cases?
842 my %param = __PACKAGE__->smart_search_param(@_);
846 sub smart_search_param {
850 my $string = $opt{'search'};
851 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
854 map { my $table = $_;
855 my $search_sql = "FS::$table"->search_sql($string);
857 AND 0 < ( SELECT COUNT(*) FROM $table
858 WHERE $table.svcnum = cust_svc.svcnum
863 FS::part_svc->svc_tables;
865 if ( $string =~ /^(\d+)$/ ) {
866 unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
869 my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
871 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
872 'null_right' => 'View/link unlinked services'
874 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
876 my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'.
877 ' LEFT JOIN cust_main USING ( custnum )'.
878 ' LEFT JOIN part_svc USING ( svcpart )';
881 'table' => 'cust_svc',
882 'addl_from' => $addl_from,
884 'extra_sql' => $extra_sql,
892 Behaviour of changing the svcpart of cust_svc records is undefined and should
893 possibly be prohibited, and pkg_svc records are not checked.
895 pkg_svc records are not checked in general (here).
897 Deleting this record doesn't check or delete the svc_* record associated
900 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
901 a DBI database handle is not yet implemented.
905 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
906 schema.html from the base documentation