view release on metacpan or  search on metacpan

bin/asterisk-lcr-dialplan  view on Meta::CPAN

#!/usr/bin/perl
use lib qw (. .. ./lib);
use warnings;
use strict;

use Asterisk::LCR::Storage::MyRoutes;
use Asterisk::LCR::Route;
use Config::Mini;


$SIG{__WARN__} = sub { $_[0] !~ /Can't locate AGI\/Fake\.pm/ and warn @_ };

@ARGV || die "Usage: $0 <config_file>";
Config::Mini::parse_file (shift);

$Asterisk::LCR::Storage::MyRoutes::FILE = shift || "__NO_FILE__";

our $STORE  = Config::Mini::instantiate ("storage") || die "no storage configured";
our $DIALER = Config::Mini::instantiate ("dialer")  || die "no dialer configured";
our $LOCALE = $DIALER->locale();


# ----------------------------------------------------------------------------
print STDERR "Reading all possible prefixes from all_rates.csv\n";
our %Prefixes = ();

open FP, "<all_rates.csv" or die "Cannot open-read all_rates.csv";
my $head = <FP>;
while (<FP>)
{
    chomp();
    s/,.*$//;
    $Prefixes{$_} = 1;
}
close FP;


# ----------------------------------------------------------------------------
print STDERR "Checking if $Asterisk::LCR::Storage::MyRoutes::FILE exists... ";
our $MYRATES_STORE = undef;
if ($Asterisk::LCR::Storage::MyRoutes::FILE and -e $Asterisk::LCR::Storage::MyRoutes::FILE)
{
    print STDERR "Yes! Loading fake storage object\n";
    $MYRATES_STORE = Asterisk::LCR::Storage::MyRoutes->new();
}
else
{
    print STDERR "Nope. No prefix filtering will be performed.\n";
}


# ----------------------------------------------------------------------------
print STDERR "Generating dialplan";
our @out = ();
my $cnt = 0;
foreach my $pfx (sort keys %Prefixes)
{
    $cnt ++;
    print STDERR "." unless ($cnt % 100);
    my $local_pfx = $LOCALE ? $LOCALE->global_to_local ($pfx) : $pfx;

    my $count = 1;
    
    if ($MYRATES_STORE)
    {
        # Step 1: Check that this prefix is supported by $MYRATES_STORE
        my ($own_rate) = $MYRATES_STORE->search_rates ($pfx);
        $own_rate or next;
        
        # Step 2: Grab the rate from our LCR store
        my @rates = $STORE->search_rates ($pfx, $DIALER->limit());

        # Step 3: Remove all rates which might be decidedly too
        #         expensive compared with our own rates.
        #         Otherwise, proceed to LCR dialing.
        @rates = map { $own_rate->rate() > $_->rate() ? $_ : () } @rates;
        
        my @dial_string  = @{$DIALER->_process ($pfx)};   
        while (scalar @dial_string and scalar @rates)
        {