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
],
},
+ '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', '', '', '', '',
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
--- /dev/null
+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;
--- /dev/null
+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;
+
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
}
- #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} },
#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();
--- /dev/null
+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";
--- /dev/null
+<& 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>
--- /dev/null
+<& /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>
? "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>
projects / freeside.git / commitdiff