From: Mark Wells <mark@freeside.biz>
Date: Wed, 10 Aug 2016 21:53:13 +0000 (-0700)
Subject: look up LRNs for more accurate call rating, #71955
X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=0586dafb71594726138cd3b7b721b9f1a0b79ae2

look up LRNs for more accurate call rating, #71955
---

diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 50fc7f074..d4d9d2b56 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -5595,6 +5595,13 @@ and customer address. Include units.',
       'rate_low'  => 'Lowest rate first',
     ],
   },
+
+  {
+    'key'         => 'cdr-lrn_lookup',
+    'section'     => 'telephony',
+    'description' => 'Look up LRNs of destination numbers for exact matching to the terminating carrier. This feature requires a Freeside support contract.',
+    'type'        => 'checkbox',
+  },
   
   {
     'key'         => 'brand-agent',
diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm
index 8661c4b97..6e5637c07 100644
--- a/FS/FS/Schema.pm
+++ b/FS/FS/Schema.pm
@@ -5547,6 +5547,10 @@ sub tables_hashref {
         'rated_ratename',         'varchar', 'NULL', $char_d, '', '', 
         'rated_cost',            'decimal', 'NULL',  '10,4', '', '',
 
+        # real endpoints of the call
+        'src_lrn',             'varchar', 'NULL',     '15', '', '',
+        'dst_lrn',             'varchar', 'NULL',     '15', '', '',
+
         'carrierid',               'bigint', 'NULL',      '', '', '',
 
         # service it was matched to
diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm
index a2b9a8ccb..d3d62e0b5 100644
--- a/FS/FS/cdr.pm
+++ b/FS/FS/cdr.pm
@@ -3,6 +3,7 @@ package FS::cdr;
 use strict;
 use vars qw( @ISA @EXPORT_OK $DEBUG $me
              $conf $cdr_prerate %cdr_prerate_cdrtypenums
+             $use_lrn $support_key
            );
 use Exporter;
 use List::Util qw(first min);
@@ -24,6 +25,11 @@ use FS::rate;
 use FS::rate_prefix;
 use FS::rate_detail;
 
+# LRN lookup
+use LWP::UserAgent;
+use HTTP::Request::Common qw(POST);
+use Cpanel::JSON::XS qw(decode_json);
+
 @ISA = qw(FS::Record);
 @EXPORT_OK = qw( _cdr_date_parser_maker _cdr_min_parser_maker );
 
@@ -39,6 +45,10 @@ FS::UID->install_callback( sub {
   @cdr_prerate_cdrtypenums = $conf->config('cdr-prerate-cdrtypenums')
     if $cdr_prerate;
   %cdr_prerate_cdrtypenums = map { $_=>1 } @cdr_prerate_cdrtypenums;
+
+  $support_key = $conf->config('support-key');
+  $use_lrn = $conf->exists('cdr-lrn_lookup');
+
 });
 
 =head1 NAME
@@ -215,6 +225,8 @@ sub table_info {
         'upstream_price'        => 'Upstream price',
         #'upstream_rateplanid'   => '',
         #'ratedetailnum'         => '',
+        'src_lrn'               => 'Source LRN',
+        'dst_lrn'               => 'Dest. LRN',
         'rated_price'           => 'Rated price',
         'rated_cost'            => 'Rated cost',
         #'distance'              => '',
@@ -686,9 +698,6 @@ sub rate_prefix {
     }
   }
 
-    
-
-
   ###
   # look up rate details based on called station id
   # (or calling station id for toll free calls)
@@ -722,13 +731,32 @@ sub rate_prefix {
     domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
   );
 
+  my $ratename = '';
+  my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
+
+  if ( $use_lrn and $countrycode eq '1' ) {
+
+    # then ask about the number
+    foreach my $field ('src', 'dst') {
+
+      $self->get_lrn($field);
+      if ( $field eq $column ) {
+        # then we are rating on this number
+        $number = $self->get($field.'_lrn');
+        $number =~ s/^1//;
+        # is this ever meaningful? can the LRN be outside NANP space?
+      }
+
+    } # foreach $field
+
+  }
+
   warn "rating call $to_or_from +$countrycode $number\n" if $DEBUG;
   my $pretty_dst = "+$countrycode $number";
   #asterisks here causes inserting the detail to barf, so:
   $pretty_dst =~ s/\*//g;
 
-  my $ratename = '';
-  my $intrastate_ratenum = $part_pkg->option_cacheable('intrastate_ratenum');
+  # should check $countrycode eq '1' here?
   if ( $intrastate_ratenum && !$self->is_tollfree ) {
     $ratename = 'Interstate'; #until proven otherwise
     # this is relatively easy only because:
@@ -737,8 +765,10 @@ 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 $dst_col = $use_lrn ? 'dst_lrn' : 'dst';
+    my $src_col = $use_lrn ? 'src_lrn' : 'src';
     my (undef, $dstprefix) = $self->parse_number(
-      column => 'dst',
+      column => $dst_col,
       international_prefix => $part_pkg->option_cacheable('international_prefix'),
       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
     );
@@ -747,7 +777,7 @@ sub rate_prefix {
                                                 'npa' => $1, 
                                          }) || '';
     my (undef, $srcprefix) = $self->parse_number(
-      column => 'src',
+      column => $src_col,
       international_prefix => $part_pkg->option_cacheable('international_prefix'),
       domestic_prefix => $part_pkg->option_cacheable('domestic_prefix'),
     );
@@ -1463,6 +1493,38 @@ sub downstream_csv {
 
 }
 
+sub get_lrn {
+  my $self = shift;
+  my $field = shift;
+
+  my $ua = LWP::UserAgent->new;
+  my $url = 'https://ws.freeside.biz/get_lrn';
+
+  my %content = ( 'support-key' => $support_key,
+                  'tn' => $self->get($field),
+                );
+  my $response = $ua->request( POST $url, \%content );
+
+  die "LRN service error: ". $response->message. "\n"
+    unless $response->is_success;
+
+  local $@;
+  my $data = eval { decode_json($response->content) };
+  die "LRN service JSON error : $@\n" if $@;
+
+  if ($data->{error}) {
+    die "acctid ".$self->acctid." $field LRN lookup failed:\n$data->{error}";
+    # for testing; later we should respect ignore_unrateable
+  } elsif ($data->{lrn}) {
+    # normal case
+    $self->set($field.'_lrn', $data->{lrn});
+  } else {
+    die "acctid ".$self->acctid." $field LRN lookup returned no number.\n";
+  }
+
+  return $data; # in case it's interesting somehow
+}
+ 
 =back
 
 =head1 CLASS METHODS