summaryrefslogtreecommitdiff
path: root/FS/FS/cdr.pm
diff options
context:
space:
mode:
authorMark Wells <mark@freeside.biz>2016-08-10 14:53:13 -0700
committerMark Wells <mark@freeside.biz>2016-08-10 15:44:14 -0700
commita7e54f3bf896037443c3da5d8f699acab0177a6c (patch)
tree7c1ea80b04212654958235733a7fc57f1f5d564e /FS/FS/cdr.pm
parent985fd23fa0963c685b7309447e6f5ea35c831320 (diff)
look up LRNs for more accurate call rating, #71955
Diffstat (limited to 'FS/FS/cdr.pm')
-rw-r--r--FS/FS/cdr.pm76
1 files changed, 69 insertions, 7 deletions
diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm
index a2b9a8c..d3d62e0 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