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;
18 #most FS::svc_ classes are autoloaded in svc_x emthod
19 use FS::svc_acct; #this one is used in the cache stuff
21 @ISA = qw( FS::cust_main_Mixin FS::option_Common ); #FS::Record );
30 my ( $hashref, $cache ) = @_;
31 if ( $hashref->{'username'} ) {
32 $self->{'_svc_acct'} = FS::svc_acct->new($hashref, '');
34 if ( $hashref->{'svc'} ) {
35 $self->{'_svcpart'} = FS::part_svc->new($hashref);
41 FS::cust_svc - Object method for cust_svc objects
47 $record = new FS::cust_svc \%hash
48 $record = new FS::cust_svc { 'column' => 'value' };
50 $error = $record->insert;
52 $error = $new_record->replace($old_record);
54 $error = $record->delete;
56 $error = $record->check;
58 ($label, $value) = $record->label;
62 An FS::cust_svc represents a service. FS::cust_svc inherits from FS::Record.
63 The following fields are currently supported:
67 =item svcnum - primary key (assigned automatically for new services)
69 =item pkgnum - Package (see L<FS::cust_pkg>)
71 =item svcpart - Service definition (see L<FS::part_svc>)
73 =item agent_svcid - Optional legacy service ID
75 =item overlimit - date the service exceeded its usage limit
85 Creates a new service. To add the refund to the database, see L<"insert">.
86 Services are normally created by creating FS::svc_ objects (see
87 L<FS::svc_acct>, L<FS::svc_domain>, and L<FS::svc_forward>, among others).
91 sub table { 'cust_svc'; }
95 Adds this service to the database. If there is an error, returns the error,
96 otherwise returns false.
100 Deletes this service from the database. If there is an error, returns the
101 error, otherwise returns false. Note that this only removes the cust_svc
102 record - you should probably use the B<cancel> method instead.
108 my $error = $self->SUPER::delete;
109 return $error if $error;
111 if ( FS::Conf->new->config('ticket_system') eq 'RT_Internal' ) {
112 FS::TicketSystem->init;
113 my $session = FS::TicketSystem->session;
114 my $links = RT::Links->new($session->{CurrentUser});
115 my $svcnum = $self->svcnum;
116 $links->Limit(FIELD => 'Target',
117 VALUE => 'freeside://freeside/cust_svc/'.$svcnum);
118 while ( my $l = $links->Next ) {
119 my ($val, $msg) = $l->Delete;
120 # can't do anything useful on error
121 warn "error unlinking ticket $svcnum: $msg\n" if !$val;
128 Cancels the relevant service by calling the B<cancel> method of the associated
129 FS::svc_XXX object (i.e. an FS::svc_acct object or FS::svc_domain object),
130 deleting the FS::svc_XXX record and then deleting this record.
132 If there is an error, returns the error, otherwise returns false.
139 local $SIG{HUP} = 'IGNORE';
140 local $SIG{INT} = 'IGNORE';
141 local $SIG{QUIT} = 'IGNORE';
142 local $SIG{TERM} = 'IGNORE';
143 local $SIG{TSTP} = 'IGNORE';
144 local $SIG{PIPE} = 'IGNORE';
146 my $oldAutoCommit = $FS::UID::AutoCommit;
147 local $FS::UID::AutoCommit = 0;
150 my $part_svc = $self->part_svc;
152 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
153 $dbh->rollback if $oldAutoCommit;
154 return "Illegal svcdb value in part_svc!";
157 require "FS/$svcdb.pm";
159 my $svc = $self->svc_x;
161 if ( %opt && $opt{'date'} ) {
162 my $error = $svc->expire($opt{'date'});
164 $dbh->rollback if $oldAutoCommit;
165 return "Error expiring service: $error";
168 my $error = $svc->cancel;
170 $dbh->rollback if $oldAutoCommit;
171 return "Error canceling service: $error";
173 $error = $svc->delete; #this deletes this cust_svc record as well
175 $dbh->rollback if $oldAutoCommit;
176 return "Error deleting service: $error";
183 warn "WARNING: no svc_ record found for svcnum ". $self->svcnum.
184 "; deleting cust_svc only\n";
186 my $error = $self->delete;
188 $dbh->rollback if $oldAutoCommit;
189 return "Error deleting cust_svc: $error";
194 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
200 =item overlimit [ ACTION ]
202 Retrieves or sets the overlimit date. If ACTION is absent, return
203 the present value of overlimit. If ACTION is present, it can
204 have the value 'suspend' or 'unsuspend'. In the case of 'suspend' overlimit
205 is set to the current time if it is not already set. The 'unsuspend' value
206 causes the time to be cleared.
208 If there is an error on setting, returns the error, otherwise returns false.
214 my $action = shift or return $self->getfield('overlimit');
216 local $SIG{HUP} = 'IGNORE';
217 local $SIG{INT} = 'IGNORE';
218 local $SIG{QUIT} = 'IGNORE';
219 local $SIG{TERM} = 'IGNORE';
220 local $SIG{TSTP} = 'IGNORE';
221 local $SIG{PIPE} = 'IGNORE';
223 my $oldAutoCommit = $FS::UID::AutoCommit;
224 local $FS::UID::AutoCommit = 0;
227 if ( $action eq 'suspend' ) {
228 $self->setfield('overlimit', time) unless $self->getfield('overlimit');
229 }elsif ( $action eq 'unsuspend' ) {
230 $self->setfield('overlimit', '');
232 die "unexpected action value: $action";
235 local $ignore_quantity = 1;
236 my $error = $self->replace;
238 $dbh->rollback if $oldAutoCommit;
239 return "Error setting overlimit: $error";
242 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
248 =item replace OLD_RECORD
250 Replaces the OLD_RECORD with this one in the database. If there is an error,
251 returns the error, otherwise returns false.
258 # my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
260 # : $new->replace_old;
261 my ( $new, $old ) = ( shift, shift );
262 $old = $new->replace_old unless defined($old);
264 local $SIG{HUP} = 'IGNORE';
265 local $SIG{INT} = 'IGNORE';
266 local $SIG{QUIT} = 'IGNORE';
267 local $SIG{TERM} = 'IGNORE';
268 local $SIG{TSTP} = 'IGNORE';
269 local $SIG{PIPE} = 'IGNORE';
271 my $oldAutoCommit = $FS::UID::AutoCommit;
272 local $FS::UID::AutoCommit = 0;
275 if ( $new->svcpart != $old->svcpart ) {
276 my $svc_x = $new->svc_x;
277 my $new_svc_x = ref($svc_x)->new({$svc_x->hash, svcpart=>$new->svcpart });
278 local($FS::Record::nowarn_identical) = 1;
279 my $error = $new_svc_x->replace($svc_x);
281 $dbh->rollback if $oldAutoCommit;
282 return $error if $error;
286 # #trigger a re-export on pkgnum changes?
287 # # (of prepaid packages), for Expiration RADIUS attribute
288 # if ( $new->pkgnum != $old->pkgnum && $new->cust_pkg->part_pkg->is_prepaid ) {
289 # my $svc_x = $new->svc_x;
290 # local($FS::Record::nowarn_identical) = 1;
291 # my $error = $svc_x->export('replace');
293 # $dbh->rollback if $oldAutoCommit;
294 # return $error if $error;
298 #trigger a pkg_change export on pkgnum changes
299 if ( $new->pkgnum != $old->pkgnum ) {
300 my $error = $new->svc_x->export('pkg_change', $new->cust_pkg,
304 $dbh->rollback if $oldAutoCommit;
305 return $error if $error;
309 #my $error = $new->SUPER::replace($old, @_);
310 my $error = $new->SUPER::replace($old);
312 $dbh->rollback if $oldAutoCommit;
313 return $error if $error;
316 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
323 Checks all fields to make sure this is a valid service. If there is an error,
324 returns the error, otherwise returns false. Called by the insert and
333 $self->ut_numbern('svcnum')
334 || $self->ut_numbern('pkgnum')
335 || $self->ut_number('svcpart')
336 || $self->ut_numbern('agent_svcid')
337 || $self->ut_numbern('overlimit')
339 return $error if $error;
341 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
342 return "Unknown svcpart" unless $part_svc;
344 if ( $self->pkgnum ) {
345 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
346 return "Unknown pkgnum" unless $cust_pkg;
347 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
348 return "No svcpart ". $self->svcpart.
349 " services in pkgpart ". $cust_pkg->pkgpart
350 unless $part_svc || $ignore_quantity;
351 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
352 " services for pkgnum ". $self->pkgnum
353 if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ;
361 Returns the displayed service number for this service: agent_svcid if it has a
362 value, svcnum otherwise
368 $self->agent_svcid || $self->svcnum;
373 Returns the definition for this service, as a FS::part_svc object (see
381 ? $self->{'_svcpart'}
382 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
387 Returns the package this service belongs to, as a FS::cust_pkg object (see
394 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
399 Returns the pkg_svc record for for this service, if applicable.
405 my $cust_pkg = $self->cust_pkg;
406 return undef unless $cust_pkg;
408 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
409 'pkgpart' => $cust_pkg->pkgpart,
416 Returns the date this service was inserted.
422 $self->h_date('insert');
425 =item pkg_cancel_date
427 Returns the date this service's package was canceled. This normally only
428 exists for a service that's been preserved through cancellation with the
429 part_pkg.preserve flag.
433 sub pkg_cancel_date {
435 my $cust_pkg = $self->cust_pkg or return;
436 return $cust_pkg->getfield('cancel') || '';
441 Returns a list consisting of:
442 - The name of this service (from part_svc)
443 - A meaningful identifier (username, domain, or mail alias)
444 - The table name (i.e. svc_domain) for this service
449 my($label, $value, $svcdb) = $cust_svc->label;
453 Like the B<label> method, except the second item in the list ("meaningful
454 identifier") may be longer - typically, a full name is included.
458 sub label { shift->_label('svc_label', @_); }
459 sub label_long { shift->_label('svc_label_long', @_); }
464 my $svc_x = $self->svc_x
465 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
467 $self->$method($svc_x);
470 sub svc_label { shift->_svc_label('label', @_); }
471 sub svc_label_long { shift->_svc_label('label_long', @_); }
474 my( $self, $method, $svc_x ) = ( shift, shift, shift );
477 $self->part_svc->svc,
479 $self->part_svc->svcdb,
487 Returns a listref of html elements associated with this service's exports.
493 my $svc_x = $self->svc_x
494 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
496 $svc_x->export_links;
499 =item export_getsettings
501 Returns two hashrefs of settings associated with this service's exports.
505 sub export_getsettings {
507 my $svc_x = $self->svc_x
508 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
510 $svc_x->export_getsettings;
516 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
517 FS::svc_domain object, etc.)
523 my $svcdb = $self->part_svc->svcdb;
524 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
525 $self->{'_svc_acct'};
527 require "FS/$svcdb.pm";
528 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
529 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
531 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
535 =item seconds_since TIMESTAMP
537 See L<FS::svc_acct/seconds_since>. Equivalent to
538 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
539 where B<svcdb> is not "svc_acct".
543 #internal session db deprecated (or at least on hold)
544 sub seconds_since { 'internal session db deprecated'; };
545 ##note: implementation here, POD in FS::svc_acct
547 # my($self, $since) = @_;
549 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
552 # AND logout IS NOT NULL'
553 # ) or die $dbh->errstr;
554 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
555 # $sth->fetchrow_arrayref->[0];
558 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
560 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
561 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
562 for records where B<svcdb> is not "svc_acct".
566 #note: implementation here, POD in FS::svc_acct
567 sub seconds_since_sqlradacct {
568 my($self, $start, $end) = @_;
570 my $mes = "$me seconds_since_sqlradacct:";
572 my $svc_x = $self->svc_x;
574 my @part_export = $self->part_svc->part_export_usage;
575 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
576 " service definition"
581 foreach my $part_export ( @part_export ) {
583 next if $part_export->option('ignore_accounting');
585 warn "$mes connecting to sqlradius database\n"
588 my $dbh = DBI->connect( map { $part_export->option($_) }
589 qw(datasrc username password) )
590 or die "can't connect to sqlradius database: ". $DBI::errstr;
592 warn "$mes connected to sqlradius database\n"
595 #select a unix time conversion function based on database type
596 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
598 my $username = $part_export->export_username($svc_x);
602 warn "$mes finding closed sessions completely within the given range\n"
607 if ($part_export->option('process_single_realm')) {
608 $realm = 'AND Realm = ?';
609 $realmparam = $part_export->option('realm');
612 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
616 AND $str2time AcctStartTime) >= ?
617 AND $str2time AcctStopTime ) < ?
618 AND $str2time AcctStopTime ) > 0
619 AND AcctStopTime IS NOT NULL"
620 ) or die $dbh->errstr;
621 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
623 my $regular = $sth->fetchrow_arrayref->[0];
625 warn "$mes finding open sessions which start in the range\n"
628 # count session start->range end
629 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
633 AND $str2time AcctStartTime ) >= ?
634 AND $str2time AcctStartTime ) < ?
635 AND ( ? - $str2time AcctStartTime ) ) < 86400
636 AND ( $str2time AcctStopTime ) = 0
637 OR AcctStopTime IS NULL )";
638 $sth = $dbh->prepare($query) or die $dbh->errstr;
641 ($realm ? $realmparam : ()),
645 or die $sth->errstr. " executing query $query";
646 my $start_during = $sth->fetchrow_arrayref->[0];
648 warn "$mes finding closed sessions which start before the range but stop during\n"
651 #count range start->session end
652 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
656 AND $str2time AcctStartTime ) < ?
657 AND $str2time AcctStopTime ) >= ?
658 AND $str2time AcctStopTime ) < ?
659 AND $str2time AcctStopTime ) > 0
660 AND AcctStopTime IS NOT NULL"
661 ) or die $dbh->errstr;
662 $sth->execute( $start,
664 ($realm ? $realmparam : ()),
669 my $end_during = $sth->fetchrow_arrayref->[0];
671 warn "$mes finding closed sessions which start before the range but stop after\n"
674 # count range start->range end
675 # don't count open sessions anymore (probably missing stop record)
676 $sth = $dbh->prepare("SELECT COUNT(*)
680 AND $str2time AcctStartTime ) < ?
681 AND ( $str2time AcctStopTime ) >= ?
683 # OR AcctStopTime = 0
684 # OR AcctStopTime IS NULL )"
685 ) or die $dbh->errstr;
686 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
688 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
690 $seconds += $regular + $end_during + $start_during + $entire_range;
692 warn "$mes done finding sessions\n"
701 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
703 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
704 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
705 for records where B<svcdb> is not "svc_acct".
709 #note: implementation here, POD in FS::svc_acct
710 #(false laziness w/seconds_since_sqlradacct above)
711 sub attribute_since_sqlradacct {
712 my($self, $start, $end, $attrib) = @_;
714 my $mes = "$me attribute_since_sqlradacct:";
716 my $svc_x = $self->svc_x;
718 my @part_export = $self->part_svc->part_export_usage;
719 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
720 " service definition"
726 foreach my $part_export ( @part_export ) {
728 next if $part_export->option('ignore_accounting');
730 warn "$mes connecting to sqlradius database\n"
733 my $dbh = DBI->connect( map { $part_export->option($_) }
734 qw(datasrc username password) )
735 or die "can't connect to sqlradius database: ". $DBI::errstr;
737 warn "$mes connected to sqlradius database\n"
740 #select a unix time conversion function based on database type
741 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
743 my $username = $part_export->export_username($svc_x);
745 warn "$mes SUMing $attrib sessions\n"
750 if ($part_export->option('process_single_realm')) {
751 $realm = 'AND Realm = ?';
752 $realmparam = $part_export->option('realm');
755 my $sth = $dbh->prepare("SELECT SUM($attrib)
759 AND $str2time AcctStopTime ) >= ?
760 AND $str2time AcctStopTime ) < ?
761 AND AcctStopTime IS NOT NULL"
762 ) or die $dbh->errstr;
763 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
766 my $row = $sth->fetchrow_arrayref;
767 $sum += $row->[0] if defined($row->[0]);
769 warn "$mes done SUMing sessions\n"
778 =item get_session_history TIMESTAMP_START TIMESTAMP_END
780 See L<FS::svc_acct/get_session_history>. Equivalent to
781 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
782 records where B<svcdb> is not "svc_acct".
786 sub get_session_history {
787 my($self, $start, $end, $attrib) = @_;
791 my @part_export = $self->part_svc->part_export_usage;
792 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
793 " service definition"
799 foreach my $part_export ( @part_export ) {
801 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
810 Returns an array of hashes representing the tickets linked to this service.
817 my $conf = FS::Conf->new;
818 my $num = $conf->config('cust_main-max_tickets') || 10;
821 if ( $conf->config('ticket_system') ) {
822 unless ( $conf->config('ticket_system-custom_priority_field') ) {
824 @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) };
828 foreach my $priority (
829 $conf->config('ticket_system-custom_priority_field-values'), ''
831 last if scalar(@tickets) >= $num;
833 @{ FS::TicketSystem->service_tickets( $self->svcnum,
834 $num - scalar(@tickets),
851 =item smart_search OPTION => VALUE ...
853 Accepts the option I<search>, the string to search for. The string will
854 be searched for as a username, email address, IP address, MAC address,
855 phone number, and hardware serial number. Unlike the I<smart_search> on
856 customers, this always requires an exact match.
860 # though perhaps it should be fuzzy in some cases?
863 my %param = __PACKAGE__->smart_search_param(@_);
867 sub smart_search_param {
871 my $string = $opt{'search'};
872 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
875 map { my $table = $_;
876 my $search_sql = "FS::$table"->search_sql($string);
878 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
879 "FROM $table WHERE $search_sql";
881 FS::part_svc->svc_tables;
883 if ( $string =~ /^(\d+)$/ ) {
884 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
887 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
888 " ON (svc_all.svcnum = cust_svc.svcnum) ";
892 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
893 'null_right' => 'View/link unlinked services'
895 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
897 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
898 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
899 ' LEFT JOIN part_svc USING ( svcpart )';
902 'table' => 'cust_svc',
903 'select' => 'svc_all.svcnum AS svcnum, '.
904 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb, '.
906 'addl_from' => $addl_from,
908 'extra_sql' => $extra_sql,
915 # fix missing (deleted by mistake) svc_x records
916 warn "searching for missing svc_x records...\n";
918 'table' => 'cust_svc',
919 'select' => 'cust_svc.*',
920 'addl_from' => ' LEFT JOIN ( ' .
922 map { "SELECT svcnum FROM $_" }
923 FS::part_svc->svc_tables
924 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
925 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
927 my @svcs = qsearch(\%search);
928 warn "found ".scalar(@svcs)."\n";
930 local $FS::Record::nowarn_classload = 1; # for h_svc_
931 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
934 'hashref' => { history_action => 'delete' },
935 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
937 foreach my $cust_svc (@svcs) {
938 my $svcnum = $cust_svc->svcnum;
939 my $svcdb = $cust_svc->part_svc->svcdb;
940 $h_search{'hashref'}{'svcnum'} = $svcnum;
941 $h_search{'table'} = "h_$svcdb";
942 my $h_svc_x = qsearchs(\%h_search)
944 my $class = "FS::$svcdb";
945 my $new_svc_x = $class->new({ $h_svc_x->hash });
946 my $error = $new_svc_x->insert;
947 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
958 Behaviour of changing the svcpart of cust_svc records is undefined and should
959 possibly be prohibited, and pkg_svc records are not checked.
961 pkg_svc records are not checked in general (here).
963 Deleting this record doesn't check or delete the svc_* record associated
966 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
967 a DBI database handle is not yet implemented.
971 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
972 schema.html from the base documentation