better invoice summary, RT#20601
[freeside.git] / FS / FS / cdr.pm
index 842cfab..fedf28a 100644 (file)
@@ -11,6 +11,7 @@ use Date::Parse;
 use Date::Format;
 use Time::Local;
 use List::Util qw( first min );
+use Text::CSV_XS;
 use FS::UID qw( dbh );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs );
@@ -87,6 +88,10 @@ following fields are currently supported:
 
 =item lastdata - Last application data
 
+=item src_ip_addr - Source IP address (dotted quad, zero-filled)
+
+=item dst_ip_addr - Destination IP address (same)
+
 =item startdate - Start of call (UNIX-style integer timestamp)
 
 =item answerdate - Answer time of call (UNIX-style integer timestamp)
@@ -148,7 +153,7 @@ following fields are currently supported:
 
 =item svcnum - Link to customer service (see L<FS::cust_svc>)
 
-=item freesidestatus - NULL, processing-tiered, rated, done
+=item freesidestatus - NULL, processing-tiered, rated, done, skipped, no-charge, failed
 
 =item freesiderewritestatus - NULL, done, skipped
 
@@ -187,6 +192,8 @@ sub table_info {
         'dstchannel'            => 'Destination channel',
         #'lastapp'               => '',
         #'lastdata'              => '',
+        'src_ip_addr'           => 'Source IP',
+        'dst_ip_addr'           => 'Dest. IP',
         'startdate'             => 'Start date',
         'answerdate'            => 'Answer date',
         'enddate'               => 'End date',
@@ -319,6 +326,10 @@ sub check {
     $self->billsec(  $self->enddate - $self->answerdate );
   } 
 
+  if ( ! $self->enddate && $self->startdate && $self->duration ) {
+    $self->enddate( $self->startdate + $self->duration );
+  }
+
   $self->set_charged_party;
 
   #check the foreign keys even?
@@ -472,6 +483,80 @@ sub set_status_and_rated_price {
   }
 }
 
+=item parse_number [ OPTION => VALUE ... ]
+
+Returns two scalars, the countrycode and the rest of the number.
+
+Options are passed as name-value pairs.  Currently available options are:
+
+=over 4
+
+=item column
+
+The column containing the number to be parsed.  Defaults to dst.
+
+=item international_prefix
+
+The digits for international dialing.  Defaults to '011'  The value '+' is
+always recognized.
+
+=item domestic_prefix
+
+The digits for domestic long distance dialing.  Defaults to '1'
+
+=back
+
+=cut
+
+sub parse_number {
+  my ($self, %options) = @_;
+
+  my $field = $options{column} || 'dst';
+  my $intl = $options{international_prefix} || '011';
+  my $countrycode = '';
+  my $number = $self->$field();
+
+  my $to_or_from = 'concerning';
+  $to_or_from = 'from' if $field eq 'src';
+  $to_or_from = 'to' if $field eq 'dst';
+  warn "parsing call $to_or_from $number\n" if $DEBUG;
+
+  #remove non-phone# stuff and whitespace
+  $number =~ s/\s//g;
+#          my $proto = '';
+#          $dest =~ s/^(\w+):// and $proto = $1; #sip:
+#          my $siphost = '';
+#          $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
+
+  if (    $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
+       || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
+     )
+  {
+
+    my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
+    #first look for 1 digit country code
+    if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
+      $countrycode = $one;
+      $number = $u1.$u2.$rest;
+    } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
+      $countrycode = $two;
+      $number = $u2.$rest;
+    } else { #3 digit country code
+      $countrycode = $three;
+      $number = $rest;
+    }
+
+  } else {
+    my $domestic_prefix =
+      exists($options{domestic_prefix}) ? $options{domestic_prefix} : '';
+    $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
+    $number =~ s/^$countrycode//;# if length($number) > 10;
+  }
+
+  return($countrycode, $number);
+
+}
+
 =item rate [ OPTION => VALUE ... ]
 
 Rates this CDR according and sets the status to 'rated'.
@@ -539,7 +624,7 @@ sub rate_prefix {
                                          );
   if ( $reason ) {
     warn "not charging for CDR ($reason)\n" if $DEBUG;
-    return $self->set_status_and_rated_price( 'rated',
+    return $self->set_status_and_rated_price( 'skipped',
                                               0,
                                               $opt{'svcnum'},
                                             );
@@ -551,51 +636,22 @@ sub rate_prefix {
   # (or calling station id for toll free calls)
   ###
 
-  my( $to_or_from, $number );
+  my( $to_or_from, $column );
   if ( $self->is_tollfree && ! $part_pkg->option_cacheable('disable_tollfree') )
   { #tollfree call
     $to_or_from = 'from';
-    $number = $self->src;
+    $column = 'src';
   } else { #regular call
     $to_or_from = 'to';
-    $number = $self->dst;
+    $column = 'dst';
   }
 
-  warn "parsing call $to_or_from $number\n" if $DEBUG;
-
-  #remove non-phone# stuff and whitespace
-  $number =~ s/\s//g;
-#          my $proto = '';
-#          $dest =~ s/^(\w+):// and $proto = $1; #sip:
-#          my $siphost = '';
-#          $dest =~ s/\@(.*)$// and $siphost = $1; # @10.54.32.1, @sip.example.com
-
   #determine the country code
-  my $intl = $part_pkg->option_cacheable('international_prefix') || '011';
-  my $countrycode = '';
-  if (    $number =~ /^$intl(((\d)(\d))(\d))(\d+)$/
-       || $number =~ /^\+(((\d)(\d))(\d))(\d+)$/
-     )
-  {
-
-    my( $three, $two, $one, $u1, $u2, $rest ) = ( $1,$2,$3,$4,$5,$6 );
-    #first look for 1 digit country code
-    if ( qsearch('rate_prefix', { 'countrycode' => $one } ) ) {
-      $countrycode = $one;
-      $number = $u1.$u2.$rest;
-    } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2
-      $countrycode = $two;
-      $number = $u2.$rest;
-    } else { #3 digit country code
-      $countrycode = $three;
-      $number = $rest;
-    }
-
-  } else {
-    my $domestic_prefix = $part_pkg->option_cacheable('domestic_prefix');
-    $countrycode = length($domestic_prefix) ? $domestic_prefix : '1';
-    $number =~ s/^$countrycode//;# if length($number) > 10;
-  }
+  my ($countrycode, $number) = $self->parse_number(
+    column => $column,
+    international_prefix => $part_pkg->option_cacheable('international_prefix'),
+    domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
+  );
 
   warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
   my $pretty_dst = "+$countrycode $number";
@@ -616,12 +672,20 @@ sub rate_prefix {
     # -disregard private or unknown numbers
     # -there is exactly one record in rate_prefix for a given NPANXX
     # -default to interstate if we can't find one or both of the prefixes
-    my $dstprefix = $self->dst;
+    my (undef, $dstprefix) = $self->parse_number(
+      column => 'dst',
+      international_prefix => $part_pkg->option_cacheable('international_prefix'),
+      domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
+    );
     $dstprefix =~ /^(\d{6})/;
     $dstprefix = qsearchs('rate_prefix', {   'countrycode' => '1', 
                                                 'npa' => $1, 
                                          }) || '';
-    my $srcprefix = $self->src;
+    my (undef, $srcprefix) = $self->parse_number(
+      column => 'src',
+      international_prefix => $part_pkg->option_cacheable('international_prefix'),
+      domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
+    );
     $srcprefix =~ /^(\d{6})/;
     $srcprefix = qsearchs('rate_prefix', {   'countrycode' => '1',
                                              'npa' => $1, 
@@ -692,8 +756,11 @@ sub rate_prefix {
   if ( !exists($interval_cache{$regionnum}) ) {
     my @intervals = (
       sort { $a->stime <=> $b->stime }
-      map { my $r = $_->rate_time; $r ? $r->intervals : () }
-      $rate->rate_detail
+        map { $_->rate_time->intervals }
+          qsearch({ 'table'     => 'rate_detail',
+                    'hashref'   => { 'ratenum' => $rate->ratenum },
+                    'extra_sql' => 'AND ratetimenum IS NOT NULL',
+                 })
     );
     $interval_cache{$regionnum} = \@intervals;
     warn "  cached ".scalar(@intervals)." interval(s)\n"
@@ -711,11 +778,16 @@ sub rate_prefix {
   my $seconds_left = $part_pkg->option_cacheable('use_duration')
                        ? $self->duration
                        : $self->billsec;
-  # charge for the first (conn_sec) seconds
-  my $seconds = min($seconds_left, $rate_detail->conn_sec);
-  $seconds_left -= $seconds; 
-  $weektime     += $seconds;
-  my $charge = $rate_detail->conn_charge; 
+
+  #no, do this later so it respects (group) included minutes
+  #  # charge for the first (conn_sec) seconds
+  #  my $seconds = min($seconds_left, $rate_detail->conn_sec);
+  #  $seconds_left -= $seconds; 
+  #  $weektime     += $seconds;
+  #  my $charge = $rate_detail->conn_charge; 
+  my $seconds = 0;
+  my $charge = 0;
+  my $connection_charged = 0;
 
   my $etime;
   while($seconds_left) {
@@ -778,6 +850,7 @@ sub rate_prefix {
 
     $seconds += $charge_sec;
 
+
     my $region_group = ($part_pkg->option_cacheable('min_included') || 0) > 0;
 
     ${$opt{region_group_included_min}} -= $minutes 
@@ -791,10 +864,21 @@ sub rate_prefix {
             )
        )
     {
+
+      #NOW do connection charges here... right?
+      #my $conn_seconds = min($seconds_left, $rate_detail->conn_sec);
+      my $conn_seconds = 0;
+      unless ( $connection_charged++ ) { #only one connection charge
+        $conn_seconds = min($charge_sec, $rate_detail->conn_sec);
+        $seconds_left -= $conn_seconds; 
+        $weektime     += $conn_seconds;
+        $charge += $rate_detail->conn_charge; 
+      }
+
                            #should preserve (display?) this
-      my $charge_min = 0 - $included_min->{$regionnum}{$ratetimenum};
+      my $charge_min = 0 - $included_min->{$regionnum}{$ratetimenum} - ( $conn_seconds / 60 );
       $included_min->{$regionnum}{$ratetimenum} = 0;
-      $charge += ($rate_detail->min_charge * $charge_min); #still not rounded
+      $charge += ($rate_detail->min_charge * $charge_min) if $charge_min > 0; #still not rounded
 
     } elsif ( ${$opt{region_group_included_min}} > 0
               && $region_group
@@ -1008,6 +1092,10 @@ my %export_names = (
     'invoice_header' => "Date,Time,Called From,Destination,Duration,Price",
                        #"Date,Time,Name,Called From,Destination,Duration,Price",
   },
+  'accountcode_simple' => {
+    'name'           => 'Simple with accountcode',
+    'invoice_header' => "Date,Time,Called From,Account,Duration,Price",
+  },
   'basic' => {
     'name'           => 'Basic',
     'invoice_header' => "Date/Time,Called Number,Min/Sec,Price",
@@ -1105,6 +1193,14 @@ sub export_formats {
       #sub { sprintf('%.3f', shift->upstream_price ) }, #PRICE
       $price_sub,
     ],
+    'accountcode_simple' => [
+      sub { time2str($date_format, shift->calldate_unix ) },   #DATE
+      sub { time2str('%r', shift->calldate_unix ) },   #TIME
+      'src',                                           #called from
+      'accountcode',                                   #NUMBER_DIALED
+      $duration_sub,                                   #DURATION
+      $price_sub,
+    ],
     'sum_duration' => [ 
       # for summary formats, the CDR is a fictitious object containing the 
       # total billsec and the phone number of the service
@@ -1195,8 +1291,6 @@ sub downstream_csv {
   #$opt{'money_char'} ||= $conf->config('money_char') || '$';
   $opt{'money_char'} ||= FS::Conf->new->config('money_char') || '$';
 
-  eval "use Text::CSV_XS;";
-  die $@ if $@;
   my $csv = new Text::CSV_XS;
 
   my @columns =
@@ -1256,6 +1350,7 @@ CDR reprocessing.
 
 sub clear_status {
   my $self = shift;
+  my %opt = @_;
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -1271,6 +1366,7 @@ sub clear_status {
   if ( $cdr_prerate && $cdr_prerate_cdrtypenums{$self->cdrtypenum}
        && $self->rated_ratedetailnum #avoid putting old CDRs back in "rated"
        && $self->freesidestatus eq 'done'
+       && ! $opt{'rerate'}
      )
   { #special case
     $self->freesidestatus('rated');
@@ -1485,6 +1581,11 @@ my %import_options = (
           keys %cdr_info
     },
 
+  'format_asn_formats' =>
+    { map { $_ => $cdr_info{$_}->{'asn_format'}; }
+          keys %cdr_info
+    },
+
   'format_row_callbacks' => { map { $_ => $cdr_info{$_}->{'row_callback'}; }
                                   keys %cdr_info
                             },
@@ -1565,6 +1666,31 @@ sub _upgrade_data {
 
 }
 
+=item ip_addr_sql FIELD RANGE
+
+Returns an SQL condition to search for CDRs with an IP address 
+within RANGE.  FIELD is either 'src_ip_addr' or 'dst_ip_addr'.  RANGE 
+should be in the form "a.b.c.d-e.f.g.h' (dotted quads), where any of 
+the leftmost octets of the second address can be omitted if they're 
+the same as the first address.
+
+=cut
+
+sub ip_addr_sql {
+  my $class = shift;
+  my ($field, $range) = @_;
+  $range =~ /^[\d\.-]+$/ or die "bad ip address range '$range'";
+  my @r = split('-', $range);
+  my @saddr = split('\.', $r[0] || '');
+  my @eaddr = split('\.', $r[1] || '');
+  unshift @eaddr, (undef) x (4 - scalar @eaddr);
+  for(0..3) {
+    $eaddr[$_] = $saddr[$_] if !defined $eaddr[$_];
+  }
+  "$field >= '".sprintf('%03d.%03d.%03d.%03d', @saddr) . "' AND ".
+  "$field <= '".sprintf('%03d.%03d.%03d.%03d', @eaddr) . "'";
+}
+
 =back
 
 =head1 BUGS