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 #my $error = $new->SUPER::replace($old, @_);
299 my $error = $new->SUPER::replace($old);
301 $dbh->rollback if $oldAutoCommit;
302 return $error if $error;
305 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
312 Checks all fields to make sure this is a valid service. If there is an error,
313 returns the error, otherwise returns false. Called by the insert and
322 $self->ut_numbern('svcnum')
323 || $self->ut_numbern('pkgnum')
324 || $self->ut_number('svcpart')
325 || $self->ut_numbern('agent_svcid')
326 || $self->ut_numbern('overlimit')
328 return $error if $error;
330 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
331 return "Unknown svcpart" unless $part_svc;
333 if ( $self->pkgnum ) {
334 my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
335 return "Unknown pkgnum" unless $cust_pkg;
336 ($part_svc) = grep { $_->svcpart == $self->svcpart } $cust_pkg->part_svc;
337 return "No svcpart ". $self->svcpart.
338 " services in pkgpart ". $cust_pkg->pkgpart
339 unless $part_svc || $ignore_quantity;
340 return "Already ". $part_svc->get('num_cust_svc'). " ". $part_svc->svc.
341 " services for pkgnum ". $self->pkgnum
342 if !$ignore_quantity && $part_svc->get('num_avail') <= 0 ;
350 Returns the displayed service number for this service: agent_svcid if it has a
351 value, svcnum otherwise
357 $self->agent_svcid || $self->svcnum;
362 Returns the definition for this service, as a FS::part_svc object (see
370 ? $self->{'_svcpart'}
371 : qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
376 Returns the package this service belongs to, as a FS::cust_pkg object (see
383 qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
388 Returns the pkg_svc record for for this service, if applicable.
394 my $cust_pkg = $self->cust_pkg;
395 return undef unless $cust_pkg;
397 qsearchs( 'pkg_svc', { 'svcpart' => $self->svcpart,
398 'pkgpart' => $cust_pkg->pkgpart,
405 Returns the date this service was inserted.
411 $self->h_date('insert');
414 =item pkg_cancel_date
416 Returns the date this service's package was canceled. This normally only
417 exists for a service that's been preserved through cancellation with the
418 part_pkg.preserve flag.
422 sub pkg_cancel_date {
424 my $cust_pkg = $self->cust_pkg or return;
425 return $cust_pkg->getfield('cancel') || '';
430 Returns a list consisting of:
431 - The name of this service (from part_svc)
432 - A meaningful identifier (username, domain, or mail alias)
433 - The table name (i.e. svc_domain) for this service
438 my($label, $value, $svcdb) = $cust_svc->label;
442 Like the B<label> method, except the second item in the list ("meaningful
443 identifier") may be longer - typically, a full name is included.
447 sub label { shift->_label('svc_label', @_); }
448 sub label_long { shift->_label('svc_label_long', @_); }
453 my $svc_x = $self->svc_x
454 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
456 $self->$method($svc_x);
459 sub svc_label { shift->_svc_label('label', @_); }
460 sub svc_label_long { shift->_svc_label('label_long', @_); }
463 my( $self, $method, $svc_x ) = ( shift, shift, shift );
466 $self->part_svc->svc,
468 $self->part_svc->svcdb,
476 Returns a listref of html elements associated with this service's exports.
482 my $svc_x = $self->svc_x
483 or return [ "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum ];
485 $svc_x->export_links;
488 =item export_getsettings
490 Returns two hashrefs of settings associated with this service's exports.
494 sub export_getsettings {
496 my $svc_x = $self->svc_x
497 or return "can't find ". $self->part_svc->svcdb. '.svcnum '. $self->svcnum;
499 $svc_x->export_getsettings;
505 Returns the FS::svc_XXX object for this service (i.e. an FS::svc_acct object or
506 FS::svc_domain object, etc.)
512 my $svcdb = $self->part_svc->svcdb;
513 if ( $svcdb eq 'svc_acct' && $self->{'_svc_acct'} ) {
514 $self->{'_svc_acct'};
516 require "FS/$svcdb.pm";
517 warn "$me svc_x: part_svc.svcpart ". $self->part_svc->svcpart.
518 ", so searching for $svcdb.svcnum ". $self->svcnum. "\n"
520 qsearchs( $svcdb, { 'svcnum' => $self->svcnum } );
524 =item seconds_since TIMESTAMP
526 See L<FS::svc_acct/seconds_since>. Equivalent to
527 $cust_svc->svc_x->seconds_since, but more efficient. Meaningless for records
528 where B<svcdb> is not "svc_acct".
532 #internal session db deprecated (or at least on hold)
533 sub seconds_since { 'internal session db deprecated'; };
534 ##note: implementation here, POD in FS::svc_acct
536 # my($self, $since) = @_;
538 # my $sth = $dbh->prepare(' SELECT SUM(logout-login) FROM session
541 # AND logout IS NOT NULL'
542 # ) or die $dbh->errstr;
543 # $sth->execute($self->svcnum, $since) or die $sth->errstr;
544 # $sth->fetchrow_arrayref->[0];
547 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
549 See L<FS::svc_acct/seconds_since_sqlradacct>. Equivalent to
550 $cust_svc->svc_x->seconds_since_sqlradacct, but more efficient. Meaningless
551 for records where B<svcdb> is not "svc_acct".
555 #note: implementation here, POD in FS::svc_acct
556 sub seconds_since_sqlradacct {
557 my($self, $start, $end) = @_;
559 my $mes = "$me seconds_since_sqlradacct:";
561 my $svc_x = $self->svc_x;
563 my @part_export = $self->part_svc->part_export_usage;
564 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
565 " service definition"
570 foreach my $part_export ( @part_export ) {
572 next if $part_export->option('ignore_accounting');
574 warn "$mes connecting to sqlradius database\n"
577 my $dbh = DBI->connect( map { $part_export->option($_) }
578 qw(datasrc username password) )
579 or die "can't connect to sqlradius database: ". $DBI::errstr;
581 warn "$mes connected to sqlradius database\n"
584 #select a unix time conversion function based on database type
585 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
587 my $username = $part_export->export_username($svc_x);
591 warn "$mes finding closed sessions completely within the given range\n"
596 if ($part_export->option('process_single_realm')) {
597 $realm = 'AND Realm = ?';
598 $realmparam = $part_export->option('realm');
601 my $sth = $dbh->prepare("SELECT SUM(acctsessiontime)
605 AND $str2time AcctStartTime) >= ?
606 AND $str2time AcctStopTime ) < ?
607 AND $str2time AcctStopTime ) > 0
608 AND AcctStopTime IS NOT NULL"
609 ) or die $dbh->errstr;
610 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
612 my $regular = $sth->fetchrow_arrayref->[0];
614 warn "$mes finding open sessions which start in the range\n"
617 # count session start->range end
618 $query = "SELECT SUM( ? - $str2time AcctStartTime ) )
622 AND $str2time AcctStartTime ) >= ?
623 AND $str2time AcctStartTime ) < ?
624 AND ( ? - $str2time AcctStartTime ) ) < 86400
625 AND ( $str2time AcctStopTime ) = 0
626 OR AcctStopTime IS NULL )";
627 $sth = $dbh->prepare($query) or die $dbh->errstr;
630 ($realm ? $realmparam : ()),
634 or die $sth->errstr. " executing query $query";
635 my $start_during = $sth->fetchrow_arrayref->[0];
637 warn "$mes finding closed sessions which start before the range but stop during\n"
640 #count range start->session end
641 $sth = $dbh->prepare("SELECT SUM( $str2time AcctStopTime ) - ? )
645 AND $str2time AcctStartTime ) < ?
646 AND $str2time AcctStopTime ) >= ?
647 AND $str2time AcctStopTime ) < ?
648 AND $str2time AcctStopTime ) > 0
649 AND AcctStopTime IS NOT NULL"
650 ) or die $dbh->errstr;
651 $sth->execute( $start,
653 ($realm ? $realmparam : ()),
658 my $end_during = $sth->fetchrow_arrayref->[0];
660 warn "$mes finding closed sessions which start before the range but stop after\n"
663 # count range start->range end
664 # don't count open sessions anymore (probably missing stop record)
665 $sth = $dbh->prepare("SELECT COUNT(*)
669 AND $str2time AcctStartTime ) < ?
670 AND ( $str2time AcctStopTime ) >= ?
672 # OR AcctStopTime = 0
673 # OR AcctStopTime IS NULL )"
674 ) or die $dbh->errstr;
675 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end )
677 my $entire_range = ($end-$start) * $sth->fetchrow_arrayref->[0];
679 $seconds += $regular + $end_during + $start_during + $entire_range;
681 warn "$mes done finding sessions\n"
690 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
692 See L<FS::svc_acct/attribute_since_sqlradacct>. Equivalent to
693 $cust_svc->svc_x->attribute_since_sqlradacct, but more efficient. Meaningless
694 for records where B<svcdb> is not "svc_acct".
698 #note: implementation here, POD in FS::svc_acct
699 #(false laziness w/seconds_since_sqlradacct above)
700 sub attribute_since_sqlradacct {
701 my($self, $start, $end, $attrib) = @_;
703 my $mes = "$me attribute_since_sqlradacct:";
705 my $svc_x = $self->svc_x;
707 my @part_export = $self->part_svc->part_export_usage;
708 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
709 " service definition"
715 foreach my $part_export ( @part_export ) {
717 next if $part_export->option('ignore_accounting');
719 warn "$mes connecting to sqlradius database\n"
722 my $dbh = DBI->connect( map { $part_export->option($_) }
723 qw(datasrc username password) )
724 or die "can't connect to sqlradius database: ". $DBI::errstr;
726 warn "$mes connected to sqlradius database\n"
729 #select a unix time conversion function based on database type
730 my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
732 my $username = $part_export->export_username($svc_x);
734 warn "$mes SUMing $attrib sessions\n"
739 if ($part_export->option('process_single_realm')) {
740 $realm = 'AND Realm = ?';
741 $realmparam = $part_export->option('realm');
744 my $sth = $dbh->prepare("SELECT SUM($attrib)
748 AND $str2time AcctStopTime ) >= ?
749 AND $str2time AcctStopTime ) < ?
750 AND AcctStopTime IS NOT NULL"
751 ) or die $dbh->errstr;
752 $sth->execute($username, ($realm ? $realmparam : ()), $start, $end)
755 my $row = $sth->fetchrow_arrayref;
756 $sum += $row->[0] if defined($row->[0]);
758 warn "$mes done SUMing sessions\n"
767 =item get_session_history TIMESTAMP_START TIMESTAMP_END
769 See L<FS::svc_acct/get_session_history>. Equivalent to
770 $cust_svc->svc_x->get_session_history, but more efficient. Meaningless for
771 records where B<svcdb> is not "svc_acct".
775 sub get_session_history {
776 my($self, $start, $end, $attrib) = @_;
780 my @part_export = $self->part_svc->part_export_usage;
781 die "no accounting-capable exports are enabled for ". $self->part_svc->svc.
782 " service definition"
788 foreach my $part_export ( @part_export ) {
790 @{ $part_export->usage_sessions( $start, $end, $self->svc_x ) };
799 Returns an array of hashes representing the tickets linked to this service.
806 my $conf = FS::Conf->new;
807 my $num = $conf->config('cust_main-max_tickets') || 10;
810 if ( $conf->config('ticket_system') ) {
811 unless ( $conf->config('ticket_system-custom_priority_field') ) {
813 @tickets = @{ FS::TicketSystem->service_tickets($self->svcnum, $num) };
817 foreach my $priority (
818 $conf->config('ticket_system-custom_priority_field-values'), ''
820 last if scalar(@tickets) >= $num;
822 @{ FS::TicketSystem->service_tickets( $self->svcnum,
823 $num - scalar(@tickets),
840 =item smart_search OPTION => VALUE ...
842 Accepts the option I<search>, the string to search for. The string will
843 be searched for as a username, email address, IP address, MAC address,
844 phone number, and hardware serial number. Unlike the I<smart_search> on
845 customers, this always requires an exact match.
849 # though perhaps it should be fuzzy in some cases?
852 my %param = __PACKAGE__->smart_search_param(@_);
856 sub smart_search_param {
860 my $string = $opt{'search'};
861 $string =~ s/(^\s+|\s+$)//; #trim leading & trailing whitespace
864 map { my $table = $_;
865 my $search_sql = "FS::$table"->search_sql($string);
867 "SELECT $table.svcnum AS svcnum, '$table' AS svcdb ".
868 "FROM $table WHERE $search_sql";
870 FS::part_svc->svc_tables;
872 if ( $string =~ /^(\d+)$/ ) {
873 unshift @or, "SELECT cust_svc.svcnum, NULL as svcdb FROM cust_svc WHERE agent_svcid = $1";
876 my $addl_from = " RIGHT JOIN (\n" . join("\nUNION\n", @or) . "\n) AS svc_all ".
877 " ON (svc_all.svcnum = cust_svc.svcnum) ";
881 push @extra_sql, $FS::CurrentUser::CurrentUser->agentnums_sql(
882 'null_right' => 'View/link unlinked services'
884 my $extra_sql = ' WHERE '.join(' AND ', @extra_sql);
886 $addl_from .= ' LEFT JOIN cust_pkg USING ( pkgnum )'.
887 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg').
888 ' LEFT JOIN part_svc USING ( svcpart )';
891 'table' => 'cust_svc',
892 'select' => 'svc_all.svcnum AS svcnum, '.
893 'COALESCE(svc_all.svcdb, part_svc.svcdb) AS svcdb',
894 'addl_from' => $addl_from,
896 'extra_sql' => $extra_sql,
903 # fix missing (deleted by mistake) svc_x records
904 warn "searching for missing svc_x records...\n";
906 'table' => 'cust_svc',
907 'select' => 'cust_svc.*',
908 'addl_from' => ' LEFT JOIN ( ' .
910 map { "SELECT svcnum FROM $_" }
911 FS::part_svc->svc_tables
912 ) . ' ) AS svc_all ON cust_svc.svcnum = svc_all.svcnum',
913 'extra_sql' => ' WHERE svc_all.svcnum IS NULL',
915 my @svcs = qsearch(\%search);
916 warn "found ".scalar(@svcs)."\n";
918 local $FS::Record::nowarn_classload = 1; # for h_svc_
919 local $FS::svc_Common::noexport_hack = 1; # because we're inserting services
922 'hashref' => { history_action => 'delete' },
923 'order_by' => ' ORDER BY history_date DESC LIMIT 1',
925 foreach my $cust_svc (@svcs) {
926 my $svcnum = $cust_svc->svcnum;
927 my $svcdb = $cust_svc->part_svc->svcdb;
928 $h_search{'hashref'}{'svcnum'} = $svcnum;
929 $h_search{'table'} = "h_$svcdb";
930 my $h_svc_x = qsearchs(\%h_search)
932 my $class = "FS::$svcdb";
933 my $new_svc_x = $class->new({ $h_svc_x->hash });
934 my $error = $new_svc_x->insert;
935 warn "error repairing svcnum $svcnum ($svcdb) from history:\n$error\n"
946 Behaviour of changing the svcpart of cust_svc records is undefined and should
947 possibly be prohibited, and pkg_svc records are not checked.
949 pkg_svc records are not checked in general (here).
951 Deleting this record doesn't check or delete the svc_* record associated
954 In seconds_since_sqlradacct, specifying a DATASRC/USERNAME/PASSWORD instead of
955 a DBI database handle is not yet implemented.
959 L<FS::Record>, L<FS::cust_pkg>, L<FS::part_svc>, L<FS::pkg_svc>,
960 schema.html from the base documentation