From: ivan Date: Mon, 20 Mar 2006 19:13:27 +0000 (+0000) Subject: add price plan to bill on internal or external CDRs directly, add option to export... X-Git-Tag: BEFORE_FINAL_MASONIZE~191 X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=commitdiff_plain;h=ff24bc786a5fd479f2252260e0da580a736f97be add price plan to bill on internal or external CDRs directly, add option to export CDRs to a per-customer downstream file --- diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index a5add28d8..6be6db5c5 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -1681,6 +1681,20 @@ httemplate/docs/config.html 'type' => 'text', }, + { + 'key' => 'echeck-nonus', + 'section' => 'billing', + 'description' => 'Disable ABA-format account checking for Electronic Check payment info', + 'type' => 'checkbox', + }, + + { + 'key' => 'voip-cust_cdr_spools', + 'section' => '', + 'description' => 'Enable the per-customer option for individual CDR spools.', + 'type' => 'checkbox', + }, + ); 1; diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index a049b8bad..9125758d0 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -437,6 +437,7 @@ sub tables_hashref { 'refnum', 'int', '', '', '', '', 'referral_custnum', 'int', 'NULL', '', '', '', 'comments', 'text', 'NULL', '', '', '', + 'spool_cdr','char', 'NULL', 1, '', '', ], 'primary_key' => 'custnum', 'unique' => [], @@ -1146,7 +1147,8 @@ sub tables_hashref { 'orig_regionnum', 'int', 'NULL', '', '', '', 'dest_regionnum', 'int', '', '', '', '', 'min_included', 'int', '', '', '', '', - 'min_charge', @money_type, '', '', + #'min_charge', @money_type, '', '', + 'min_charge', 'decimal', '', '10,5', '', '', 'sec_granularity', 'int', '', '', '', '', #time period (link to table of periods)? ], @@ -1416,14 +1418,14 @@ sub tables_hashref { 'index' => [], }, - #map upstream rateid (XXX or rateplanid?) to ours... - 'cdr_upstream_rate' => { # XXX or 'cdr_upstream_rateplan' ?? + #map upstream rateid to ours... + 'cdr_upstream_rate' => { 'columns' => [ - # XXX or 'upstream_rateplanid' ?? - 'upstream_rateid', 'int', 'NULL', '', '', '', + 'upstreamratenum', 'serial', '', '', '', '', + 'upstream_rateid', 'varchar', '', $char_d, '', '', 'ratedetailnum', 'int', 'NULL', '', '', '', ], - 'primary_key' => '', #XXX need a primary key + 'primary_key' => 'upstreamratenum', #XXX need a primary key 'unique' => [ [ 'upstream_rateid' ] ], #unless we add another field, yeah 'index' => [], }, diff --git a/FS/FS/cdr.pm b/FS/FS/cdr.pm index 2d40177f5..70c8a0f09 100644 --- a/FS/FS/cdr.pm +++ b/FS/FS/cdr.pm @@ -3,11 +3,13 @@ package FS::cdr; use strict; use vars qw( @ISA ); use Date::Parse; +use Date::Format; use FS::UID qw( dbh ); use FS::Record qw( qsearch qsearchs ); use FS::cdr_type; use FS::cdr_calltype; use FS::cdr_carrier; +use FS::cdr_upstream_rate; @ISA = qw(FS::Record); @@ -99,6 +101,8 @@ following fields are currently supported: =item upstream_rateplanid - Upstream rate plan ID +=item rated_price - Rated (or re-rated) price + =item distance - km (need units field?) =item islocal - Local - 1, Non Local = 0 @@ -121,7 +125,7 @@ following fields are currently supported: =item svcnum - Link to customer service (see L) -=item freesidestatus - NULL, done, skipped, pushed_downstream (or something) +=item freesidestatus - NULL, done (or something) =back @@ -241,7 +245,184 @@ sub check { $self->SUPER::check; } -my %formats = ( +=item set_status_and_rated_price STATUS [ RATED_PRICE ] + +Sets the status to the provided string. If there is an error, returns the +error, otherwise returns false. + +=cut + +sub set_status_and_rated_price { + my($self, $status, $rated_price) = @_; + $self->status($status); + $self->rated_price($rated_price); + $self->replace(); +} + +=item calldate_unix + +Parses the calldate in SQL string format and returns a UNIX timestamp. + +=cut + +sub calldate_unix { + str2time(shift->calldate); +} + +=item cdr_carrier + +Returns the FS::cdr_carrier object associated with this CDR, or false if no +carrierid is defined. + +=cut + +my %carrier_cache = (); + +sub cdr_carrier { + my $self = shift; + return '' unless $self->carrierid; + $carrier_cache{$self->carrierid} ||= + qsearchs('cdr_carrier', { 'carrierid' => $self->carrierid } ); +} + +=item carriername + +Returns the carrier name (see L), or the empty string if +no FS::cdr_carrier object is assocated with this CDR. + +=cut + +sub carriername { + my $self = shift; + my $cdr_carrier = $self->cdr_carrier; + $cdr_carrier ? $cdr_carrier->carriername : ''; +} + +=item cdr_calltype + +Returns the FS::cdr_calltype object associated with this CDR, or false if no +calltypenum is defined. + +=cut + +my %calltype_cache = (); + +sub cdr_calltype { + my $self = shift; + return '' unless $self->calltypenum; + $calltype_cache{$self->calltypenum} ||= + qsearchs('cdr_calltype', { 'calltypenum' => $self->calltypenum } ); +} + +=item calltypename + +Returns the call type name (see L), or the empty string if +no FS::cdr_calltype object is assocated with this CDR. + +=cut + +sub calltypename { + my $self = shift; + my $cdr_calltype = $self->cdr_calltype; + $cdr_calltype ? $cdr_calltype->calltypename : ''; +} + +=item cdr_upstream_rate + +Returns the upstream rate mapping (see L), or the empty +string if no FS::cdr_upstream_rate object is associated with this CDR. + +=cut + +sub cdr_upstream_rate { + my $self = shift; + return '' unless $self->upstream_rateid; + qsearchs('cdr_upstream_rate', { 'upstream_rateid' => $self->upstream_rateid }) + or ''; +} + +=item _convergent_format COLUMN [ COUNTRYCODE ] + +Returns the number in COLUMN formatted as follows: + +If the country code does not match COUNTRYCODE (default "61"), it is returned +unchanged. + +If the country code does match COUNTRYCODE (default "61"), it is removed. In +addiiton, "0" is prepended unless the number starts with 13, 18 or 19. (???) + +=cut + +sub _convergent_format { + my( $self, $field ) = ( shift, shift ); + my $countrycode = scalar(@_) ? shift : '61'; #+61 = australia + #my $number = $self->$field(); + my $number = $self->get($field); + #if ( $number =~ s/^(\+|011)$countrycode// ) { + if ( $number =~ s/^\+$countrycode// ) { + $number = "0$number" + unless $number =~ /^1[389]/; #??? + } + $number; +} + +=item downstream_csv [ OPTION => VALUE, ... ] + +=cut + +my %export_formats = ( + 'convergent' => [ + 'carriername', #CARRIER + sub { shift->_convergent_format('src') }, #SERVICE_NUMBER + sub { shift->_convergent_format('charged_party') }, #CHARGED_NUMBER + sub { time2str('%Y-%m-%d', shift->calldate_unix ) }, #DATE + sub { time2str('%T', shift->calldate_unix ) }, #TIME + 'billsec', #'duration', #DURATION + sub { shift->_convergent_format('dst') }, #NUMBER_DIALED + '', #XXX add (from prefixes in most recent email) #FROM_DESC + '', #XXX add (from prefixes in most recent email) #TO_DESC + 'calltypename', #CLASS_CODE + 'rated_price', #PRICE + sub { shift->rated_price ? 'Y' : 'N' }, #RATED + '', #OTHER_INFO + ], +); + +sub downstream_csv { + my( $self, %opt ) = @_; + + my $format = $opt{'format'}; # 'convergent'; + return "Unknown format $format" unless exists $export_formats{$format}; + + eval "use Text::CSV_XS;"; + die $@ if $@; + my $csv = new Text::CSV_XS; + + my @columns = + map { + ref($_) ? &{$_}($self) : $self->$_(); + } + @{ $export_formats{$format} }; + + my $status = $csv->combine(@columns); + die "FS::CDR: error combining ". $csv->error_input(). "into downstream CSV" + unless $status; + + $csv->string; + +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item batch_import + +=cut + +my %import_formats = ( 'asterisk' => [ 'accountcode', 'src', @@ -264,14 +445,15 @@ my %formats = ( ], 'unitel' => [ 'uniqueid', - 'cdr_type', - 'calldate', # XXX may need massaging - 'billsec', #XXX duration and billsec? - # sub { $_[0]->billsec( $_[1] ); - # $_[0]->duration( $_[1] ); - # }, + #'cdr_type', + 'cdrtypenum', + 'calldate', # may need massaging? huh maybe not... + #'billsec', #XXX duration and billsec? + sub { $_[0]->billsec( $_[1] ); + $_[0]->duration( $_[1] ); + }, 'src', - 'dst', + 'dst', # XXX needs to have "+61" prepended unless /^\+/ ??? 'charged_party', 'upstream_currency', 'upstream_price', @@ -279,8 +461,8 @@ my %formats = ( 'distance', 'islocal', 'calltypenum', - 'startdate', # XXX will definitely need massaging - 'enddate', # XXX same + 'startdate', #XXX needs massaging + 'enddate', #XXX same 'description', 'quantity', 'carrierid', @@ -294,7 +476,7 @@ sub batch_import { my $fh = $param->{filehandle}; my $format = $param->{format}; - return "Unknown format $format" unless exists $formats{$format}; + return "Unknown format $format" unless exists $import_formats{$format}; eval "use Text::CSV_XS;"; die $@ if $@; @@ -339,7 +521,7 @@ sub batch_import { } } - @{ $formats{$format} } + @{ $import_formats{$format} } ; my $cdr = new FS::cdr ( \%cdr ); diff --git a/FS/FS/cdr_upstream_rate.pm b/FS/FS/cdr_upstream_rate.pm new file mode 100644 index 000000000..2fd978203 --- /dev/null +++ b/FS/FS/cdr_upstream_rate.pm @@ -0,0 +1,138 @@ +package FS::cdr_upstream_rate; + +use strict; +use vars qw( @ISA ); +use FS::Record qw( qsearch qsearchs ); +use FS::rate_detail; + +@ISA = qw(FS::Record); + +=head1 NAME + +FS::cdr_upstream_rate - Object methods for cdr_upstream_rate records + +=head1 SYNOPSIS + + use FS::cdr_upstream_rate; + + $record = new FS::cdr_upstream_rate \%hash; + $record = new FS::cdr_upstream_rate { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::cdr_upstream_rate object represents an upstream rate mapping to +internal rate detail (see L). FS::cdr_upstream_rate inherits +from FS::Record. The following fields are currently supported: + +=over 4 + +=item upstreamratenum - primary key + +=item upstream_rateid - CDR upstream Rate ID (cdr.upstream_rateid - see L) + +=item ratedetailnum - Rate detail - see L + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new upstream rate mapping. To add the upstream rate 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 method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'cdr_upstream_rate'; } + +=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 upstream rate. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +# the check method should currently be supplied - FS::Record contains some +# data checking routines + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('upstreamratenum') + #|| $self->ut_number('upstream_rateid') + || $self->ut_alpha('upstream_rateid') + #|| $self->ut_text('upstream_rateid') + || $self->ut_foreign_key('ratedetailnum', 'rate_detail', 'ratedetailnum' ) + ; + return $error if $error; + + $self->SUPER::check; +} + +=item rate_detail + +Returns the internal rate detail object for this upstream rate (see +L). + +=cut + +sub rate_detail { + my $self = shift; + qsearchs('rate_detail', { 'ratedetailnum' => $self->ratedetailnum } ); +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L, schema.html from the base documentation. + +=cut + +1; + diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 50faeb422..99d27dd5e 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -284,6 +284,8 @@ sub paymask { =item referral_custnum - referring customer number +=item spool_cdr - Enable individual CDR spooling, empty or `Y' + =back =head1 METHODS @@ -1257,7 +1259,11 @@ sub check { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + if ( $conf->exists('echeck-nonus') ) { + $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; + } else { + $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + } $payinfo = "$1\@$2"; $self->payinfo($payinfo); $self->paycvv('') if $self->dbdef_table->column('paycvv'); @@ -1336,8 +1342,10 @@ sub check { $self->payname($1); } - $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax; - $self->tax($1); + foreach my $flag (qw( tax spool_cdr )) { + $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); + $self->$flag($1); + } $self->otaker(getotaker) unless $self->otaker; @@ -1640,6 +1648,7 @@ sub bill { my( $total_setup, $total_recur ) = ( 0, 0 ); my %tax; + my @precommit_hooks = (); foreach my $cust_pkg ( qsearch('cust_pkg', { 'custnum' => $self->custnum } ) @@ -1673,7 +1682,7 @@ sub bill { $setup = eval { $cust_pkg->calc_setup( $time ) }; if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return $@; + return "$@ running calc_setup for $cust_pkg\n"; } $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; @@ -1695,10 +1704,13 @@ sub bill { # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) }; + #over two params! lets at least switch to a hashref for the rest... + my %param = ( 'precommit_hooks' => \@precommit_hooks, ); + + $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return $@; + return "$@ running calc_recur for $cust_pkg\n"; } #change this bit to use Date::Manip? CAREFUL with timezones (see @@ -1970,6 +1982,16 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "can't update charged for invoice #$invnum: $error"; } + + foreach my $hook ( @precommit_hooks ) { + eval { + &{$hook}; #($self) ? + }; + if ( $@ ) { + $dbh->rollback if $oldAutoCommit; + return "$@ running precommit hook $hook\n"; + } + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index ad87cab7e..e7afa77ea 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -16,6 +16,7 @@ use FS::svc_broadband; use FS::svc_external; use FS::domain_record; use FS::part_export; +use FS::cdr; @ISA = qw( FS::Record ); @@ -570,6 +571,50 @@ sub get_session_history { } +=item get_cdrs_for_update + +Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR +objects (see L) associated with this service. + +Currently CDRs are associated with svc_acct services via a DID in the +username. This part is rather tenative and still subject to change... + +=cut + +sub get_cdrs_for_update { + my($self, %options) = @_; + + my $default_prefix = $options{'default_prefix'}; + + #Currently CDRs are associated with svc_acct services via a DID in the + #username. This part is rather tenative and still subject to change... + #return () unless $self->svc_x->isa('FS::svc_acct'); + return () unless $self->part_svc->svcdb eq 'svc_acct'; + my $number = $self->svc_x->username; + + my @cdrs = + qsearch( + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'charged_party' => $number + }, + 'extra_sql' => 'FOR UPDATE', + ); + + if ( length($default_prefix) ) { + push @cdrs, + qsearch( + 'table' => 'cdr', + 'hashref' => { 'freesidestatus' => '', + 'charged_party' => "$default_prefix$number", + }, + 'extra_sql' => 'FOR UPDATE', + ); + } + + @cdrs; +} + =item pkg_svc Returns the pkg_svc record for for this service, if applicable. diff --git a/FS/FS/part_pkg/voip_cdr.pm b/FS/FS/part_pkg/voip_cdr.pm index 385fcb2e5..15af77b4f 100644 --- a/FS/FS/part_pkg/voip_cdr.pm +++ b/FS/FS/part_pkg/voip_cdr.pm @@ -4,18 +4,19 @@ use strict; use vars qw(@ISA $DEBUG %info); use Date::Format; use Tie::IxHash; +use FS::Conf; use FS::Record qw(qsearchs qsearch); use FS::part_pkg::flat; #use FS::rate; -use FS::rate_prefix; +#use FS::rate_prefix; @ISA = qw(FS::part_pkg::flat); $DEBUG = 1; -tie my %region_method, 'Tie::IxHash', +tie my %rating_method, 'Tie::IxHash', 'prefix' => 'Rate calls by using destination prefix to look up a region and rate according to the internal prefix and rate tables', - 'upstream_rateid' => 'Rate calls by mapping the upstream rate ID (# rate plan ID?) directly to an internal rate (rate_detail)', #upstream_rateplanid + 'upstream' => 'Rate calls based on upstream data: If the call type is "1", map the upstream rate ID directly to an internal rate (rate_detail), otherwise, pass the upstream price through directly.', ; #tie my %cdr_location, 'Tie::IxHash', @@ -43,11 +44,15 @@ tie my %region_method, 'Tie::IxHash', 'select_key' => 'ratenum', 'select_label' => 'ratename', }, - 'region_method' => { 'name' => 'Region rating method', + 'rating_method' => { 'name' => 'Region rating method', 'type' => 'select', - 'select_options' => \%region_method, + 'select_options' => \%rating_method, }, + 'default_prefix' => { 'name' => 'Default prefix optionally prepended to customer DID numbers when searching for CDR records', + 'default' => '+1', + }, + #XXX also have option for an external db?? # 'cdr_location' => { 'name' => 'CDR database location' # 'type' => 'select', @@ -72,7 +77,7 @@ tie my %region_method, 'Tie::IxHash', # }, }, - 'fieldorder' => [qw( setup_fee recur_flat unused_credit ratenum ignore_unrateable )], + 'fieldorder' => [qw( setup_fee recur_flat unused_credit ratenum rating_method default_prefix )], 'weight' => 40, ); @@ -83,164 +88,248 @@ sub calc_setup { #false laziness w/voip_sqlradacct... resolve it if that one ever gets used again sub calc_recur { - my($self, $cust_pkg, $sdate, $details ) = @_; + my($self, $cust_pkg, $sdate, $details, $param ) = @_; my $last_bill = $cust_pkg->last_bill; my $ratenum = $cust_pkg->part_pkg->option('ratenum'); + my $spool_cdr = $cust_pkg->cust_main->spool_cdr; + my %included_min = (); my $charges = 0; + my $downstream_cdr = ''; + # also look for a specific domain??? (username@telephonedomain) foreach my $cust_svc ( grep { $_->part_svc->svcdb eq 'svc_acct' } $cust_pkg->cust_svc ) { foreach my $cdr ( - $cust_svc->get_cdrs( $last_bill, $$sdate ) + $cust_svc->get_cdrs_for_update() # $last_bill, $$sdate ) ) { if ( $DEBUG > 1 ) { warn "rating CDR $cdr\n". join('', map { " $_ => ". $cdr->{$_}. "\n" } keys %$cdr ); } - my( $regionnum, $rate_detail ); - if ( $self->option('region_method') eq 'prefix' - || ! $self->option('region_method') + my $rate_detail; + my( $rate_region, $regionnum ); + my $pretty_destnum; + my $charge = 0; + my @call_details = (); + if ( $self->option('rating_method') eq 'prefix' + || ! $self->option('rating_method') ) { - ### - # look up rate details based on called station id - ### - - my $dest = $cdr->{'calledstationid'}; # XXX - - #remove non-phone# stuff and whitespace - $dest =~ 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 $countrycode; - if ( $dest =~ /^011(((\d)(\d))(\d))(\d+)$/ - || $dest =~ /^\+(((\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; - $dest = $u1.$u2.$rest; - } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2 - $countrycode = $two; - $dest = $u2.$rest; - } else { #3 digit country code - $countrycode = $three; - $dest = $rest; - } - - } else { - $countrycode = '1'; - $dest =~ s/^1//;# if length($dest) > 10; - } - - warn "rating call to +$countrycode $dest\n" if $DEBUG; - - #find a rate prefix, first look at most specific (4 digits) then 3, etc., - # finally trying the country code only - my $rate_prefix = ''; - for my $len ( reverse(1..6) ) { - $rate_prefix = qsearchs('rate_prefix', { - 'countrycode' => $countrycode, - #'npa' => { op=> 'LIKE', value=> substr($dest, 0, $len) } - 'npa' => substr($dest, 0, $len), - } ) and last; - } - $rate_prefix ||= qsearchs('rate_prefix', { - 'countrycode' => $countrycode, - 'npa' => '', - }); - - die "Can't find rate for call to +$countrycode $dest\n" - unless $rate_prefix; - - $regionnum = $rate_prefix->regionnum; - $rate_detail = qsearchs('rate_detail', { - 'ratenum' => $ratenum, - 'dest_regionnum' => $regionnum, - } ); - - warn " found rate for regionnum $regionnum ". - "and rate detail $rate_detail\n" - if $DEBUG; + die "rating_method 'prefix' not yet supported"; + +# ### +# # look up rate details based on called station id +# ### +# +# my $dest = $cdr->dst; +# +# #remove non-phone# stuff and whitespace +# $dest =~ 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 $countrycode; +# if ( $dest =~ /^011(((\d)(\d))(\d))(\d+)$/ +# || $dest =~ /^\+(((\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; +# $dest = $u1.$u2.$rest; +# } elsif ( qsearch('rate_prefix', { 'countrycode' => $two } ) ) { #or 2 +# $countrycode = $two; +# $dest = $u2.$rest; +# } else { #3 digit country code +# $countrycode = $three; +# $dest = $rest; +# } +# +# } else { +# $countrycode = '1'; +# $dest =~ s/^1//;# if length($dest) > 10; +# } +# +# warn "rating call to +$countrycode $dest\n" if $DEBUG; +# $pretty_destnum = "+$countrycode $dest"; +# +# #find a rate prefix, first look at most specific (4 digits) then 3, etc., +# # finally trying the country code only +# my $rate_prefix = ''; +# for my $len ( reverse(1..6) ) { +# $rate_prefix = qsearchs('rate_prefix', { +# 'countrycode' => $countrycode, +# #'npa' => { op=> 'LIKE', value=> substr($dest, 0, $len) } +# 'npa' => substr($dest, 0, $len), +# } ) and last; +# } +# $rate_prefix ||= qsearchs('rate_prefix', { +# 'countrycode' => $countrycode, +# 'npa' => '', +# }); +# +# die "Can't find rate for call to +$countrycode $dest\n" +# unless $rate_prefix; +# +# $regionnum = $rate_prefix->regionnum; +# $rate_detail = qsearchs('rate_detail', { +# 'ratenum' => $ratenum, +# 'dest_regionnum' => $regionnum, +# } ); +# +# $rate_region = $rate_prefix->rate_region; +# +# warn " found rate for regionnum $regionnum ". +# "and rate detail $rate_detail\n" +# if $DEBUG; - } elsif ( $self->option('region_method') eq 'upstream_rateid' ) { #upstream_rateplanid + } elsif ( $self->option('rating_method') eq 'upstream' ) { - $regionnum = ''; #XXXXX regionnum should be something + if ( $cdr->cdrtypenum == 1 ) { #rate based on upstream rateid - $rate_detail = $cdr->cdr_upstream_rate->rate_detail; + $rate_detail = $cdr->cdr_upstream_rate->rate_detail; - warn " found rate for ". #regionnum $regionnum and ". - "rate detail $rate_detail\n" - if $DEBUG; + $regionnum = $rate_detail->dest_regionnum; + $rate_region = $rate_detail->dest_region; + + $pretty_destnum = $cdr->dst; + + warn " found rate for regionnum $regionnum and ". + "rate detail $rate_detail\n" + if $DEBUG; + + } else { #pass upstream price through + + $charge = sprintf('%.2f', $cdr->upstream_price); + + @call_details = ( + #time2str("%Y %b %d - %r", $cdr->calldate_unix ), + time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot + 'N/A', #minutes... + '$'.$charge, + #$pretty_destnum, + $cdr->description, #$rate_region->regionname, + ); + + } } else { die "don't know how to rate CDRs using method: ". - $self->option('region_method'). "\n"; + $self->option('rating_method'). "\n"; } ### # find the price and add detail to the invoice ### - $included_min{$regionnum} = $rate_detail->min_included - unless exists $included_min{$regionnum}; - - my $granularity = $rate_detail->sec_granularity; - my $seconds = $cdr->{'acctsessiontime'}; # XXX - $seconds += $granularity - ( $seconds % $granularity ); - my $minutes = sprintf("%.1f", $seconds / 60); - $minutes =~ s/\.0$// if $granularity == 60; - - $included_min{$regionnum} -= $minutes; + # if $rate_detail is not found, skip this CDR... i.e. + # don't add it to invoice, don't set its status to NULL, + # don't call downstream_csv or something on it... + # but DO emit a warning... + if ( ! $rate_detail && ! scalar(@call_details) ) { + + warn "no rate_detail found for CDR.acctid: ". $cdr->acctid. + "; skipping\n" + + } else { # there *is* a rate_detail (or call_details), proceed... + + unless ( @call_details ) { + + $included_min{$regionnum} = $rate_detail->min_included + unless exists $included_min{$regionnum}; + + my $granularity = $rate_detail->sec_granularity; + my $seconds = $cdr->billsec; # |ength($cdr->billsec) ? $cdr->billsec : $cdr->duration; + $seconds += $granularity - ( $seconds % $granularity ); + my $minutes = sprintf("%.1f", $seconds / 60); + $minutes =~ s/\.0$// if $granularity == 60; + + $included_min{$regionnum} -= $minutes; + + if ( $included_min{$regionnum} < 0 ) { + my $charge_min = 0 - $included_min{$regionnum}; + $included_min{$regionnum} = 0; + $charge = sprintf('%.2f', $rate_detail->min_charge * $charge_min ); + $charges += $charge; + } + + # this is why we need regionnum/rate_region.... + warn " (rate region $rate_region)\n" if $DEBUG; + + @call_details = ( + #time2str("%Y %b %d - %r", $cdr->calldate_unix ), + time2str("%c", $cdr->calldate_unix), #XXX this should probably be a config option dropdown so they can select US vs- rest of world dates or whatnot + $minutes.'m', + '$'.$charge, + $pretty_destnum, + $rate_region->regionname, + ); - my $charge = 0; - if ( $included_min{$regionnum} < 0 ) { - my $charge_min = 0 - $included_min{$regionnum}; - $included_min{$regionnum} = 0; - $charge = sprintf('%.2f', $rate_detail->min_charge * $charge_min ); - $charges += $charge; + } + + warn " adding details on charge to invoice: ". + join(' - ', @call_details ) + if $DEBUG; + + push @$details, join(' - ', @call_details); #\@call_details, + + # if the customer flag is on, call "downstream_csv" or something + # like it to export the call downstream! + # XXX price plan option to pick format, or something... + $downstream_cdr .= $cdr->downstream_csv( 'format' => 'convergent' ) + if $spool_cdr; + + my $error = $cdr->set_status_and_rated_price('done', $charge); + die $error if $error; + } - - # XXXXXXX -# my $rate_region = $rate_prefix->rate_region; -# warn " (rate region $rate_region)\n" if $DEBUG; -# -# my @call_details = ( -# #time2str("%Y %b %d - %r", $session->{'acctstarttime'}), -# time2str("%c", $cdr->{'acctstarttime'}), #XXX -# $minutes.'m', -# '$'.$charge, -# "+$countrycode $dest", -# $rate_region->regionname, -# ); -# -# warn " adding details on charge to invoice: ". -# join(' - ', @call_details ) -# if $DEBUG; -# -# push @$details, join(' - ', @call_details); #\@call_details, - + } # $cdr } # $cust_svc + if ( $spool_cdr && length($downstream_cdr) ) { + + use FS::UID qw(datasrc); + my $dir = '/usr/local/etc/freeside/export.'. datasrc. '/cdr'; + mkdir $dir, 0700 unless -d $dir; + $dir .= '/'. $cust_pkg->custnum. + mkdir $dir, 0700 unless -d $dir; + my $filename = time2str("$dir/CDR%Y%m%d-spool.CSV", time); #XXX invoice date instead? would require changing the order things are generated in cust_main::bill insert cust_bill first - with transactions it could be done though + + push @{ $param->{'precommit_hooks'} }, + sub { + #lock the downstream spool file and append the records + use Fcntl qw(:flock); + use IO::File; + my $spool = new IO::File ">>$filename" + or die "can't open $filename: $!\n"; + flock( $spool, LOCK_EX) + or die "can't lock $filename: $!\n"; + seek($spool, 0, 2) + or die "can't seek to end of $filename: $!\n"; + print $spool $downstream_cdr; + flock( $spool, LOCK_UN ); + close $spool; + }; + + } #if ( $spool_cdr && length($downstream_cdr) ) + $self->option('recur_flat') + $charges; } diff --git a/FS/FS/rate_detail.pm b/FS/FS/rate_detail.pm index 1964be2f4..6f023f575 100644 --- a/FS/FS/rate_detail.pm +++ b/FS/FS/rate_detail.pm @@ -114,7 +114,11 @@ sub check { || $self->ut_foreign_keyn('orig_regionnum', 'rate_region', 'regionnum' ) || $self->ut_foreign_key('dest_regionnum', 'rate_region', 'regionnum' ) || $self->ut_number('min_included') - || $self->ut_money('min_charge') + + #|| $self->ut_money('min_charge') + #good enough for now... + || $self->ut_float('min_charge') + || $self->ut_number('sec_granularity') ; return $error if $error; @@ -122,6 +126,30 @@ sub check { $self->SUPER::check; } +=item orig_region + +Returns the origination region (see L) associated with this +call plan rate. + +=cut + +sub orig_region { + my $self = shift; + qsearchs('rate_region', { 'regionnum' => $self->orig_regionnum } ); +} + +=item dest_region + +Returns the destination region (see L) associated with this +call plan rate. + +=cut + +sub dest_region { + my $self = shift; + qsearchs('rate_region', { 'regionnum' => $self->dest_regionnum } ); +} + =back =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 759d7372e..a2b7a11c7 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -20,6 +20,7 @@ use Crypt::PasswdMD5 1.2; use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); +use FS::Msgcat qw(gettext); use FS::svc_Common; use FS::cust_svc; use FS::part_svc; @@ -31,9 +32,9 @@ use FS::queue; use FS::radius_usergroup; use FS::export_svc; use FS::part_export; -use FS::Msgcat qw(gettext); use FS::svc_forward; use FS::svc_www; +use FS::cdr; @ISA = qw( FS::svc_Common ); @@ -1344,6 +1345,67 @@ sub get_session_history { $self->cust_svc->get_session_history(@_); } +=item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ] + +=cut + +sub get_cdrs { + my($self, $start, $end, %opt ) = @_; + + my $did = $self->username; #yup + + my $prefix = $opt{'default_prefix'}; #convergent.au '+61' + + my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : ''; + + #SELECT $for_update * FROM cdr + # WHERE calldate >= $start #need a conversion + # AND calldate < $end #ditto + # AND ( charged_party = "$did" + # OR charged_party = "$prefix$did" #if length($prefix); + # OR ( ( charged_party IS NULL OR charged_party = '' ) + # AND + # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix) + # ) + # ) + # AND ( freesidestatus IS NULL OR freesidestatus = '' ) + + my $charged_or_src; + if ( length($prefix) ) { + $charged_or_src = + " AND ( charged_party = '$did' + OR charged_party = '$prefix$did' + OR ( ( charged_party IS NULL OR charged_party = '' ) + AND + ( src = '$did' OR src = '$prefix$did' ) + ) + ) + "; + } else { + $charged_or_src = + " AND ( charged_party = '$did' + OR ( ( charged_party IS NULL OR charged_party = '' ) + AND + src = '$did' + ) + ) + "; + + } + + qsearch( + 'select' => "$for_update *", + 'table' => 'cdr', + 'hashref' => { + #( freesidestatus IS NULL OR freesidestatus = '' ) + 'freesidestatus' => '', + }, + 'extra_sql' => $charged_or_src, + + ); + +} + =item radius_groups Returns all RADIUS groups for this account (see L). diff --git a/FS/MANIFEST b/FS/MANIFEST index 6360d5303..a70be40e4 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -322,3 +322,5 @@ FS/inventory_class.pm t/inventory_class.t FS/inventory_item.pm t/inventory_item.t +FS/cdr_upstream_rate.pm +t/cdr_upstream_rate.t diff --git a/FS/t/cdr_upstream_rate.t b/FS/t/cdr_upstream_rate.t new file mode 100644 index 000000000..f9458c527 --- /dev/null +++ b/FS/t/cdr_upstream_rate.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::cdr_upstream_rate; +$loaded=1; +print "ok 1\n"; diff --git a/bin/cdr_upstream_rate.import b/bin/cdr_upstream_rate.import new file mode 100755 index 000000000..fda3883b5 --- /dev/null +++ b/bin/cdr_upstream_rate.import @@ -0,0 +1,142 @@ +#!/usr/bin/perl -w +# +# Usage: bin/cdr_upstream_rate.import username ratenum filename +# +# records will be imported into cdr_upstream_rate, rate_detail and rate_region +# +# Example: bin/cdr_upstream_rate.import ivan 1 ~ivan/convergent/sample_rate_table.csv +# +# username: a freeside login (from /usr/local/etc/freeside/mapsecrets) +# ratenum: rate plan (FS::rate) created with the web UI +# filename: CSV file +# +# the following fields are currently used: +# - Class Code => cdr_upstream_rate.rateid +# - Description => rate_region.regionname +# (rate_detail->dest_region) +# - 1_rate => ( * 60 / 1_rate_seconds ) => rate_detail.min_charge +# - 1_rate_seconds => (used above) +# - 1_second_increment => rate_detail.sec_granularity +# +# the following fields are not (yet) used: +# - Flagfall => what's this for? +# +# - 1_cap_time => freeside doesn't have voip time caps yet... +# - 1_cap_cost => freeside doesn't have voip cost caps yet... +# - 1_repeat => not sure what this is for, sample data is all 0 +# +# - 2_rate => \ +# - 2_rate_seconds => | +# - 2_second_increment => | not sure what the second set of rate data +# - 2_cap_time => | is supposed to be for... +# - 2_cap_cost => | +# - 2_repeat => / +# +# - Carrier => probably not needed? +# - Start Date => not necessary? + +use strict; +use vars qw( $DEBUG ); +use Text::CSV_XS; +use FS::UID qw(dbh adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::rate; +use FS::cdr_upstream_rate; +use FS::rate_detail; +use FS::rate_region; + +$DEBUG = 1; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $ratenum = shift or die &usage; + +my $rate = qsearchs( 'rate', { 'ratenum' => $ratenum } ); +die "rate plan $ratenum not found in rate table\n" + unless $rate; + +my $csv = new Text::CSV_XS; +my $hline = scalar(<>); +chomp($hline); +$csv->parse($hline) or die "can't parse header: $hline\n"; +my @header = $csv->fields(); + +$FS::UID::AutoCommit = 0; + +while (<>) { + + chomp; + my $line = $_; + +# #$line =~ /^(\d+),"([^"]+)"$/ or do { +# #} +# $line =~ /^(\d+),"([^"]+)"/ or do { +# warn "unparsable line: $line\n"; +# next; +# }; + + $csv->parse($line) or die "can't parse line: $line\n"; + my @line = $csv->fields(); + + my %hash = map { $_ => shift(@line) } @header; + + warn join('', map { "$_ => $hash{$_}\n" } keys %hash ) + if $DEBUG > 1; + + my $rate_region = new FS::rate_region { + 'regionname' => $hash{'Description'} + }; + + my $error = $rate_region->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into rate_region: $error\n"; + } + my $dest_regionnum = $rate_region->regionnum; + warn "rate_region $dest_regionnum inserted\n" + if $DEBUG; + + my $rate_detail = new FS::rate_detail { + 'ratenum' => $ratenum, + 'dest_regionnum' => $dest_regionnum, + 'min_included' => 0, + #'min_charge', => sprintf('%.5f', 60 * $hash{'1_rate'} / $hash{'1_rate_seconds'} ), + 'min_charge', => sprintf('%.5f', $hash{'1_rate'} / + ( $hash{'1_rate_seconds'} / 60 ) + ), + 'sec_granularity' => $hash{'1_second_increment'}, + }; + $error = $rate_detail->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into rate_detail: $error\n"; + } + my $ratedetailnum = $rate_detail->ratedetailnum; + warn "rate_detail $ratedetailnum inserted\n" + if $DEBUG; + + my $cdr_upstream_rate = new FS::cdr_upstream_rate { + 'upstream_rateid' => $hash{'Class Code'}, + 'ratedetailnum' => $rate_detail->ratedetailnum, + }; + $error = $cdr_upstream_rate->insert; + if ( $error ) { + dbh->rollback; + die "error inserting into cdr_upstream_rate: $error\n"; + } + warn "cdr_upstream_rate ". $cdr_upstream_rate->upstreamratenum. " inserted\n" + if $DEBUG; + + dbh->commit or die "can't commit: ". dbh->errstr; + + warn "\n" if $DEBUG; + +} + +dbh->commit or die "can't commit: ". dbh->errstr; + +sub usage { + "Usage:\n\ncdr_upstream_rate.import username ratenum filename\n"; +} + diff --git a/httemplate/edit/cust_main/billing.html b/httemplate/edit/cust_main/billing.html index 96f777baa..790f41f00 100644 --- a/httemplate/edit/cust_main/billing.html +++ b/httemplate/edit/cust_main/billing.html @@ -348,7 +348,7 @@ if ( $payby_default eq 'HIDE' ) { ); - + #this should use FS::payby my %allopt = ( 'CARD' => 'Credit card', 'CHEK' => 'Electronic check', @@ -433,6 +433,14 @@ if ( $payby_default eq 'HIDE' ) { + <% if ( $conf->exists('voip-cust_cdr_spools') ) { %> + + spool_cdr eq "Y" ? 'CHECKED' : '' %>> Spool CDRs + + <% } else { %> + + <% } %> + diff --git a/httemplate/edit/part_pkg.cgi b/httemplate/edit/part_pkg.cgi index 61e4086be..158c6e2ff 100755 --- a/httemplate/edit/part_pkg.cgi +++ b/httemplate/edit/part_pkg.cgi @@ -297,16 +297,35 @@ my $widget = new HTML::Widgets::SelectLayers( $html .= ' MULTIPLE' if $href->{$field}{'type'} eq 'select_multiple'; $html .= qq! NAME="$field" onChange="fchanged(this)">!; - foreach my $record ( - qsearch( $href->{$field}{'select_table'}, - $href->{$field}{'select_hash'} ) - ) { - my $value = $record->getfield($href->{$field}{'select_key'}); - $html .= qq!