credit limit for CDR prerating, RT#27267

7 files changed, 258 insertions, 5 deletions

diff --git a/FS/FS.pm b/FS/FS.pm
index c19d2a9..41d5138 100644
--- a/FS/FS.pm
+++ b/FS/FS.pm
@@ -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";