diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/Conf.pm | 7 | ||||
| -rw-r--r-- | FS/FS/Record.pm | 43 | ||||
| -rw-r--r-- | FS/FS/svc_acct.pm | 29 | ||||
| -rw-r--r-- | FS/MANIFEST | 1 | ||||
| -rwxr-xr-x | FS/bin/freeside-daily | 13 | ||||
| -rw-r--r-- | FS/bin/freeside-prepaidd | 75 |
6 files changed, 155 insertions, 13 deletions
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 463d0b49e..37d649bf9 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1562,6 +1562,13 @@ httemplate/docs/config.html ], }, + { + 'key' => 'cust_pkg-display_times', + 'section' => 'UI', + 'description' => 'Display full timestamps (not just dates) for customer packages. Useful if you are doing real-time things like hourly prepaid.', + 'type' => 'checkbox', + }, + ); 1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 9cff57936..d84365804 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -185,13 +185,36 @@ sub create { } } -=item qsearch TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM +=item qsearch PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM Searches the database for all records matching (at least) the key/value pairs in HASHREF. Returns all the records found as `FS::TABLE' objects if that module is loaded (i.e. via `use FS::cust_main;'), otherwise returns FS::Record objects. +The preferred usage is to pass a hash reference of named parameters: + + my @records = qsearch( { + 'table' => 'table_name', + 'hashref' => { 'field' => 'value' + 'field' => { 'op' => '<', + 'value' => '420', + }, + }, + + #these are optional... + 'select' => '*', + 'extra_sql' => 'AND field ', + #'cache_obj' => '', #optional + 'addl_from' => 'LEFT JOIN othtable USING ( field )', + } + ); + +Much code still uses old-style positional parameters, this is also probably +fine in the common case where there are only two parameters: + + my @records = qsearch( 'table', { 'field' => 'value' } ); + ###oops, argh, FS::Record::new only lets us create database fields. #Normal behaviour if SELECT is not specified is `*', as in #C<SELECT * FROM table WHERE ...>. However, there is an experimental new @@ -204,12 +227,24 @@ objects. =cut sub qsearch { - my($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_; + my($stable, $record, $select, $extra_sql, $cache, $addl_from ); + if ( ref($_[0]) ) { #hashref for now, eventually maybe accept a list too + my $opt = shift; + $stable = $opt->{'table'} or die "table name is required"; + $record = $opt->{'hashref'} || {}; + $select = $opt->{'select'} || '*'; + $extra_sql = $opt->{'extra_sql'} || ''; + $cache = $opt->{'cache_obj'} || ''; + $addl_from = $opt->{'addl_from'} || ''; + } else { + ($stable, $record, $select, $extra_sql, $cache, $addl_from ) = @_; + $select ||= '*'; + } + #$stable =~ /^([\w\_]+)$/ or die "Illegal table: $table"; #for jsearch $stable =~ /^([\w\s\(\)\.\,\=]+)$/ or die "Illegal table: $stable"; $stable = $1; - $select ||= '*'; my $dbh = dbh; my $table = $cache ? $cache->table : $stable; @@ -471,7 +506,7 @@ sub jsearch { ); } -=item qsearchs TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM +=item qsearchs PARAMS_HASHREF | TABLE, HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ, ADDL_FROM Same as qsearch, except that if more than one record matches, it B<carp>s but returns the first. If this happens, you either made a logic error in asking diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 1ec5429e9..de89819b3 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -15,6 +15,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles @saltset @pw_set ); use Carp; use Fcntl qw(:flock); +use Date::Format; use Crypt::PasswdMD5 1.2; use FS::UID qw( datasrc ); use FS::Conf; @@ -1011,6 +1012,7 @@ expected to change in the future. sub radius_reply { my $self = shift; + my %reply = map { /^(radius_(.*))$/; @@ -1018,12 +1020,15 @@ sub radius_reply { #$attrib =~ s/_/\-/g; ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); } grep { /^radius_/ && $self->getfield($_) } fields( $self->table ); + if ( $self->slipip && $self->slipip ne '0e0' ) { $reply{$radius_ip} = $self->slipip; } + if ( $self->seconds !~ /^$/ ) { $reply{'Session-Timeout'} = $self->seconds; } + %reply; } @@ -1040,16 +1045,25 @@ expected to change in the future. sub radius_check { my $self = shift; - my $password = $self->_password; - my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; - ( $pw_attrib => $password, + + my %check = map { /^(rc_(.*))$/; my($column, $attrib) = ($1, $2); #$attrib =~ s/_/\-/g; ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) ); - } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ) - ); + } grep { /^rc_/ && $self->getfield($_) } fields( $self->table ); + + my $password = $self->_password; + my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password; + + my $cust_pkg = $self->cust_svc->cust_pkg; + if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid ) { + $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html + } + + %check; + } =item domain @@ -1086,10 +1100,7 @@ Returns the FS::cust_svc record for this account (see L<FS::cust_svc>). =cut -sub cust_svc { - my $self = shift; - qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } ); -} +#inherited from svc_Common =item email diff --git a/FS/MANIFEST b/FS/MANIFEST index f756b5c77..e7d9dea34 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -291,3 +291,4 @@ FS/banned_pay.pm t/banned_pay.t FS/cancel_reason.pm t/cancel_reason.t +bin/freeside-prepaidd diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 589af8998..603da12b8 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -89,6 +89,19 @@ foreach $cust_main ( @cust_main ) { $cust_main->custnum. ": $error" if $error; } + # $^T not $time because -d is for pre-printing invoices + foreach my $cust_pkg ( + grep { $_->part_pkg->is_prepaid + && $_->bill && $_->bill < $^T && ! $_->susp + } + $cust_main->ncancelled_pkgs + ) { + my $error = $cust_pkg->suspend; + warn "Error suspending package ". $cust_pkg->pkgnum. + " for custnum ". $cust_main->custnum. + ": $error" + if $error; + } my $error = $cust_main->bill( 'time' => $time, 'resetup' => $opt_s, ); diff --git a/FS/bin/freeside-prepaidd b/FS/bin/freeside-prepaidd new file mode 100644 index 000000000..e51a56350 --- /dev/null +++ b/FS/bin/freeside-prepaidd @@ -0,0 +1,75 @@ +#!/usr/bin/perl -w + +use strict; +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); # qsearchs); +use FS::cust_pkg; + +my $user = shift or die &usage; + +#daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs +daemonize1('freeside-prepaidd'); + +drop_root(); + +adminsuidsetup($user); + +logfile( "/usr/local/etc/freeside/prepaidd-log.". $FS::UID::datasrc ); + +daemonize2(); + +#-- + +while (1) { + + foreach my $cust_pkg ( + qsearch( { + 'select' => 'cust_pkg.*, part_pkg.plan', + 'table' => 'cust_pkg', + 'addl_from' => 'LEFT JOIN part_pkg USING ( pkgpart )', + #'hashref' => { 'plan' => 'prepaid' },#should check part_pkg::is_prepaid + #'extra_sql' => "AND bill < ". time. + 'hashref' => {}, + 'extra_sql' => "WHERE plan = 'prepaid' AND bill < ". time. + " AND bill IS NOT NULL". + " AND ( susp IS NULL OR susp = 0)". + " AND ( cancel IS NULL OR cancel = 0)" + } ) + ) { + my $error = $cust_pkg->suspend; + warn "Error suspended package ". $cust_pkg->pkgnum. + " for custnum ". $cust_pkg->custnum. + ": $error\n" + if $error; + } + + die "exiting" if sigterm() || sigint(); + sleep 5; + +} + +#-- + +sub usage { + die "Usage:\n\n freeside-prepaidd user\n"; +} + +=head1 NAME + +freeside-prepaidd - Real-time daemon for prepaid packages + +=head1 SYNOPSIS + + freeside-prepaidd + +=head1 DESCRIPTION + +Runs continuously and suspendes any prepaid customer packages which have +passed their renewal date (next bill date). + +=head1 SEE ALSO + +=cut + +1; |