voip_cdr call rating by day and time, RT#4763

9 files changed, 543 insertions, 43 deletions

diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm
index 6bc2338..f1e5c7d 100644
--- a/FS/FS/Mason.pm
+++ b/FS/FS/Mason.pm
@@ -244,6 +244,8 @@ if ( -e $addl_handler_use_file ) {
   use FS::cgp_rule_action;
   use FS::bill_batch;
   use FS::cust_bill_batch;
+  use FS::rate_time;
+  use FS::rate_time_interval;
   # Sammath Naur
 
   if ( $FS::Mason::addl_handler_use ) {
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 73392e8..f113146 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -2229,6 +2229,7 @@ sub tables_hashref {
         'conn_sec',        'int',     '',     '', '0', '',
         'min_charge',      'decimal', '', '10,5', '', '', #@money_type, '', '', 
         'sec_granularity', 'int',     '',     '', '', '', 
+        'ratetimenum',     'int', 'NULL',     '', '', '',
         #time period (link to table of periods)?
         'classnum',        'int', 'NULL',     '', '', '', 
       ],
@@ -2260,6 +2261,28 @@ sub tables_hashref {
       'index'       => [ [ 'countrycode' ], [ 'npa' ], [ 'regionnum' ] ],
     },
 
+    'rate_time' => {
+      'columns' => [
+        'ratetimenum', 'serial',      '',      '', '', '',
+        'ratetimename',   'varchar',      '', $char_d, '', '',
+      ],
+      'primary_key' => 'ratetimenum',
+      'unique'      => [],
+      'index'       => [],
+    },
+
+    'rate_time_interval' => {
+      'columns' => [
+        'intervalnum', 'serial', '', '', '', '',
+        'stime',          'int', '', '', '', '',
+        'etime',          'int', '', '', '', '',
+        'ratetimenum',    'int', '', '', '', '',
+      ],
+      'primary_key' => 'intervalnum',
+      'unique'      => [],
+      'index'       => [],
+    },
+
     'usage_class' => {
       'columns' => [
         'classnum',    'serial',      '',      '', '', '', 
diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm
index 9e21ba2..0ccd835 100644
--- a/FS/FS/part_pkg/voip_cdr.pm
+++ b/FS/FS/part_pkg/voip_cdr.pm
@@ -13,6 +13,8 @@ use FS::rate_prefix;
 use FS::rate_detail;
 use FS::part_pkg::recur_Common;
 
+use List::Util qw(first min);
+
 @ISA = qw(FS::part_pkg::recur_Common);
 
 $DEBUG = 1;
@@ -318,6 +320,8 @@ sub calc_usage {
     @dirass = split(',', $dirass);
   }
 
+  my %interval_cache = (); # for timed rates
+
   #for check_chargable, so we don't keep looking up options inside the loop
   my %opt_cache = ();
 
@@ -347,11 +351,16 @@ sub calc_usage {
 
       my $rate_detail;
       my( $rate_region, $regionnum );
+      my $rate;
       my $pretty_destnum;
       my $charge = '';
       my $seconds = '';
+      my $weektime = '';
       my $regionname = '';
       my $classnum = '';
+      my $countrycode;
+      my $number;
+
       my @call_details = ();
       if ( $rating_method eq 'prefix' ) {
 
@@ -378,7 +387,7 @@ sub calc_usage {
           # (or calling station id for toll free calls)
           ###
 
-          my( $to_or_from, $number );
+          my( $to_or_from );
           if ( $cdr->is_tollfree && ! $disable_tollfree )
           { #tollfree call
             $to_or_from = 'from';
@@ -398,7 +407,7 @@ sub calc_usage {
 #          $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
 
           #determine the country code
-          my $countrycode;
+          $countrycode = '';
           if (    $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
                || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
              )
@@ -427,11 +436,20 @@ sub calc_usage {
           #asterisks here causes inserting the detail to barf, so:
           $pretty_destnum =~ s/\*//g;
 
-          my $rate = qsearchs('rate', { 'ratenum' => $ratenum })
+          $rate = qsearchs('rate', { 'ratenum' => $ratenum })
             or die "ratenum $ratenum not found!";
 
+          my @ltime = localtime($cdr->startdate);
+          $weektime = $ltime[0] + 
+                      $ltime[1]*60 +   #minutes
+                      $ltime[2]*3600 + #hours
+                      $ltime[6]*86400; #days since sunday
+          # if there's no timed rate_detail for this time/region combination,
+          # dest_detail returns the default.  There may still be a timed rate 
+          # that applies after the starttime of the call, so be careful...
           $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
                                               'phonenum'    => $number,
+                                              'weektime'    => $weektime,
                                             });
 
           if ( $rate_detail ) {
@@ -443,6 +461,17 @@ sub calc_usage {
                  "and rate detail $rate_detail\n"
               if $DEBUG;
 
+            if ( !exists($interval_cache{$regionnum}) ) {
+              my @intervals = (
+                sort { $a->stime <=> $b->stime }
+                map { my $r = $_->rate_time; $r ? $r->intervals : () }
+                $rate->rate_detail
+              );
+              $interval_cache{$regionnum} = \@intervals;
+              warn "  cached ".scalar(@intervals)." interval(s)\n"
+                if $DEBUG;
+            }
+
           } elsif ( $ignore_unrateable ) {
 
             $rate_region = '';
@@ -557,60 +586,111 @@ sub calc_usage {
 
         unless ( @call_details || ( $charge ne '' && $charge == 0 ) ) {
 
-          $included_min{$regionnum} = $rate_detail->min_included
-            unless exists $included_min{$regionnum};
+          my $seconds_left = $use_duration ? $cdr->duration : $cdr->billsec;
+          # charge for the first (conn_sec) seconds
+          $seconds = min($seconds_left, $rate_detail->conn_sec);
+          $seconds_left -= $seconds; 
+          $weektime     += $seconds;
+          $charge = sprintf("%.02f", $rate_detail->conn_charge);
+
+          my $total_minutes = 0;
+          my $etime;
+          while($seconds_left) {
+            my $ratetimenum = $rate_detail->ratetimenum; # may be empty
+
+            # find the end of the current rate interval
+            if(@{ $interval_cache{$regionnum} } == 0) {
+              # There are no timed rates in this group, so just stay 
+              # in the default rate_detail for the entire duration.
+              $etime = 0;
+            } 
+            elsif($ratetimenum) {
+              # This is a timed rate, so go to the etime of this interval.
+              # If it's followed by another timed rate, the stime of that 
+              # interval should match the etime of this one.
+              my $interval = $rate_detail->rate_time->contains($weektime);
+              $etime = $interval->etime;
+            }
+            else {
+              # This is a default rate, so use the stime of the next 
+              # interval in the sequence.
+              my $next_int = first { $_->stime > $weektime } 
+                              @{ $interval_cache{$regionnum} };
+              if ($next_int) {
+                $etime = $next_int->stime;
+              }
+              else {
+                # weektime is near the end of the week, so decrement 
+                # it by a full week and use the stime of the first 
+                # interval.
+                $weektime -= (3600*24*7);
+                $etime = $interval_cache{$regionnum}->[0]->stime;
+              }
+            }
 
-          my $granularity = $rate_detail->sec_granularity;
+            my $charge_sec = min($seconds_left, $etime - $weektime);
 
-                      # length($cdr->billsec) ? $cdr->billsec : $cdr->duration;
-          $seconds = $use_duration ? $cdr->duration : $cdr->billsec;
+            $seconds_left -= $charge_sec;
+            $seconds += $charge_sec;
 
-          $seconds -= $rate_detail->conn_sec;
-          $seconds = 0 if $seconds < 0;
+            $included_min{$regionnum}{$ratetimenum} = $rate_detail->min_included
+              unless exists $included_min{$regionnum}{$ratetimenum};
 
-          $seconds += $granularity - ( $seconds % $granularity )
-            if $seconds      # don't granular-ize 0 billsec calls (bills them)
-            && $granularity; # 0 is per call
-          my $minutes = sprintf("%.1f", $seconds / 60);
-          $minutes =~ s/\.0$// if $granularity == 60;
+            my $granularity = $rate_detail->sec_granularity;
 
-          # per call rather than per minute
-          $minutes = 1 unless $granularity;
+            # should this be done in every rate interval?
+            $charge_sec += $granularity - ( $charge_sec % $granularity )
+              if $charge_sec   # don't granular-ize 0 billsec calls (bills them)
+              && $granularity; # 0 is per call
+            my $minutes = sprintf("%.1f", $charge_sec / 60);
+            $minutes =~ s/\.0$// if $granularity == 60;
 
-          $included_min{$regionnum} -= $minutes;
+            # per call rather than per minute
+            $minutes = 1 unless $granularity;
+            $seconds_left = 0 unless $granularity;
 
-          $charge = sprintf('%.2f', $rate_detail->conn_charge);
+            $included_min{$regionnum}{$ratetimenum} -= $minutes;
+            
+            if ( $included_min{$regionnum}{$ratetimenum} <= 0 ) {
+              my $charge_min = 0 - $included_min{$regionnum}{$ratetimenum}; #XXX should preserve
+                                                              #(display?) this
+              $included_min{$regionnum}{$ratetimenum} = 0;
+              $charge += sprintf('%.2f', ($rate_detail->min_charge * $charge_min)
+                                         + 0.00000001 ); #so 1.005 rounds to 1.01
+              $total_minutes += $minutes;
+            }
 
-          if ( $included_min{$regionnum} < 0 ) {
-            my $charge_min = 0 - $included_min{$regionnum}; #XXX should preserve
-                                                            #(display?) this
-            $included_min{$regionnum} = 0;
-            $charge += sprintf('%.2f', ($rate_detail->min_charge * $charge_min)
-                                       + 0.00000001 ); #so 1.005 rounds to 1.01
-            $charge = sprintf('%.2f', $charge);
-          }
-          warn "Incrementing \$charges by $charge.  Now $charges\n" if $DEBUG;
-          $charges += $charge;
+            # choose next rate_detail
+            $rate_detail = $rate->dest_detail({ 'countrycode' => $countrycode,
+                                                'phonenum'    => $number,
+                                                'weektime'    => $etime })
+                    if($seconds_left);
+            # we have now moved forward to $etime
+            $weektime = $etime;
 
+          } #while $seconds_left
           # this is why we need regionnum/rate_region....
           warn "  (rate region $rate_region)\n" if $DEBUG;
 
-          @call_details = (
-           $cdr->downstream_csv( 'format'         => $output_format,
-                                 'granularity'    => $granularity,
-                                 'minutes'        => $minutes,
-                                 'charge'         => $charge,
-                                 'pretty_dst'     => $pretty_destnum,
-                                 'dst_regionname' => $regionname,
-                               )
-          );
-
           $classnum = $rate_detail->classnum;
+          $charge = sprintf('%.2f', $charge);
 
-        }
+          @call_details = (
+            $cdr->downstream_csv( 'format'         => $output_format,
+                                  'granularity'    => $rate_detail->sec_granularity, 
+                                  'minutes'        => $total_minutes,
+                                  'charge'         => $charge,
+                                  'pretty_dst'     => $pretty_destnum,
+                                  'dst_regionname' => $regionname,
+                                )
+          );
+        } #if(there is a rate_detail)
+ 
 
         if ( $charge > 0 ) {
           #just use FS::cust_bill_pkg_detail objects?
+          warn "Incrementing \$charges by $charge.  Now $charges\n" if $DEBUG;
+          $charges += $charge;
           my $call_details;
           my $phonenum = $cust_svc->svc_x->phonenum;
 
diff --git a/FS/FS/rate.pm b/FS/FS/rate.pm
index 793846a..f30e4c7 100644
--- a/FS/FS/rate.pm
+++ b/FS/FS/rate.pm
@@ -279,16 +279,22 @@ Destination can be specified as an FS::rate_detail object or regionnum
 (see L<FS::rate_detail>), or as a hashref with two keys: I<countrycode>
 and I<phonenum>.
 
+An optional third key, I<weektime>, will return a timed rate (one with 
+a non-null I<ratetimenum>) if one exists for a call at that time.  If 
+no matching timed rate exists, the non-timed rate will be returned.
+
 =cut
 
 sub dest_detail {
   my $self = shift;
 
   my $regionnum;
+  my $weektime;
   if ( ref($_[0]) eq 'HASH' ) {
 
     my $countrycode = $_[0]->{'countrycode'};
     my $phonenum    = $_[0]->{'phonenum'};
+    $weektime       = $_[0]->{'weektime'};
 
     #find a rate prefix, first look at most specific, then fewer digits,
     # finally trying the country code only
@@ -314,9 +320,31 @@ sub dest_detail {
   } else {
     $regionnum = ref($_[0]) ? shift->regionnum : shift;
   }
-
-  qsearchs( 'rate_detail', { 'ratenum'        => $self->ratenum,
-                             'dest_regionnum' => $regionnum,     } );
+  
+  if(!defined($weektime)) {
+    return qsearchs( 'rate_detail', 
+                            { 'ratenum'        => $self->ratenum,
+                              'dest_regionnum' => $regionnum,
+                              'ratetimenum'    => '',
+                            } );
+  }
+  else {
+    my @details = grep { my $rate_time = $_->rate_time;
+                            $rate_time && $rate_time->contains($weektime) }
+                       qsearch( 'rate_detail',
+                                    { 'ratenum'        => $self->ratenum,
+                                      'dest_regionnum' => $regionnum, } );
+    if(!@details) {
+      # this may change at some point
+      return $self->dest_detail($regionnum);
+    }
+    elsif(@details == 1) {
+      return $details[0];
+    }
+    else {
+      die "overlapping rate_detail times (region $regionnum, time $weektime)\n";
+    }
+  }
 }
 
 =item rate_detail
diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm
index f6cdedf..7b90452 100644
--- a/FS/FS/rate_detail.pm
+++ b/FS/FS/rate_detail.pm
@@ -5,6 +5,7 @@ use vars qw( @ISA $DEBUG $me );
 use FS::Record qw( qsearch qsearchs dbh );
 use FS::rate;
 use FS::rate_region;
+use FS::rate_time;
 use Tie::IxHash;
 
 @ISA = qw(FS::Record);
@@ -54,6 +55,8 @@ inherits from FS::Record.  The following fields are currently supported:
 
 =item classnum - usage class (see L<FS::usage_class>) if any for this rate
 
+=item ratetimenum - rating time period (see L<FS::rate_time) if any
+
 =back
 
 =head1 METHODS
@@ -194,6 +197,30 @@ sub dest_prefixes_short {
   $self->dest_region->prefixes_short;
 }
 
+=item rate_time
+
+Returns the L<FS::rate_time> object associated with this call 
+plan rate, if there is one.
+
+=cut
+
+sub rate_time {
+  my $self = shift;
+  $self->ratetimenum ? FS::rate_time->by_key($self->ratetimenum) : ();
+}
+
+=item rate_time_name
+
+Returns the I<ratetimename> field of the L<FS::rate_time> object
+associated with this rate plan.
+
+=cut
+
+sub rate_time_name {
+  my $self = shift;
+  $self->ratetimenum ? $self->rate_time->ratetimename : '(default)';
+}
+
 =item classname
 
 Returns the name of the usage class (see L<FS::usage_class>) associated with
diff --git a/FS/FS/rate_time.pm b/FS/FS/rate_time.pm
new file mode 100644
index 0000000..40cd23e
--- /dev/null
+++ b/FS/FS/rate_time.pm
@@ -0,0 +1,168 @@
+package FS::rate_time;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+use FS::rate_time_interval;
+
+=head1 NAME
+
+FS::rate_time - Object methods for rate_time records
+
+=head1 SYNOPSIS
+
+  use FS::rate_time;
+
+  $record = new FS::rate_time \%hash;
+  $record = new FS::rate_time { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::rate_time object represents a time period for selection of CDR billing 
+rates.  FS::rate_time inherits from FS::Record.  The following fields are 
+currently supported:
+
+=over 4
+
+=item ratetimenum
+
+primary key
+
+=item ratetimename
+
+A label (like "Daytime" or "Weekend").
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example.  To add the example 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
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'rate_time'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=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.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example.  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('ratetimenum')
+    || $self->ut_text('ratetimename')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=item intervals
+
+Return the L<FS::rate_time_interval> objects included in this rating period.
+
+=cut
+
+sub intervals {
+  my $self = shift;
+  return qsearch({ table    => 'rate_time_interval', 
+                   hashref  => { ratetimenum => $self->ratetimenum },
+                   order_by => 'ORDER BY stime ASC',
+  });
+}
+
+=item contains TIME
+
+Return the L<FS::rate_time_interval> object that contains the specified 
+time-of-week (in seconds from the start of Sunday).  The primary use of 
+this is to test whether that time falls within this rating period.
+
+=cut
+
+sub contains {
+  my $self = shift;
+  my $weektime = shift;
+  return qsearchs('rate_time_interval', { ratetimenum => $self->ratetimenum,
+                                          stime => { op    => '<=', 
+                                                     value => $weektime },
+                                          etime => { op    => '>',
+                                                     value => $weektime },
+                                        } );
+}
+
+=item description
+
+Returns a list of arrayrefs containing the starting and 
+ending times of each interval in this period, in a readable
+format.
+
+=cut
+
+sub description {
+  my $self = shift;
+  return map { [ $_->description ] } $self->intervals;
+}
+
+
+=back
+
+=head1 BUGS
+
+To be seen.
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/rate_time_interval.pm b/FS/FS/rate_time_interval.pm
new file mode 100644
index 0000000..37bc83b
--- /dev/null
+++ b/FS/FS/rate_time_interval.pm
@@ -0,0 +1,162 @@
+package FS::rate_time_interval;
+
+use strict;
+use base qw( FS::Record );
+use FS::Record qw( qsearch qsearchs );
+
+=head1 NAME
+
+FS::rate_time_interval - Object methods for rate_time_interval records
+
+=head1 SYNOPSIS
+
+  use FS::rate_time_interval;
+
+  $record = new FS::rate_time_interval \%hash;
+  $record = new FS::rate_time_interval { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::rate_time_interval object represents an interval of clock time during 
+the week, such as "Monday, 7 AM to 8 PM".  FS::rate_time_interval inherits 
+from FS::Record.  The following fields are currently supported:
+
+=over 4
+
+=item intervalnum
+
+primary key
+
+=item stime
+
+Start of the interval, in seconds from midnight on Sunday.
+
+=item etime
+
+End of the interval.
+
+=item ratetimenum
+
+A foreign key to an L<FS::rate_time> object representing the set of intervals 
+to which this belongs.
+
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new example.  To add the example 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
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'rate_time_interval'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=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.
+
+=cut
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid example.  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('intervalnum')
+    || $self->ut_number('stime')
+    || $self->ut_number('etime')
+    || $self->ut_number('ratetimenum')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=item rate_time
+
+Returns the L<FS::rate_time> comprising this interval.
+
+=cut
+
+sub rate_time {
+  my $self = shift;
+  FS::rate_time->by_key($self->ratetimenum);
+}
+
+=item description
+
+Returns two strings containing stime and etime, formatted 
+"Day HH:MM:SS AM/PM".  Example: "Mon 5:00 AM".
+
+=cut
+
+my @days = qw(Sun Mon Tue Wed Thu Fri Sat);
+
+sub description {
+  my $self = shift;
+  return map { 
+            sprintf('%s %02d:%02d:%02d %s',
+            $days[int($_/86400) % 7],
+            int($_/3600) % 12,
+            int($_/60) % 60,
+            $_ % 60,
+            (($_/3600) % 24 < 12) ? 'AM' : 'PM' )
+       } ( $self->stime, $self->etime );
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::rate_time>, L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/t/rate_time.t b/FS/t/rate_time.t
new file mode 100644
index 0000000..ece37d1
--- /dev/null
+++ b/FS/t/rate_time.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::rate_time;
+$loaded=1;
+print "ok 1\n";
diff --git a/FS/t/rate_time_interval.t b/FS/t/rate_time_interval.t
new file mode 100644
index 0000000..68f9a95
--- /dev/null
+++ b/FS/t/rate_time_interval.t
@@ -0,0 +1,5 @@
+BEGIN { $| = 1; print "1..1\n" }
+END {print "not ok 1\n" unless $loaded;}
+use FS::rate_time_interval;
+$loaded=1;
+print "ok 1\n";