X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcdr.pm;h=fedf28aa643db2a06c1912c8e994280b19bae40b;hb=85ce878a87e2da7ed3e2f927cae7745ef3b59cc0;hp=ff07a59ee11d7af1595adae0c6c7e9cb875a55ba;hpb=fb4ab1073f0d15d660c6cdc4e07afebf68ef3924;p=freeside.git diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index ff07a59ee..fedf28aa6 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -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) -=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, @@ -714,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) { @@ -781,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 @@ -794,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 @@ -1011,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", @@ -1108,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 @@ -1198,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 = @@ -1490,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 }, @@ -1570,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