diff options
| -rw-r--r-- | FS/FS.pm | 2 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 20 | ||||
| -rw-r--r-- | FS/FS/cust_main.pm | 1 | ||||
| -rw-r--r-- | FS/FS/cust_main/Credit_Limit.pm | 87 | ||||
| -rw-r--r-- | FS/FS/cust_main_credit_limit.pm | 121 | ||||
| -rw-r--r-- | FS/bin/freeside-cdrrated | 27 | ||||
| -rw-r--r-- | FS/t/cust_main_credit_limit.t | 5 | ||||
| -rw-r--r-- | httemplate/search/cust_main_credit_limit.html | 63 | ||||
| -rw-r--r-- | httemplate/search/report_cust_main_credit_limit.html | 24 | ||||
| -rw-r--r-- | httemplate/view/cust_main/billing.html | 3 |
10 files changed, 348 insertions, 5 deletions
@@ -376,6 +376,8 @@ L<FS::cust_main_Mixin> - Mixin class for records that contain fields from cust_m L<FS::cust_main_invoice> - Invoice destination class +L<FS::cust_main_credit_limit> - Customer credit limit events class + L<FS::cust_class> - Customer classification class L<FS::cust_category> - Customer category class diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 4211ee2..bd58698 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -1879,6 +1879,26 @@ sub tables_hashref { ], }, + 'cust_main_credit_limit' => { + 'columns' => [ + 'creditlimitnum', 'serial', '', '', '', '', + 'custnum', 'int', '', '', '', '', + '_date', @date_type, '', '', + 'amount', @money_typen, '', '', + #'amount_currency', 'char', 'NULL', 3, '', '', + 'credit_limit', @money_typen, '', '', + #'credit_limit_currency', 'char', 'NULL', 3, '', '', + ], + 'primary_key' => 'creditlimitnum', + 'unique' => [], + 'index' => [ ['custnum'], ], + 'foreign_keys' => [ + { columns => [ 'custnum' ], + table => 'cust_main', + }, + ], + }, + 'cust_main_note' => { 'columns' => [ 'notenum', 'serial', '', '', '', '', diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 57c0095..b37b0da 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -7,6 +7,7 @@ use base qw( FS::cust_main::Packages FS::cust_main::Billing_Discount FS::cust_main::Billing_ThirdParty FS::cust_main::Location + FS::cust_main::Credit_Limit FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin FS::geocode_Mixin FS::Quotable_Mixin FS::Sales_Mixin FS::o2m_Common diff --git a/FS/FS/cust_main/Credit_Limit.pm b/FS/FS/cust_main/Credit_Limit.pm new file mode 100644 index 0000000..238d885 --- /dev/null +++ b/FS/FS/cust_main/Credit_Limit.pm @@ -0,0 +1,87 @@ +package FS::cust_main::Credit_Limit; + +use strict; +use vars qw( $conf $default_credit_limit $credit_limit_delay ); +use FS::UID qw( dbh ); +use FS::Record qw( qsearchs ); +use FS::cust_main_credit_limit; + +#ask FS::UID to run this stuff for us later +install_callback FS::UID sub { + $conf = new FS::Conf; + #yes, need it for stuff below (prolly should be cached) + $default_credit_limit = $conf->config('default_credit_limit') || 0; +}; + +$credit_limit_delay = 6 * 60 * 60; #6 hours? conf? + +sub check_credit_limit { + my $self = shift; + + my $credit_limit = $self->credit_limit || $default_credit_limit; + + return '' unless $credit_limit > 0; + + #see if we've already triggered this credit limit recently + return '' + if qsearchs({ + 'table' => 'cust_main_credit_limit', + 'hashref' => { + 'custnum' => $self->custnum, + 'credit_limit' => { op=>'>=', value=> $credit_limit }, + '_date' => { op=>'>=', value=> time - $credit_limit_delay, }, + }, + 'order_by' => 'LIMIT 1', + }); + + #count up prerated CDRs + + my @cust_svc = map $_->cust_svc_unsorted( 'svcdb'=>'svc_phone' ), + $self->all_pkgs; + my @svcnum = map $_->svcnum, @cust_svc; + + #false laziness w/svc_phone->sum_cdrs / psearch_cdrs + my $sum = qsearchs( { + 'select' => 'SUM(rated_price) AS rated_price', + 'table' => 'cdr', + 'hashref' => { 'status' => 'rated', + 'svcnum' => { op => 'IN', + value => '('. join(',',@svcnum). ')', + }, + }, + } ); + + return '' unless $sum->rated_price > $credit_limit; + + #XXX trigger an alert + # (email send / ticket create / nagios alert export) ? + # maybe an over_credit_limit cust_main export or some such? + + # record we did it so we don't do it continuously + my $cust_main_credit_limit = new FS::cust_main_credit_limit { + 'custnum' => $self->custnum, + '_date' => time, + 'credit_limit' => $credit_limit, + 'amount' => sprintf('%.2f', $sum->rated_price ), + }; + my $error = $cust_main_credit_limit->insert; + if ( $error ) { + #"should never happen", but better to survive e.g. database going + # away and coming back and resume doing our thing + warn $error; + sleep 30; + } + +} + +sub num_cust_main_credit_limit { + my $self = shift; + + my $sql = 'SELECT COUNT(*) FROM cust_main_credit_limit WHERE custnum = ?'; + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute( $self->custnum) or die $sth->errstr; + + $sth->fetchrow_arrayref->[0]; +} + +1; diff --git a/FS/FS/cust_main_credit_limit.pm b/FS/FS/cust_main_credit_limit.pm new file mode 100644 index 0000000..5a5181d --- /dev/null +++ b/FS/FS/cust_main_credit_limit.pm @@ -0,0 +1,121 @@ +package FS::cust_main_credit_limit; +use base qw( FS::Record ); + +use strict; +#use FS::Record qw( qsearch qsearchs ); +use FS::cust_main; + +=head1 NAME + +FS::cust_main_credit_limit - Object methods for cust_main_credit_limit records + +=head1 SYNOPSIS + + use FS::cust_main_credit_limit; + + $record = new FS::cust_main_credit_limit \%hash; + $record = new FS::cust_main_credit_limit { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cust_main_credit_limit object represents a specific incident where a +customer exceeds their credit limit. FS::cust_main_credit_limit inherits from +FS::Record. The following fields are currently supported: + +=over 4 + +=item creditlimitnum + +primary key + +=item custnum + +Customer (see L<FS::cust_main>) + +=item _date + +Ppecified as a UNIX timestamp; see L<perlfunc/"time">. Also see +L<Time::Local> and L<Date::Parse> for conversion functions. + +=item amount + +Amount of credit of the incident + +=item credit_limit + +Appliable customer or default credit_limit at the time of the incident + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new record. To add the record to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +sub table { 'cust_main_credit_limit'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. + +=item delete + +Delete this record from the database. + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=item check + +Checks all fields to make sure this is a valid record. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('creditlimitnum') + || $self->ut_foreign_keyn('custnum', 'cust_main', 'custnum') + || $self->ut_number('_date') + || $self->ut_money('amount') + || $self->ut_money('credit_limit') + ; + return $error if $error; + + $self->SUPER::check; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record> + +=cut + +1; + diff --git a/FS/bin/freeside-cdrrated b/FS/bin/freeside-cdrrated index 99ea675..1333240 100644 --- a/FS/bin/freeside-cdrrated +++ b/FS/bin/freeside-cdrrated @@ -37,7 +37,7 @@ our %svcnum = (); # phonenum => svcnum our %pkgnum = (); # phonenum => pkgnum our %cust_pkg = (); # pkgnum => cust_pkg (NOT phonenum => cust_pkg!) our %pkgpart = (); # phonenum => pkgpart -our %part_pkg = (); # phonenum => part_pkg +our %part_pkg = (); # pkgpart => part_pkg #some false laziness w/freeside-cdrrewrited @@ -127,10 +127,12 @@ while (1) { } - #unless ( $part_pkg{$pkgpart{$number}} ) { - #} - - #XXX if $part_pkg->option('min_included') then we can't prerate this CDR + if ( $part_pkg{ $pkgpart{$number} }->option('min_included') ) { + #then we can't prerate this CDR + #some sort of warning? + # (sucks if you're depending on credit limit fraud warnings) + next; + } my $error = $cdr->rate( 'part_pkg' => $part_pkg{ $pkgpart{$number} }, @@ -141,6 +143,21 @@ while (1) { #XXX ??? warn $error; sleep 30; + } else { + + #this could get expensive on a per-call basis + # trigger in a separate process with less frequency? + + my $cust_main = $cust_pkg{ $pkgnum{$number} }->cust_main; + + my $error = $cust_main->check_credit_limit; + if ( $error ) { + #"should never happen" normally, but as a daemon, better to survive + # e.g. database going away and coming back and resume doing our thing + warn $error; + sleep 30; + } + } last if sigterm() || sigint(); diff --git a/FS/t/cust_main_credit_limit.t b/FS/t/cust_main_credit_limit.t new file mode 100644 index 0000000..11f8adf --- /dev/null +++ b/FS/t/cust_main_credit_limit.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cust_main_credit_limit; +$loaded=1; +print "ok 1\n"; diff --git a/httemplate/search/cust_main_credit_limit.html b/httemplate/search/cust_main_credit_limit.html new file mode 100644 index 0000000..b2a0c9b --- /dev/null +++ b/httemplate/search/cust_main_credit_limit.html @@ -0,0 +1,63 @@ +<& elements/search.html, + 'title' => 'Credit limit incidents', + 'name_singular' => 'incident', + 'query' => { table => 'cust_main_credit_limit', + hashref => \%hash, + extra_sql => " AND $dates_sql ", + order_by => 'ORDER BY _date ASC', + }, + 'count_query' => "SELECT COUNT(*) FROM cust_main_credit_limit", + 'header' => [ 'Date', + + #XXX should use cust_fields etc. + '#', + 'Customer', + + 'Amount', + 'Limit', + ], + 'fields' => [ sub { time2str($date_format, shift->_date); }, + + #XXX should use cust_fields etc. + sub { shift->cust_main->display_custnum }, + sub { shift->cust_main->name }, + + sub { $money_char. shift->amount }, + sub { $money_char. shift->credit_limit }, + ], + + 'links' => [ '', + + #XXX should use cust_fields etc. + $cust_link, + $cust_link, + + '', + '', + ], +&> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('List rating data'); + +my $conf = new FS::Conf; + +my $date_format = $conf->config('date_format') || '%m/%d/%Y'; + +my $money_char = $conf->config('money_char') || '$'; + +my $cust_link = [ "${p}view/cust_main.cgi?", 'custnum' ]; + +my ($begin, $end) = FS::UI::Web::parse_beginning_ending($cgi); +my $dates_sql = "_date >= $begin AND _date < $end"; + +my $count_query= "SELECT COUNT(*) FROM cust_main_credit_limit WHERE $dates_sql"; + +my %hash = (); +if ( $cgi->param('custnum') =~ /^(\d+)$/ ) { + $hash{custnum} = $1; + $count_query .= " AND custnum = $1"; +} + +</%init> diff --git a/httemplate/search/report_cust_main_credit_limit.html b/httemplate/search/report_cust_main_credit_limit.html new file mode 100644 index 0000000..8503fb3 --- /dev/null +++ b/httemplate/search/report_cust_main_credit_limit.html @@ -0,0 +1,24 @@ +<& /elements/header.html, 'Credit limit incidents' &> + +<FORM ACTION="cust_main_credit_limit.html" METHOD="GET"> + +<TABLE BGCOLOR="#cccccc" CELLSPACING=0> + +<& /elements/tr-search-cust_main.html, 'label' => 'Customer' &> + +<TR><TD></TD><TD><FONT SIZE="-1">(leave blank for all customers)</FONT></TD></TR> + +<& /elements/tr-input-beginning_ending.html &> + +</TABLE> + +<BR> +<INPUT TYPE="submit" VALUE="Get Report"> + +<& /elements/footer.html &> +<%init> + +die "access denied" + unless $FS::CurrentUser::CurrentUser->access_right('List rating data'); + +</%init> diff --git a/httemplate/view/cust_main/billing.html b/httemplate/view/cust_main/billing.html index 382fdac..2c4b3fb 100644 --- a/httemplate/view/cust_main/billing.html +++ b/httemplate/view/cust_main/billing.html @@ -273,6 +273,9 @@ ? "Default ($money_char". sprintf("%.2f", $default_credit_limit). ")" : emt('Unlimited') %> +% if ( $cust_main->num_cust_main_credit_limit ) { + <A HREF="<% $p %>search/cust_main_credit_limit.html?custnum=<% $cust_main->custnum %>">(incidents)</A> +% } </TD> </TR> |