'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;
'refnum', 'int', '', '', '', '',
'referral_custnum', 'int', 'NULL', '', '', '',
'comments', 'text', 'NULL', '', '', '',
+ 'spool_cdr','char', 'NULL', 1, '', '',
],
'primary_key' => 'custnum',
'unique' => [],
'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)?
],
'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' => [],
},
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);
=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
=item svcnum - Link to customer service (see L<FS::cust_svc>)
-=item freesidestatus - NULL, done, skipped, pushed_downstream (or something)
+=item freesidestatus - NULL, done (or something)
=back
$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<FS::cdr_carrier>), 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<FS::cdr_calltype>), 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<FS::cdr_upstream_rate>), 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',
],
'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',
'distance',
'islocal',
'calltypenum',
- 'startdate', # XXX will definitely need massaging
- 'enddate', # XXX same
+ 'startdate', #XXX needs massaging
+ 'enddate', #XXX same
'description',
'quantity',
'carrierid',
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 $@;
}
}
- @{ $formats{$format} }
+ @{ $import_formats{$format} }
;
my $cdr = new FS::cdr ( \%cdr );
--- /dev/null
+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::rate_detail>). 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<FS::cdr>)
+
+=item ratedetailnum - Rate detail - see L<FS::rate_detail>
+
+=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<hash> 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<FS::rate_detail>).
+
+=cut
+
+sub rate_detail {
+ my $self = shift;
+ qsearchs('rate_detail', { 'ratedetailnum' => $self->ratedetailnum } );
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
=item referral_custnum - referring customer number
+=item spool_cdr - Enable individual CDR spooling, empty or `Y'
+
=back
=head1 METHODS
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');
$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;
my( $total_setup, $total_recur ) = ( 0, 0 );
my %tax;
+ my @precommit_hooks = ();
foreach my $cust_pkg (
qsearch('cust_pkg', { 'custnum' => $self->custnum } )
$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;
# 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
$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
use FS::svc_external;
use FS::domain_record;
use FS::part_export;
+use FS::cdr;
@ISA = qw( FS::Record );
}
+=item get_cdrs_for_update
+
+Returns (and SELECTs "FOR UPDATE") all unprocessed (freesidestatus NULL) CDR
+objects (see L<FS::cdr>) 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.
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',
'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',
# },
},
- '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,
);
#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;
}
|| $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;
$self->SUPER::check;
}
+=item orig_region
+
+Returns the origination region (see L<FS::rate_region>) 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<FS::rate_region>) associated with this
+call plan rate.
+
+=cut
+
+sub dest_region {
+ my $self = shift;
+ qsearchs('rate_region', { 'regionnum' => $self->dest_regionnum } );
+}
+
=back
=head1 BUGS
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;
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 );
$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<FS::radius_usergroup>).
t/inventory_class.t
FS/inventory_item.pm
t/inventory_item.t
+FS/cdr_upstream_rate.pm
+t/cdr_upstream_rate.t
--- /dev/null
+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";
--- /dev/null
+#!/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";
+}
+
);
-
+ #this should use FS::payby
my %allopt = (
'CARD' => 'Credit card',
'CHEK' => 'Electronic check',
<TD WIDTH="408"><INPUT TYPE="text" NAME="invoicing_list" VALUE="<%= join(', ', grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ) %>"></TD>
</TR>
+ <% if ( $conf->exists('voip-cust_cdr_spools') ) { %>
+ <TR>
+ <TD COLSPAN="2"><INPUT TYPE="checkbox" NAME="spool_cdr" VALUE="Y" <%= $cust_main->spool_cdr eq "Y" ? 'CHECKED' : '' %>> Spool CDRs</TD>
+ </TR>
+ <% } else { %>
+ <INPUT TYPE="hidden" NAME="spool_cdr" VALUE="<%= $cust_main->spool_cdr %>">
+ <% } %>
+
</TABLE>
</FORM>
$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!<OPTION VALUE="$value"!.
- ( $plandata{$field} =~ /(^|, *)$value *(,|$)/
- ? ' SELECTED'
- : '' ).
- '>'. $record->getfield($href->{$field}{'select_label'})
+
+ if ( $href->{$field}{'select_table'} ) {
+ foreach my $record (
+ qsearch( $href->{$field}{'select_table'},
+ $href->{$field}{'select_hash'} )
+ ) {
+ my $value = $record->getfield($href->{$field}{'select_key'});
+ $html .= qq!<OPTION VALUE="$value"!.
+ ( $plandata{$field} =~ /(^|, *)$value *(,|$)/
+ ? ' SELECTED'
+ : ''
+ ).
+ '>'. $record->getfield($href->{$field}{'select_label'});
+ }
+ } elsif ( $href->{$field}{'select_options'} ) {
+ foreach my $key ( keys %{ $href->{$field}{'select_options'} } ) {
+ my $value = $href->{$field}{'select_options'}{$key};
+ $html .= qq!<OPTION VALUE="$key"!.
+ ( $plandata{$field} =~ /(^|, *)$value *(,|$)/
+ ? ' SELECTED'
+ : ''
+ ).
+ '>'. $value;
+ }
+
+ } else {
+ $html .= '<font color="#ff0000">warning: '.
+ "don't know how to retreive options for $field select field".
+ '</font>';
}
$html .= '</SELECT>';
}
my $p1 = popurl(1);
my %granularity = (
+ '1', => '1 second',
'6' => '6 second',
+ '30' => '30 second', # '1/2 minute',
'60' => 'minute',
);
qsearch({
'select' => 'DISTINCT ON ( regionnum ) rate_region.*',
'table' => 'rate_region',
- 'addl_from' => 'INNER JOIN rate_prefix USING ( regionnum )',
'hashref' => {},
- 'extra_sql' => "WHERE countrycode != '1'",
+ #'addl_from' => 'INNER JOIN rate_prefix USING ( regionnum )',
+ #'extra_sql' => "WHERE countrycode != '1'",
+
# 'ORDER BY regionname'
# ERROR: SELECT DISTINCT ON expressions must
# match initial ORDER BY expressions
<%
+my $title = 'Call Detail Records';
my $hashref = {};
-#process params for CDR search, populate $hashref...
-
my $count_query = 'SELECT COUNT(*) FROM cdr';
+
+#process params for CDR search, populate $hashref...
# and fixup $count_query
+if ( $cgi->param('freesidestatus') eq 'NULL' ) {
+
+ my $title = "Unprocessed $title";
+ $hashref->{'freesidestatus'} = ''; # Record.pm will take care of it
+ $count_query .= " AND ( freesidestatus IS NULL OR freesidestatus = '' )";
+
+} elsif ( $cgi->param('freesidestatus') =~ /^([\w ]+)$/ ) {
+
+ my $title = "Processed $title";
+ $hashref->{'freesidestatus'} = $1;
+ $count_query .= " AND freesidestatus = '$1'";
+
+}
+
%><%= include( 'elements/search.html',
- 'title' => 'Call Detail Records',
+ 'title' => $title,
'name' => 'call detail records',
'query' => { 'table' => 'cdr',
'hashref' => $hashref
<%= include('/elements/header.html', 'Call Detail Record Search' ) %>
<FORM ACTION="cdr.html" METHOD="GET">
+Status: <SELECT NAME="freesidestatus">
+ <OPTION VALUE="">(all)
+ <OPTION VALUE="NULL">unprocessed
+ <OPTION VALUE="done"">processed
+</SELECT><BR>
<INPUT TYPE="submit" VALUE="Search Call Detail Records">
<%= include('/elements/footer.html') %>
<%= join(', ', grep { $_ !~ /^(POST|FAX)$/ } @invoicing_list ) || 'no' %>
</TD>
</TR>
+<% my $conf = new FS::Conf; if ( $conf->exists('voip-cust_cdr_spools') ) { %>
+ <TR>
+ <TD ALIGN="right">Spool CDRs</TD>
+ <TD BGCOLOR="#ffffff"><%= $cust_main->spool_cdr ? 'yes' : 'no' %></TD>
+ </TR>
+<% } %>
</TABLE></TD></TR></TABLE>
projects / freeside.git / commitdiff