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 displayed service number for this service: agent_svcid if it has a
350 value, svcnum otherwise
356 $self->agent_svcid || $self->svcnum;
361 Returns the definition for this service, as a FS::part_svc object (see
369 ? $self->{'_svcpart'}
370 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
375 Returns the package this service belongs to, as a FS::cust_pkg object (see
382 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
387 Returns the pkg_svc record for for this service, if applicable.
393 my $cust_pkg = $self->cust_pkg;
394 return undef unless $cust_pkg;
396 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
397 'pkgpart' => $cust_pkg->pkgpart,
404 Returns the date this service was inserted.
410 $self->h_date('insert');
413 =item pkg_cancel_date
415 Returns the date this service's package was canceled. This normally only
416 exists for a service that's been preserved through cancellation with the
417 part_pkg.preserve flag.
421 sub pkg_cancel_date {
423 my $cust_pkg = $self->cust_pkg or return;
424 return $cust_pkg->getfield('cancel') || '';
429 Returns a list consisting of:
430 - The name of this service (from part_svc)
431 - A meaningful identifier (username, domain, or mail alias)
432 - The table name (i.e. svc_domain) for this service
437 my($label, $value, $svcdb) = $cust_svc->label;
441 Like the B<label> method, except the second item in the list ("meaningful
442 identifier") may be longer - typically, a full name is included.
446 sub label { shift->_label('svc_label', @_); }
447 sub label_long { shift->_label('svc_label_long', @_); }
452 my $svc_x = $self->svc_x
453 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
455 $self->$method($svc_x);
458 sub svc_label { shift->_svc_label('label', @_); }
459 sub svc_label_long { shift->_svc_label('label_long', @_); }
462 my( $self, $method, $svc_x ) = ( shift, shift, shift );
465 $self->part_svc->svc,
467 $self->part_svc->svcdb,
475 Returns a listref of html elements associated with this service's exports.
481 my $svc_x = $self->svc_x
482 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
484 $svc_x->export_links;
487 =item export_getsettings
489 Returns two hashrefs of settings associated with this service's exports.
493 sub export_getsettings {
495 my $svc_x = $self->svc_x
496 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
498 $svc_x->export_getsettings;
504 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
505 FS::svc_domain object, etc.)
511 my $svcdb = $self->part_svc->svcdb;
512 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
513 $self->{'_svc_acct'};
515 require "FS/$svcdb.pm";
516 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
517 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
519 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
523 =item seconds_since TIMESTAMP
525 See L<FS::svc_acct/seconds_since>. Equivalent to
526 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
527 where B<svcdb> is not "svc_acct".
531 #internal session db deprecated (or at least on hold)
532 sub seconds_since { 'internal session db deprecated'; };
533 ##note: implementation here, POD in FS::svc_acct
535 # my($self, $since) = @_;
537 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
540 # AND logout IS NOT NULL'
541 # ) or die $dbh->errstr;
542 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
543 # $sth->fetchrow_arrayref->[0];
546 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
548 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
549 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
550 for records where B<svcdb> is not "svc_acct".
554 #note: implementation here, POD in FS::svc_acct
555 sub seconds_since_sqlradacct {
556 my($self, $start, $end) = @_;
558 my $mes = "$me seconds_since_sqlradacct:";
560 my $svc_x = $self->svc_x;
562 my @part_export = $self->part_svc->part_export_usage;
563 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
564 " service definition"
569 foreach my $part_export ( @part_export ) {
571 next if $part_export->option('ignore_accounting');
573 warn "$mes connecting to sqlradius database\n"
576 my $dbh = DBI->connect( map { $part_export->option($_) }
577 qw(datasrc username password) )
578 or die "can't connect to sqlradius database: ". $DBI::errstr;
580 warn "$mes connected to sqlradius database\n"
583 #select a unix time conversion function based on database type
584 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
586 my $username = $part_export->export_username($svc_x);
590 warn "$mes finding closed sessions completely within the given range\n"
595 if ($part_export->option('process_single_realm')) {
596 $realm = 'AND Realm = ?';
597 $realmparam = $part_export->option('realm');
600 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
604 AND $str2time AcctStartTime) >= ?
605 AND $str2time AcctStopTime ) < ?
606 AND $str2time AcctStopTime ) > 0
607 AND AcctStopTime IS NOT NULL"
608 ) or die $dbh->errstr;
609 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
611 my $regular = $sth->fetchrow_arrayref->[0];
613 warn "$mes finding open sessions which start in the range\n"
616 # count session start->range end
617 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
621 AND $str2time AcctStartTime ) >= ?
622 AND $str2time AcctStartTime ) < ?
623 AND ( ? - $str2time AcctStartTime ) ) < 86400
624 AND ( $str2time AcctStopTime ) = 0
625 OR AcctStopTime IS NULL )";
626 $sth = $dbh->prepare($query) or die $dbh->errstr;
629 ($realm ? $realmparam : ()),
633 or die $sth->errstr. " executing query $query";
634 my $start_during = $sth->fetchrow_arrayref->[0];
636 warn "$mes finding closed sessions which start before the range but stop during\n"
639 #count range start->session end
640 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
644 AND $str2time AcctStartTime ) < ?
645 AND $str2time AcctStopTime ) >= ?
646 AND $str2time AcctStopTime ) < ?
647 AND $str2time AcctStopTime ) > 0
648 AND AcctStopTime IS NOT NULL"
649 ) or die $dbh->errstr;
650 $sth->execute( $start,
652 ($realm ? $realmparam : ()),
657 my $end_during = $sth->fetchrow_arrayref->[0];
659 warn "$mes finding closed sessions which start before the range but stop after\n"
662 # count range start->range end
663 # don't count open sessions anymore (probably missing stop record)
664 $sth = $dbh->prepare("SELECT COUNT(*)
668 AND $str2time AcctStartTime ) < ?
669 AND ( $str2time AcctStopTime ) >= ?
671 # OR AcctStopTime = 0
672 # OR AcctStopTime IS NULL )"
673 ) or die $dbh->errstr;
674 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
676 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
678 $seconds += $regular + $end_during + $start_during + $entire_range;
680 warn "$mes done finding sessions\n"
689 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
691 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
692 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
693 for records where B<svcdb> is not "svc_acct".
697 #note: implementation here, POD in FS::svc_acct
698 #(false laziness w/seconds_since_sqlradacct above)
699 sub attribute_since_sqlradacct {
700 my($self, $start, $end, $attrib) = @_;
702 my $mes = "$me attribute_since_sqlradacct:";
704 my $svc_x = $self->svc_x;
706 my @part_export = $self->part_svc->part_export_usage;
707 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
708 " service definition"
714 foreach my $part_export ( @part_export ) {
716 next if $part_export->option('ignore_accounting');
718 warn "$mes connecting to sqlradius database\n"
721 my $dbh = DBI->connect( map { $part_export->option($_) }
722 qw(datasrc username password) )
723 or die "can't connect to sqlradius database: ". $DBI::errstr;
725 warn "$mes connected to sqlradius database\n"
728 #select a unix time conversion function based on database type
729 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
731 my $username = $part_export->export_username($svc_x);
733 warn "$mes SUMing $attrib sessions\n"
738 if ($part_export->option('process_single_realm')) {
739 $realm = 'AND Realm = ?';
740 $realmparam = $part_export->option('realm');
743 my $sth = $dbh->prepare("SELECT SUM($attrib)
747 AND $str2time AcctStopTime ) >= ?
748 AND $str2time AcctStopTime ) < ?
749 AND AcctStopTime IS NOT NULL"
750 ) or die $dbh->errstr;
751 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
754 my $row = $sth->fetchrow_arrayref;
755 $sum += $row->[0] if defined($row->[0]);
757 warn "$mes done SUMing sessions\n"
766 =item get_session_history TIMESTAMP_START TIMESTAMP_END
768 See L<FS::svc_acct/get_session_history>. Equivalent to
769 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
770 records where B<svcdb> is not "svc_acct".
774 sub get_session_history {
775 my($self, $start, $end, $attrib) = @_;
779 my @part_export = $self->part_svc->part_export_usage;
780 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
781 " service definition"
787 foreach my $part_export ( @part_export ) {
789 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
798 Returns an array of hashes representing the tickets linked to this service.
805 my $conf = FS::Conf->new;
806 my $num = $conf->config('cust_main-max_tickets') || 10;
809 if ( $conf->config('ticket_system') ) {
810 unless ( $conf->config('ticket_system-custom_priority_field') ) {
812 @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) };
816 foreach my $priority (
817 $conf->config('ticket_system-custom_priority_field-values'), ''
819 last if scalar(@tickets) >= $num;
821 @{ FS::TicketSystem->service_tickets( $self->svcnum,
822 $num - scalar(@tickets),
839 =item smart_search OPTION => VALUE ...
841 Accepts the option I<search>, the string to search for. The string will
842 be searched for as a username, email address, IP address, MAC address,
843 phone number, and hardware serial number. Unlike the I<smart_search> on
844 customers, this always requires an exact match.
848 # though perhaps it should be fuzzy in some cases?
851 my %param = __PACKAGE__->smart_search_param(@_);
855 sub smart_search_param {
859 my $string = $opt{'search'};
860 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
863 map { my $table = $_;
864 my $search_sql = "FS::$table"->search_sql($string);
866 AND 0 < ( SELECT COUNT(*) FROM $table
867 WHERE $table.svcnum = cust_svc.svcnum
872 FS::part_svc->svc_tables;
874 if ( $string =~ /^(\d+)$/ ) {
875 unshift @or, " ( agent_svcid IS NOT NULL AND agent_svcid = $1 ) ";
878 my @extra_sql = ' ( '. join(' OR ', @or). ' ) ';
880 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
881 'null_right' => 'View/link unlinked services'
883 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
885 my $addl_from = ' LEFT JOIN cust_pkg USING ( pkgnum )'.
886 ' LEFT JOIN cust_main USING ( custnum )'.
887 ' LEFT JOIN part_svc USING ( svcpart )';
890 'table' => 'cust_svc',
891 'addl_from' => $addl_from,
893 'extra_sql' => $extra_sql,
901 Behaviour of changing the svcpart of cust_svc records is undefined and should
902 possibly be prohibited, and pkg_svc records are not checked.
904 pkg_svc records are not checked in general (here).
906 Deleting this record doesn't check or delete the svc_* record associated
909 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
910 a DBI database handle is not yet implemented.
914 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
915 schema.html from the base documentation