TT#24111 rework splitpeakparts feature

+ fix/revive testsuite in stretch
+ rateomat-45-split-cdr.t rewritten, PASS

Change-Id: I5e1c3f8da0a374d7d1a055ae4651f0db004d37d3
changes/03/16503/21
Rene Krenn 8 years ago
parent de705505ac
commit a2795f0e8a

@ -12,6 +12,7 @@ use NetAddr::IP;
use Data::Dumper;
use Time::HiRes qw(); #for debugging info only
use List::Util qw(shuffle);
use Storable qw(dclone);
# constants: ###########################################################
@ -56,10 +57,10 @@ my $update_prepaid_preference = 1;
# control writing cdr relation data:
# disable it for now until this will be limited to prepaid contracts,
# as it produces massive amounts of zeroed or unneeded data.
my $write_cash_balance_before_after = 0;
my $write_free_time_balance_before_after = 0;
my $write_profile_package_id = 0;
my $write_contract_balance_id = 0;
my $write_cash_balance_before_after = $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} // 0;
my $write_free_time_balance_before_after = $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} // 0;
my $write_profile_package_id = $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} // 0;
my $write_contract_balance_id = $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} // 0;
# terminate if the same cdr fails $failed_cdr_max_retries + 1 times:
my $failed_cdr_max_retries = ((defined $ENV{RATEOMAT_MAX_RETRIES} && $ENV{RATEOMAT_MAX_RETRIES} >= 0) ? int $ENV{RATEOMAT_MAX_RETRIES} : 2);
@ -98,6 +99,7 @@ my $DupDB_User = $ENV{RATEOMAT_DUPLICATE_DB_USER};
my $DupDB_Pass = $ENV{RATEOMAT_DUPLICATE_DB_PASS};
my @cdr_fields = qw(source_user_id source_provider_id source_external_subscriber_id source_external_contract_id source_account_id source_user source_domain source_cli source_clir source_ip source_lnp_prefix source_user_out destination_user_id destination_provider_id destination_external_subscriber_id destination_external_contract_id destination_account_id destination_user destination_domain destination_user_dialed destination_user_in destination_domain_in destination_lnp_prefix destination_user_out peer_auth_user peer_auth_realm call_type call_status call_code init_time start_time duration call_id source_carrier_cost source_reseller_cost source_customer_cost source_carrier_free_time source_reseller_free_time source_customer_free_time source_carrier_billing_fee_id source_reseller_billing_fee_id source_customer_billing_fee_id source_carrier_billing_zone_id source_reseller_billing_zone_id source_customer_billing_zone_id destination_carrier_cost destination_reseller_cost destination_customer_cost destination_carrier_free_time destination_reseller_free_time destination_customer_free_time destination_carrier_billing_fee_id destination_reseller_billing_fee_id destination_customer_billing_fee_id destination_carrier_billing_zone_id destination_reseller_billing_zone_id destination_customer_billing_zone_id frag_carrier_onpeak frag_reseller_onpeak frag_customer_onpeak is_fragmented split rated_at rating_status exported_at export_status source_lnp_type destination_lnp_type);
foreach my $gpp_idx(0 .. 9) {
push @cdr_fields, ("source_gpp$gpp_idx", "destination_gpp$gpp_idx");
}
@ -1381,7 +1383,7 @@ PREPARE_BALANCE_CATCHUP:
};
if (!$underrun_lock_applied && defined $underrun_lock_threshold && $last_cash_balance >= $underrun_lock_threshold && 0.0 < $underrun_lock_threshold) {
$underrun_lock_applied = 1;
DEBUG "cash balance was decreased from $last_cash_balance to $cash_balance and dropped below underrun lock threshold $underrun_lock_threshold";
DEBUG "cash balance was decreased from $last_cash_balance to 0 and dropped below underrun lock threshold $underrun_lock_threshold";
if (defined $underrun_lock_level) {
set_subscriber_lock_level($contract_id,$underrun_lock_level,0);
set_subscriber_status($contract_id,$underrun_lock_level,0);
@ -1391,7 +1393,7 @@ PREPARE_BALANCE_CATCHUP:
if (!$underrun_profiles_applied && defined $underrun_profile_threshold && $last_cash_balance >= $underrun_profile_threshold && 0.0 < $underrun_profile_threshold) {
$underrun_profiles_applied = 1;
DEBUG "cash balance was decreased from $last_cash_balance to $cash_balance and dropped below underrun profile threshold $underrun_profile_threshold";
DEBUG "cash balance was decreased from $last_cash_balance to 0 and dropped below underrun profile threshold $underrun_profile_threshold";
if (add_profile_mappings($contract_id,$call_start_time,$package_id,'underrun',0) > 0) {
$underrun_profiles_time = $now;
$bal->{underrun_profile_time} = $now;
@ -1941,16 +1943,21 @@ sub get_call_cost {
$r_profile_info->{on_init_rate} : $r_profile_info->{off_init_rate};
DEBUG "add init rate $rate per sec to costs";
} else {
last if $split_peak_parts and defined($$r_onpeak) and $$r_onpeak != $onpeak
and not defined $cdr->{rating_duration};
$interval = $onpeak == 1 ?
$r_profile_info->{on_follow_interval} : $r_profile_info->{off_follow_interval};
$rate = $onpeak == 1 ?
$r_profile_info->{on_follow_rate} : $r_profile_info->{off_follow_rate};
DEBUG "add follow rate $rate per sec to costs";
}
$$r_onpeak = $onpeak;
$$r_onpeak = $onpeak unless defined $$r_onpeak;
if ($split_peak_parts #break the cdr, if
and not defined $cdr->{rating_duration} #is the first attempt to calculate,
and defined($$r_onpeak) #it started with onpeak or offpeak in the first interval,
and $$r_onpeak != $onpeak) { #and switched onpeak/offpeak in the next interval
DEBUG (($$r_onpeak ? 'onpeak' : 'offpeak').' -> '.($onpeak ? 'onpeak' : 'offpeak').' transition, rating_duration = ' . $$r_rating_duration);
#$split = 1;
last;
}
$rate *= $interval;
DEBUG "interval is $interval, so rate for this interval is $rate";
@ -1958,7 +1965,7 @@ sub get_call_cost {
my $current_call_time = int($cdr->{start_time} + $offset);
my @bals = grep {
$_->{start_unix} <= $current_call_time &&
($current_call_time <= $_->{end_unix} || is_infinite_unix($_->{end_unix}))
(is_infinite_unix($_->{end_unix}) || $current_call_time <= $_->{end_unix})
} @$r_balances;
@bals or FATAL "No contract balance for CDR $cdr->{id} found";
WARNING "overlapping contract balances for CDR $cdr->{id} found: ".(Dumper \@bals) if (scalar @bals) > 1;
@ -2030,6 +2037,15 @@ sub get_call_cost {
$offset += $interval;
}
if (defined $cdr->{rating_duration} # we are in the second attempt,
and $cdr->{rating_duration} >= $cdr->{duration} # must be last, final fragment,
and $cdr->{rating_duration} > $$r_rating_duration) { # set $$r_rating_duration to the max rating duration, if its not
DEBUG "set rating_duration from $$r_rating_duration to rating_duration = $cdr->{rating_duration}";
$$r_rating_duration = $cdr->{rating_duration}; # will result in identical rating durations, and the fragment will pass.
} else {
DEBUG ("rating_duration = $$r_rating_duration");
}
if ((scalar @cash_balance_rates) > 0) {
my @remaining_bals = @{ sort_contract_balances([ values %bal_map ]) };
foreach my $bal (@remaining_bals) {
@ -2294,6 +2310,7 @@ sub get_customer_call_cost {
my $cdr = shift;
my $type = shift;
my $direction = shift;
my $readonly = shift;
my $r_cost = shift;
my $r_free_time = shift;
my $r_rating_duration = shift;
@ -2341,7 +2358,7 @@ sub get_customer_call_cost {
my %profile_info = ();
get_call_cost($cdr, $type, $direction,$contract_id,
$billing_info{profile_id}, $outgoing_prepaid && defined $prepaid_cost_entry,
$billing_info{profile_id}, $readonly || ($outgoing_prepaid && defined $prepaid_cost_entry),
\%profile_info, \%package_info, $r_cost, \$real_cost, $r_free_time,
$r_rating_duration, \$onpeak, \@balances)
or FATAL "Error getting ".$dir."customer call cost\n";
@ -2365,7 +2382,7 @@ sub get_customer_call_cost {
if (defined $prepaid_cost_entry) {
$$r_cost = $prepaid_cost_entry->{cost};
$$r_free_time = $prepaid_cost_entry->{free_time_used};
drop_prepaid_cost($prepaid_cost_entry);
drop_prepaid_cost($prepaid_cost_entry) unless $readonly;
# it would be more safe to add *_balance_before/after columns to the prepaid_costs table,
# instead of reconstructing the balance values:
@ -2376,8 +2393,10 @@ sub get_customer_call_cost {
# maybe another rateomat was faster and already processed+deleted it?
# in that case we should bail out here.
WARNING "no prepaid cost record found for call ID $cdr->{call_id}, applying calculated costs";
update_contract_balance(\@balances)
or FATAL "Error updating ".$dir."customer contract balance\n";
unless ($readonly) {
update_contract_balance(\@balances)
or FATAL "Error updating ".$dir."customer contract balance\n";
}
$$r_cost = $real_cost;
$cdr->{$dir."customer_cash_balance_after"} = $snapshot_bal->{cash_balance};
$cdr->{$dir."customer_free_time_balance_after"} = $snapshot_bal->{free_time_balance};
@ -2390,8 +2409,10 @@ sub get_customer_call_cost {
} else { #postpaid in, postpaid out
DEBUG "billing profile is post-paid, update contract balance";
}
update_contract_balance(\@balances)
or FATAL "Error updating ".$dir."customer contract balance\n";
unless ($readonly) {
update_contract_balance(\@balances)
or FATAL "Error updating ".$dir."customer contract balance\n";
}
$cdr->{$dir."customer_cash_balance_after"} = $snapshot_bal->{cash_balance};
$cdr->{$dir."customer_free_time_balance_after"} = $snapshot_bal->{free_time_balance};
}
@ -2407,6 +2428,7 @@ sub get_provider_call_cost {
my $cdr = shift;
my $type = shift;
my $direction = shift;
my $readonly = shift;
my $provider_info = shift;
my $r_cost = shift;
my $r_free_time = shift;
@ -2440,7 +2462,7 @@ sub get_provider_call_cost {
my %profile_info = ();
get_call_cost($cdr, $type, $direction,$contract_id,
$provider_info->{billing}->{profile_id}, $prepaid, # no underruns for providers with prepaid profile
$provider_info->{billing}->{profile_id}, $readonly || $prepaid, # no underruns for providers with prepaid profile
\%profile_info, $provider_info->{package}, $r_cost, \$real_cost, $r_free_time,
$r_rating_duration, \$onpeak, $provider_info->{balances})
or FATAL "Error getting ".$dir."provider call cost\n";
@ -2460,8 +2482,10 @@ sub get_provider_call_cost {
$cdr->{$dir.$provider_type."cash_balance_after"} = $snapshot_bal->{cash_balance_old};
$cdr->{$dir.$provider_type."free_time_balance_after"} = $snapshot_bal->{free_time_balance_old};
update_contract_balance($provider_info->{balances})
or FATAL "Error updating ".$dir.$provider_type."provider contract balance\n";
unless ($readonly) {
update_contract_balance($provider_info->{balances})
or FATAL "Error updating ".$dir.$provider_type."provider contract balance\n";
}
$cdr->{$dir.$provider_type."cash_balance_after"} = $snapshot_bal->{cash_balance};
$cdr->{$dir.$provider_type."free_time_balance_after"} = $snapshot_bal->{free_time_balance};
@ -2496,9 +2520,6 @@ sub rate_cdr {
my $destination_carrier_free_time = 0;
my $destination_reseller_free_time = 0;
my $direction;
my @rating_durations;
unless($cdr->{call_status} eq "ok") {
DEBUG "cdr #$$cdr{id} has call_status $$cdr{call_status}, skip.";
$cdr->{source_carrier_cost} = $source_carrier_cost;
@ -2560,6 +2581,33 @@ sub rate_cdr {
};
DEBUG sub { "destination_provider_info is ".(Dumper $destination_provider_info) };
my @rating_durations;
my $rating_attempts = 0;
my $readonly;
$cdr->{rating_duration} = undef;
RATING_DURATION_FOUND:
$rating_attempts += 1;
@rating_durations = ();
$source_customer_cost = 0;
$source_carrier_cost = 0;
$source_reseller_cost = 0;
$source_customer_free_time = 0;
$source_carrier_free_time = 0;
$source_reseller_free_time = 0;
$destination_customer_cost = 0;
$destination_carrier_cost = 0;
$destination_reseller_cost = 0;
$destination_customer_free_time = 0;
$destination_carrier_free_time = 0;
$destination_reseller_free_time = 0;
$source_provider_info->{balances} = dclone(\@source_provider_balances);
$destination_provider_info->{balances} = dclone(\@destination_provider_balances);
$readonly = ($split_peak_parts ? ($rating_attempts == 1) : 0);
if ($readonly) {
DEBUG "### $rating_attempts. readonly pass ###";
} else {
DEBUG "### $rating_attempts. write pass ###";
}
#unless($destination_provider_billing_info{profile_info}) {
# FATAL "Missing billing profile for destination_provider_id ".$cdr->{destination_provider_id}." for cdr #".$cdr->{id}."\n";
#}
@ -2583,7 +2631,7 @@ sub rate_cdr {
# we find a fee with direction "in"
if($destination_provider_billing_info{profile_id}) {
DEBUG "destination provider has billing profile $destination_provider_billing_info{profile_id}, get reseller termination cost";
get_provider_call_cost($cdr, $type, "in",
get_provider_call_cost($cdr, $type, "in", $readonly,
$destination_provider_info, \$destination_reseller_cost, \$destination_reseller_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting destination reseller cost for local destination_provider_id ".
@ -2595,7 +2643,7 @@ sub rate_cdr {
DEBUG "destination provider $$cdr{destination_provider_id} has no billing profile, skip reseller termination cost";
}
DEBUG "get customer termination cost for destination_user_id $$cdr{destination_user_id}";
get_customer_call_cost($cdr, $type, "in",
get_customer_call_cost($cdr, $type, "in", $readonly,
\$destination_customer_cost, \$destination_customer_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting destination customer cost for local destination_user_id ".
@ -2609,7 +2657,7 @@ sub rate_cdr {
# (this is what the peering provider is charging the carrier)
if($destination_provider_billing_info{profile_id}) {
DEBUG sub { "fetching source_carrier_cost based on destination_provider_billing_info ".(Dumper \%destination_provider_billing_info) };
get_provider_call_cost($cdr, $type, "out",
get_provider_call_cost($cdr, $type, "out", $readonly,
$destination_provider_info, \$source_carrier_cost, \$source_carrier_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting source carrier cost for cdr ".$cdr->{id}."\n";
@ -2620,7 +2668,7 @@ sub rate_cdr {
# get reseller cost
if($source_provider_billing_info{profile_id}) {
get_provider_call_cost($cdr, $type, "out",
get_provider_call_cost($cdr, $type, "out", $readonly,
$source_provider_info, \$source_reseller_cost, \$source_reseller_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting source reseller cost for cdr ".$cdr->{id}."\n";
@ -2630,11 +2678,12 @@ sub rate_cdr {
}
# get customer cost
get_customer_call_cost($cdr, $type, "out",
get_customer_call_cost($cdr, $type, "out", $readonly,
\$source_customer_cost, \$source_customer_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting source customer cost for local source_user_id ".
$cdr->{source_user_id}." for cdr ".$cdr->{id}."\n";
} else {
# call from a foreign caller
@ -2649,7 +2698,7 @@ sub rate_cdr {
# as this is what the peer is charging us
if($source_provider_billing_info{profile_id}) {
DEBUG sub { "fetching destination_carrier_cost based on source_provider_billing_info ".(Dumper \%source_provider_billing_info) };
get_provider_call_cost($cdr, $type, "in",
get_provider_call_cost($cdr, $type, "in", $readonly,
$source_provider_info, \$destination_carrier_cost, \$destination_carrier_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting destination carrier cost for local destination_provider_id ".
@ -2659,7 +2708,7 @@ sub rate_cdr {
}
if($destination_provider_billing_info{profile_id}) {
DEBUG sub { "fetching destination_reseller_cost based on source_provider_billing_info ".(Dumper \%destination_provider_billing_info) };
get_provider_call_cost($cdr, $type, "in",
get_provider_call_cost($cdr, $type, "in", $readonly,
$destination_provider_info, \$destination_reseller_cost, \$destination_reseller_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting destination reseller cost for local destination_provider_id ".
@ -2669,11 +2718,12 @@ sub rate_cdr {
# in theory, all resellers MUST have a billing profile, so we could bail out here
WARNING "missing destination profile, so we can't calculate destination_reseller_cost for destination_provider_billing_info ".(Dumper \%destination_provider_billing_info);
}
get_customer_call_cost($cdr, $type, "in",
\$destination_customer_cost, \$destination_customer_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting destination customer cost for local destination_user_id ".
$cdr->{destination_user_id}." for cdr ".$cdr->{id}."\n";
get_customer_call_cost($cdr, $type, "in", $readonly,
\$destination_customer_cost, \$destination_customer_free_time,
\$rating_durations[@rating_durations])
or FATAL "Error getting destination customer cost for local destination_user_id ".
$cdr->{destination_user_id}." for cdr ".$cdr->{id}."\n";
} else {
# TODO what about transit calls?
}
@ -2687,19 +2737,31 @@ sub rate_cdr {
my %rating_durations;
for my $rd (@rating_durations) {
defined($rd) and $rating_durations{$rd} = 1;
if (defined($rd)) {
$rating_durations{$rd} = 1;
$cdr->{rating_duration} //= 0;
$cdr->{rating_duration} = $rd if $rd > $cdr->{rating_duration};
}
}
if (scalar(keys(%rating_durations)) > 1) {
DEBUG 'Inconsistend rating fragment durations '.join(', ',keys(%rating_durations))." for cdr ID $cdr->{id}";
if ($rating_attempts > 1) {
FATAL "Error getting consistent rating fragment for cdr ".$cdr->{id}.". Rating profiles don't match.";
} else {
DEBUG 'trying again';
goto RATING_DURATION_FOUND;
}
} elsif ($rating_attempts == 1) { # coherent rating durations on first attempt
goto RATING_DURATION_FOUND; # just do it again to write stuff
}
scalar(keys(%rating_durations)) > 1
and FATAL "Error getting consistent rating fragment for cdr ".$cdr->{id}.". Rating profiles don't match.";
my $rating_duration = (keys(%rating_durations))[0] // $cdr->{duration};
if ($rating_duration < $cdr->{duration}) {
my $sth = $sth_create_cdr_fragment;
my $sth = $sth_create_cdr_fragment; # start_time is advanced, duration decreased
$sth->execute($rating_duration, $rating_duration, $cdr->{id})
or FATAL "Error executing create cdr fragment statement: ".$sth->errstr;
if ($sth->rows > 0) {
DEBUG "cdr ID $cdr->{id} covers $rating_duration secs before crossing coherent onpeak/offpeak. another cdr for remaining " .
($cdr->{duration} - $rating_duration) . " secs of call ID $cdr->{call_id} was created";
DEBUG "New rating fragment CDR with ".($cdr->{duration} - $rating_duration)." secs duration created from cdr ID $cdr->{id}";
} else {
$rollback = 1;
FATAL "cdr ID $cdr->{id} seems to be already processed by someone else";

@ -4,7 +4,7 @@ use strict;
use warnings;
use LWP::UserAgent qw();
use JSON qw();
use JSON::PP qw();
use Test::More;
use Time::HiRes qw(); #prevent warning from Time::Warp
use Time::Warp qw();
@ -51,6 +51,7 @@ our @EXPORT_OK = qw(
setup_package
to_pretty_json
cartesian_product
is_float_approx
);
my ($netloc) = ($uri =~ m!^https?://(.*)/?.*$!);
@ -198,11 +199,11 @@ sub _create_item {
my ($resource,@params) = @_;
my $map = _get_entity_map($resource);
my $n = 1 + scalar keys %$map;
Data::Rmap::rmap { $_ =~ s/<n>/$n/; $_ =~ s/<i>/$n/; $_ =~ s/<t>/$t/; } @params;
Data::Rmap::rmap { $_ =~ s/<n>/$n/ if defined $_; $_ =~ s/<i>/$n/ if defined $_; $_ =~ s/<t>/$t/ if defined $_; } @params;
$req = HTTP::Request->new('POST', $uri.'/api/'.$resource.'/');
$req->header('Content-Type' => 'application/json');
$req->header('X-Fake-Clienttime' => _get_fake_clienttime_now());
$req->content(JSON::to_json({
$req->content(_to_json({
@params
}));
$res = _ua_request($req);
@ -210,13 +211,13 @@ sub _create_item {
$req = HTTP::Request->new('GET', $uri.$res->header('Location'));
$req->header('X-Fake-Clienttime' => _get_fake_clienttime_now());
$res = _ua_request($req);
my $entity = JSON::from_json($res->decoded_content);
my $entity = _from_json($res->decoded_content);
$map->{$entity->{id}} = $entity;
$resource_map{$entity->{_links}->{self}->{href}} = $resource;
return $entity;
} else {
eval {
diag(JSON::from_json($res->decoded_content)->{message});
diag(_from_json($res->decoded_content)->{message});
};
}
return;
@ -227,22 +228,22 @@ sub update_item {
my $self_href = $entity->{_links}->{self}->{href};
my $resource = $resource_map{$self_href};
my $map = _get_entity_map($resource);
Data::Rmap::rmap { $_ =~ s/<t>/$t/; } %params;
Data::Rmap::rmap { $_ =~ s/<t>/$t/ if defined $_; } %params;
$req = HTTP::Request->new('PATCH', $uri.$self_href);
$req->header('Prefer' => 'return=representation');
$req->header('X-Fake-Clienttime' => _get_fake_clienttime_now());
$req->header('Content-Type' => 'application/json-patch+json');
$req->content(JSON::to_json(
$req->content(_to_json(
[ map { { op => 'replace', path => '/'.$_ , value => $params{$_} }; } keys %params ]
));
$res = _ua_request($req);
if (is($res->code, 200, "patch $resource id ".$entity->{id})) {
$entity = JSON::from_json($res->decoded_content);
$entity = _from_json($res->decoded_content);
$map->{$entity->{id}} = $entity;
return $entity;
} else {
eval {
diag(JSON::from_json($res->decoded_content)->{message});
diag(_from_json($res->decoded_content)->{message});
};
}
return $entity;
@ -362,13 +363,13 @@ sub set_cash_balance {
$req->header('Prefer' => 'return=representation');
$req->header('Content-Type' => 'application/json-patch+json');
$req->header('X-Fake-Clienttime' => _get_fake_clienttime_now());
$req->content(JSON::to_json(
$req->content(_to_json(
[ { op => 'replace', path => '/cash_balance', value => $new_cash_balance } ]
));
$res = _ua_request($req);
if (!is($res->code, 200, "setting customer id " . $customer->{id} . " cash_balance to " . $new_cash_balance * 100.0 . ' cents')) {
eval {
diag(JSON::from_json($res->decoded_content)->{message});
diag(_from_json($res->decoded_content)->{message});
};
}
@ -380,10 +381,10 @@ sub get_subscriber_preferences {
$req->header('X-Fake-Clienttime' => _get_fake_clienttime_now());
$res = _ua_request($req);
if (is($res->code, 200, "fetch subscriber id " . $subscriber->{id} . " preferences")) {
return JSON::from_json($res->decoded_content);
return _from_json($res->decoded_content);
} else {
eval {
diag(JSON::from_json($res->decoded_content)->{message});
diag(_from_json($res->decoded_content)->{message});
};
}
}
@ -412,7 +413,13 @@ sub check_interval_history {
$req->header('X-Fake-Clienttime' => _get_fake_clienttime_now());
$res = _ua_request($req);
is($res->code, 200, $label . "fetch customer id " . $customer_id . " balance intervals collection page");
my $collection = JSON::from_json($res->decoded_content);
my $collection;
eval {
$collection = _from_json($res->decoded_content);
};
if ($@) {
print $@;
}
if (!$first_only && defined $total_count) {
$ok = ok($collection->{total_count} == $total_count, $label . "check 'total_count' of collection") && $ok;
@ -454,7 +461,7 @@ sub _compare_interval {
}
if ($expected->{stop}) {
if (substr($expected->{stop},0,1) eq '~') {
$ok = _is_ts_approx($got->{stop},$expected->{stop},$label . "check interval " . $got->{id} . " stop timestamp") && $ok;
$ok = _is_ts_approx($got->{stop},substr($expected->{stop},1),$label . "check interval " . $got->{id} . " stop timestamp") && $ok;
} else {
$ok = is($got->{stop},$expected->{stop},$label . "check interval " . $got->{id} . " stop timestamp $got->{stop} = $expected->{stop}") && $ok;
}
@ -465,7 +472,11 @@ sub _compare_interval {
}
if (defined $expected->{debit}) {
$ok = is($got->{cash_debit},$expected->{debit},$label . "check interval " . $got->{id} . " cash balance interval $got->{cash_debit} = $expected->{debit}") && $ok;
if (substr($expected->{debit},0,1) eq '~') {
$ok = is_float_approx($got->{cash_debit},substr($expected->{debit},1),$label . "check interval " . $got->{id} . " cash balance interval") && $ok;
} else {
$ok = is($got->{cash_debit},$expected->{debit},$label . "check interval " . $got->{id} . " cash balance interval $got->{cash_debit} = $expected->{debit}") && $ok;
}
}
if ($expected->{profile}) {
@ -498,6 +509,14 @@ sub _is_ts_approx {
return ok($got >= $lower && $got <= $upper,$label . ' ' . datetime_to_string($expected) . ' ~ ' . datetime_to_string($got));
}
sub is_float_approx {
my ($got,$expected,$label) = @_;
my $epsilon = 1e-6;
my $lower = $expected - $epsilon;
my $upper = $expected + $epsilon;
return ok($got >= $lower && $got <= $upper,$label . ' ' . $expected . ' ~ ' . $got);
}
sub perform_topup {
my ($subscriber,$amount,$package) = @_;
@ -509,11 +528,11 @@ sub perform_topup {
package_id => ($package ? $package->{id} : undef),
subscriber_id => $subscriber->{id},
};
$req->content(JSON::to_json($req_data));
$req->content(_to_json($req_data));
$res = _ua_request($req);
if (!is($res->code, 204, "perform topup with amount " . $amount * 100.0 . " cents, " . ($package ? 'package id ' . $package->{id} : 'no package'))) {
eval {
diag(JSON::from_json($res->decoded_content)->{message});
diag(_from_json($res->decoded_content)->{message});
};
}
@ -703,8 +722,8 @@ sub setup_provider {
$provider->{contract} = update_item($provider->{contract},
billing_profile_id => $provider->{profile}->{id},
);
} else {
ok(!$split_peak_parts,'split_peak_parts disabled');
#} else {
# ok(!$split_peak_parts,'split_peak_parts disabled');
#use default billing profile id, which already comes with fees.
#$provider->{profile} = create_billing_profile(
# reseller_id => $provider->{reseller}->{id},
@ -779,7 +798,17 @@ sub _setup_fees {
}
sub to_pretty_json {
return JSON::to_json(shift, {pretty => 1}); # =~ s/(^\s*{\s*)|(\s*}\s*$)//rg =~ s/\n /\n/rg;
my $json = JSON::PP->new;
return $json->pretty->encode(shift);
#return _to_json(shift, {pretty => 1}); # =~ s/(^\s*{\s*)|(\s*}\s*$)//rg =~ s/\n /\n/rg;
}
sub _from_json {
return JSON::PP::decode_json(shift);
}
sub _to_json {
return JSON::PP::encode_json(shift);
}
sub cartesian_product {

@ -680,6 +680,7 @@ sub _insert {
}
return $id;
}
sub _delete_cdrs {
my ($dbh,$ids) = @_;
my $deleted = [];

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -14,6 +18,8 @@ use Test::More;
### this tests verify that ratomat can be run safely against
### one and the same accounting.cdr table.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
{
my $number_of_rateomat_threads = 3;

@ -1,6 +1,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -12,6 +16,8 @@ use Test::More;
### this tests verify that prepaid costs are properly
### cached and cleaned up.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
my $provider = Utils::Api::setup_provider('test.com',
[ #rates:
{

@ -1,6 +1,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -13,6 +17,8 @@ use Test::More;
### balance > 0.0/no balance produce correct customer/reseller call cost, cash balance
### and cash balance interval values.
$ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
my $init_secs = 60;
my $follow_secs = 30;
my $provider_a = create_provider('testa.com');

@ -1,6 +1,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -13,6 +17,8 @@ use Test::More;
### balance > 0.0/no balance produce correct customer/reseller call cost, cash balance
### and cash balance interval values.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
my $init_secs = 60;
my $follow_secs = 30;
my @offnet_subscribers = (Utils::Rateomat::prepare_offnet_subsriber_info({ cc => 999, ac => '2<n>', sn => '<t>' },'somewhere.tld'),

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -14,6 +18,8 @@ use Test::More;
### properly increase the destination customer's cash
### balance.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
use Text::Table;
use Text::Wrap;
use Storable;

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -12,6 +16,8 @@ use Test::More;
### this tests verify that rating correctly
### consumes up free time before cash balance.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
my $init_secs = 50;
my $follow_secs = 20;
my $in_free_time = $init_secs + 20 * $follow_secs;

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -13,6 +17,8 @@ use Test::More;
### this tests verify that rates are correctly choosen
### depending on the caller (source) ip.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
my $provider = Utils::Api::setup_provider('test.com',
[ #rates:
{ #any

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -18,6 +22,8 @@ use Data::Dumper;
### note: since it also includes minute-based balance intervals, this tests
### takes longer time to complete
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
#goto SKIP;
{ #no package:
my $now = Utils::Api::get_now();

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -14,6 +18,8 @@ use Test::More;
### profile are correctly applied when balance was discarded during catchup,
### or call costs decrease the balance so it drops below the thresholds.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
Utils::Api::set_time(Utils::Api::get_now->subtract(months => 5));
#provider contract needs to be created in the past as well:
my $provider = create_provider();

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -16,6 +20,8 @@ use Storable qw();
### which also depends on topups performed.
### note: this tests takes longer time to complete
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
Utils::Api::set_time(Utils::Api::get_now->subtract(months => 5));
#provider contract needs to be created in the past as well:
my $provider = create_provider();

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
@ -13,6 +17,8 @@ use Test::More;
### this short tests verify that created contract_balance records show a
### correct gap in their hourly balance intervals.
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
if ('Europe/Vienna' eq Utils::Api::get_now->time_zone->name) {
Utils::Api::set_time(Utils::Api::datetime_from_string('2015-03-01 00:00:00'));

@ -2,9 +2,14 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
use Utils::Api qw();
use Utils::Rateomat qw();
use Test::More;
use List::Util qw();
### testcase outline:
### onnet calls of callers with profiles using different
@ -15,7 +20,9 @@ use Test::More;
### phases during a single call, another new cdr has to be created
### per peaktime fragment with each rateomat loop ("split peak parts").
local $ENV{RATEOMAT_WRITE_CDR_RELATION_DATA} = 1;
local $ENV{RATEOMAT_SPLIT_PEAK_PARTS} = 1;
local $ENV{RATEOMAT_BATCH_SIZE} = 1;
#use Text::Table;
#use Text::Wrap;
@ -63,12 +70,34 @@ local $ENV{RATEOMAT_SPLIT_PEAK_PARTS} = 1;
my $balance = 0; #no balances, for correct source_customer_cost
my $caller = Utils::Api::setup_subscriber($provider,$profile,$balance,{ cc => 888, ac => '1<n>', sn => '<t>' });
my $callee = Utils::Api::setup_subscriber($provider,$profile,$balance,{ cc => 888, ac => '2<n>', sn => '<t>' });
my $caller_costs = $provider->{subscriber_fees}->[0]->{fees}->[0]->{offpeak_init_rate} * 60 +
$provider->{subscriber_fees}->[0]->{fees}->[0]->{onpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2 + 0.99) +
$provider->{subscriber_fees}->[0]->{fees}->[0]->{offpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2);
my $caller_provider_costs = $provider->{provider_fee}->{fees}->[0]->{offpeak_init_rate} * 60 +
$provider->{provider_fee}->{fees}->[0]->{onpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2 + 0.99) +
$provider->{provider_fee}->{fees}->[0]->{offpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2);
#my $caller_costs = $provider->{subscriber_fees}->[0]->{fees}->[0]->{offpeak_init_rate} * 1 +
# $provider->{subscriber_fees}->[0]->{fees}->[0]->{onpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2 + 0.99) +
# $provider->{subscriber_fees}->[0]->{fees}->[0]->{offpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2);
#my $caller_provider_costs = $provider->{provider_fee}->{fees}->[0]->{offpeak_init_rate} * 60 +
# $provider->{provider_fee}->{fees}->[0]->{onpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2 + 0.99) +
# $provider->{provider_fee}->{fees}->[0]->{offpeak_follow_rate} * 60 * int(($call_minutes - 1) / 2);
my @caller_costs = (
$provider->{subscriber_fees}->[0]->{fees}->[0]->{offpeak_init_rate} * 60, #07:59:50 .. 08:00:50
$provider->{subscriber_fees}->[0]->{fees}->[0]->{onpeak_follow_rate} * 10,
(map { ($provider->{subscriber_fees}->[0]->{fees}->[0]->{offpeak_follow_rate} * 60,
$provider->{subscriber_fees}->[0]->{fees}->[0]->{onpeak_follow_rate} * 60); } (1..(int(($call_minutes - 1) / 2 + 0.99) - 1))), #4x on
$provider->{subscriber_fees}->[0]->{fees}->[0]->{offpeak_follow_rate} * 50,
);
my @caller_provider_costs = (
$provider->{provider_fee}->{fees}->[0]->{offpeak_init_rate} * 1 + #07:59:50 .. 08:00:50
$provider->{provider_fee}->{fees}->[0]->{offpeak_follow_rate} * 9 +
$provider->{provider_fee}->{fees}->[0]->{onpeak_follow_rate} * 50,
$provider->{provider_fee}->{fees}->[0]->{onpeak_follow_rate} * 10,
(map { ($provider->{provider_fee}->{fees}->[0]->{offpeak_follow_rate} * 60,
$provider->{provider_fee}->{fees}->[0]->{onpeak_follow_rate} * 60); } (1..(int(($call_minutes - 1) / 2 + 0.99) - 1))), #4x on
$provider->{provider_fee}->{fees}->[0]->{offpeak_follow_rate} * 50,
);
$t = Utils::Api::datetime_from_string($date . ' 07:59:50');
Utils::Api::set_time();
my $cdr = Utils::Rateomat::create_cdrs([
@ -80,28 +109,41 @@ local $ENV{RATEOMAT_SPLIT_PEAK_PARTS} = 1;
my %cdr_id_map = ();
my $onpeak = 0; #call starts offpeak
my $i = 1;
my $remaining = $call_minutes * 60;
while (defined $cdr && ok(Utils::Rateomat::run_rateomat_threads(),'rate-o-mat executed')) {
# rated fragment:
$cdr = Utils::Rateomat::get_cdrs($cdr->{id});
$cdr_id_map{$cdr->{id}} = $cdr;
Utils::Rateomat::check_cdr('cdr was processed: ',$cdr->{id},{ rating_status => 'ok' });
Utils::Rateomat::check_cdr('cdr is fragmented: ',$cdr->{id},{ is_fragmented => '1' });
Utils::Rateomat::check_cdr('cdr is reseller onpeak: ',$cdr->{id},{ frag_reseller_onpeak => "$onpeak" });
Utils::Rateomat::check_cdr('cdr is customer onpeak: ',$cdr->{id},{ frag_customer_onpeak => "$onpeak" });
Utils::Rateomat::check_cdr('cdr duration: ',$cdr->{id},{ duration => '60.000' });
Utils::Api::is_float_approx($cdr->{source_customer_cost},$caller_costs[$i-1],'caller costs: ');
Utils::Api::check_interval_history("caller ",$caller->{customer}->{id},[{
debit => '~'.List::Util::sum(@caller_costs[0..$i-1])/100.0,
},]);
Utils::Api::is_float_approx($cdr->{source_reseller_cost},$caller_provider_costs[$i-1],'caller provider costs: ');
Utils::Api::check_interval_history("caller provider ",$caller->{reseller}->{contract_id},[{
debit => '~'.List::Util::sum(@caller_provider_costs[0..$i-1])/100.0,
},]);
my $duration = (($remaining < 60) ? $remaining : 60);
$duration = 10 if $i == 2;
Utils::Rateomat::check_cdr('cdr duration: ',$cdr->{id},{ duration => $duration.'.000' });
my @split_cdrs = grep { !exists $cdr_id_map{$_->{id}}; } @{ Utils::Rateomat::get_cdrs_by_call_id($cdr->{call_id}) };
if ((scalar @split_cdrs) > 0) {
is(scalar @split_cdrs,1,'exactly one new split cdr');
$cdr = $split_cdrs[0];
Utils::Rateomat::check_cdr('split cdr is unrated: ',$cdr->{id},{ rating_status => 'unrated' });
Utils::Rateomat::check_cdr('split cdr is fragmented: ',$cdr->{id},{ is_fragmented => '1' });
Utils::Rateomat::check_cdr('split cdr duration: ',$cdr->{id},{ duration => ($call_minutes-$i)*60 . '.000' });
$remaining -= $duration;
Utils::Rateomat::check_cdr('split cdr duration: ',$cdr->{id},{ duration => $remaining . '.000' });
$i++;
$onpeak = ($onpeak ? 0 : 1);
} else {
undef $cdr;
}
}
is(scalar keys %cdr_id_map,$call_minutes,"call was split into $call_minutes cdrs");
is(scalar keys %cdr_id_map,$call_minutes + 1,"call was split into " . ($call_minutes + 1) . " cdrs");
my $duration_sum = 0;
my $caller_costs_sum = 0;
my $caller_provider_costs_sum = 0;
@ -112,8 +154,8 @@ local $ENV{RATEOMAT_SPLIT_PEAK_PARTS} = 1;
$caller_provider_costs_sum += $cdr->{source_reseller_cost};
}
ok($duration_sum == $call_minutes * 60,'sum of rated duration is ' . $call_minutes * 60 . ' secs');
ok($caller_costs_sum == $caller_costs,'caller costs is ' . $caller_costs);
ok($caller_provider_costs_sum == $caller_provider_costs,'caller provider costs is ' . $caller_provider_costs);
Utils::Api::is_float_approx($caller_costs_sum,List::Util::sum(@caller_costs),'caller costs: ');
Utils::Api::is_float_approx($caller_provider_costs_sum,List::Util::sum(@caller_provider_costs),'caller provider costs: ');
}
@ -150,12 +192,12 @@ sub create_provider {
destination => '.',
onpeak_init_rate => 30,
onpeak_init_interval => 60,
onpeak_follow_rate => 10,
onpeak_follow_interval => 60,
onpeak_follow_rate => sprintf("%.10f",10/60),
onpeak_follow_interval => 1, #60,
offpeak_init_rate => 3,
offpeak_init_interval => 60,
offpeak_follow_rate => 1,
offpeak_follow_interval => 60,
offpeak_follow_rate => sprintf("%.10f",1/60),
offpeak_follow_interval => 1, #60,
},
],
@peaktimes,
@ -166,16 +208,16 @@ sub create_provider {
# provider rate
fees => [
{
direction => 'out',
destination => '.',
onpeak_init_rate => 40,
onpeak_init_interval => 60,
onpeak_follow_rate => 20,
onpeak_follow_interval => 60,
offpeak_init_rate => 4,
offpeak_init_interval => 60,
offpeak_follow_rate => 2,
offpeak_follow_interval => 60,
direction => 'out',
destination => '.',
onpeak_init_rate => 40,
onpeak_init_interval => 60,
onpeak_follow_rate => sprintf("%.10f",20/60),
onpeak_follow_interval => 1, #60,
offpeak_init_rate => sprintf("%.10f",4/60),
offpeak_init_interval => 1, #60,
offpeak_follow_rate => sprintf("%.10f",2/60),
offpeak_follow_interval => 1, #60,
},
],
@peaktimes,

@ -2,6 +2,10 @@
use strict;
use warnings;
use File::Basename;
use Cwd;
use lib Cwd::abs_path(File::Basename::dirname(__FILE__));
#use Time::Local qw(timegm timelocal);
use POSIX qw(mktime);
use Test::More;

Loading…
Cancel
Save