Relativ simples LCR AGI-/Perl-Script

#Specification of your location:
#In numbers with only one leading 0 the 0 will be replaced by 00<countrty_prefix>.
#In numbers without a leading 0 the 0 will be replaced by 00<country_prefix><city_prefix>.
#So all numbers will be normalized to 00<country><city><number>.
#Numbers with at least two 0's won't be normalized.

country prefix 49
city prefix    221

#Classification of telephone numbers:
#You can classify your telephone numbers using the Pattern Syntax known from the extensions.conf.
#X         matches any digit from 0-9
#Z         matches any digit form 1-9
#N         matches any digit from 2-9
#[1237-9]  matches any digit or letter in the brackets (in this example, 1,2,3,7,8,9)
#.         wildcard, matches one or more characters
#If you want to create a class "german_mobile" for all numbers that match 00491[567] you would do it like this:
# class german_mobile 00491[567]
#You can also define multiple patterns per class:
# class german_mobile 004915
# class german_mobile 004916
# class german_mobile 004917
#Note that a telephone number will be checked against the class pattern in the order it occurs in this config file.
#So it makes sense to put a catch all class at the end of the class list.

class german_mobile 00491[567]
class germany_01803 00491803
class germany_01805 00491805
class city          0049221
class germany       0049
class other         .

#Definition of the available providers and how to use them:
#You can create rules in this format:
# provider <name> <command-string>
#Where the <command-string> is the command which shall be executed when using this provider and looks like this:
#Within this string you may use the variable $number$, which will be replaced by the target number.
#Most probably you will call the Dial()-command or a user-defined macro.
#Example:
# provider sipgate Dial(SIP/$number$@$sipgate,60,tT)
#Note that you have to create the context "sipgate" in your sip.conf to use the above.

provider sipgate Dial(SIP/$number$@sipgate,60,tT)
provider webde   Dial(SIP/$number$@webde,60,tT)

#Definition of the rates at a specific time and for a specific number class.
#You may define the rates in this format:
# rate <class> <date-range> <provider> <rate>
#<class> is the number class, to which the dialed number matches.
#<date-range> is the range for which the rates are defined.
#It can be specified in two formats:
# Weekday:hh-Weekday-hh #from hh at weekday 1 to hh at weekday 2
# Weekday-Weekday:hh-hh #from weekday 1 to weekday 2 but only between hh and hh at each day
#Weekday will be one of Mon,Tue,Wed,Thi,Fri,Sat,Sun and hh will of 00-23.
#hh will match the time hh-00-00 to hh-59-59.
#If the end date within the range is before the start date, the range will be
#from the start date until the end date in the next week.
#<provider> will be one of the above specified providers.
#<rate> will be the rate per minute. Note that the <rate> doesn't has to match
#the actual rate of your provider. If may be any number. But a cheaper provider
#should always be defined with a lower number.
#Example:
# rate german_mobile Mon:00-Sun:23 sipgate 19.9
#The script will take the number, normalize it, classify it and then calling the
#Dial()-command of the provider, which has the lowest rates for the number class
#and the current date.
#Every number class should have at least one provider at every hour at every
#day of the week.
#If there is no matching provider for a given a number class at a given time,
#the default provider will be used:
# default provider sipgate
#Note also that you should not specify a rate for a provider that you haven't
#defined above!

#sipgate
rate german_mobile Mon-Sun:00-23 sipgate  19.90
rate german_01803  Mon-Sun:00-23 sipgate   9.00
rate german_01805  Mon-Sun:00-23 sipgate  12.00
rate germany       Mon-Sun:00-23 sipgate   1.79
rate city          Mon-Sun:00-23 sipgate   1.79

#webde
rate german_mobile Mon-Sun:00-23 webde    22.90
rate germany       Mon-Sun:00-23 webde     1.49
rate city          Mon-Sun:00-23 webde     1.49

#very cheap city provider
rate city          Sat-Sun:00-23 xxl       0.00
rate germany       Sat-Sun:00-23 xxl       0.00

#even cheaper
rate city          Sun-Mon:10-12 billitc  -1.00
rate germany       Sun-Mon:10-12 billitc  -1.00

#default provider. should be a very reliable one since it is a "catch-all" option.
default provider sipgate

;Generally dial through the least cost routing script
exten => _X.,1,Agi(least_cost_router.pl|${EXTEN},1)
exten => _X.,2,Congestion
exten => _X.,3,Busy
exten => _X.,4,Hangup

;Generally dial through the least cost routing script
exten => _X.,1,Macro(lcr-out-fallback,${EXTEN},1)

[macro-lcr-out-fallback]
;Places an outgoing call to a number (ARG1) over 3 providers returned by the LCR script.
;Start with the ARG2-th-cheapest provider. (e.g. start with the 2nd cheapest, when ARG2 = 2)
;If the call fails (DIALSTATUS = CHANUNAVAIL or CONGESTION) we will try it with the next provider

;Init
exten => s,1,GoTo(10)
;Try 1st provider
exten => s,10,Agi(least_cost_router.pl|${ARG1},$[${ARG2}])
exten => s,11,GotoIf($[$[${DIALSTATUS} = CHANUNAVAIL] | $[${DIALSTATUS} = CONGESTION]]? 20 : 90)
;Try 2nd provider
exten => s,20,Agi(least_cost_router.pl|${ARG1},$[${ARG2} + 1])
exten => s,21,GotoIf($[$[${DIALSTATUS} = CHANUNAVAIL] | $[${DIALSTATUS} = CONGESTION]]? 30 : 90)
;Try 3rd provider
exten => s,30,Agi(least_cost_router.pl|${ARG1},$[${ARG2} + 2])
exten => s,31,Goto(90)
;Final commands
exten => s,90,Congestion
exten => s,91,Busy
exten => s,92,Hangup

#!/usr/bin/perl -w
#!/usr/bin/perl

#Least cost routing AGI extension.
#(C) 2004 by Thomas Wittek tw (at) zentrifuge (dot) biz
#Released under the GNU General Public License
#
#This script will dial the cheapest provider currently available.
#Use it in your extensions.conf like this:
#  ;Explicitly dial through the least cost routing script
#  exten => _*0.,1,Agi(least_cost_router.pl|${EXTEN:2},1)
#  exten => _*0.,1,Agi(least_cost_router.pl|${EXTEN:2},1)
#You have to pass the target number and which provider of the list of cheapest
#providers you want to use as arguments to the script.
#"1" will use the cheapest, "2" will use the 2nd cheapest and so on.
#This may be interesting to construct a fallback, if the cheapest provider isn't
#available.
#
#Confuguration of the providers and rates will be done through
#/etc/asterisk/least_cost_routing_table.conf or any file
#specified in the constant CONFIG_FILE below.

use strict;
use Asterisk::AGI;
use constant CONFIG_FILE       => '/etc/asterisk/least_cost_routing_table.conf';
use constant WEEKDAY_TO_NUMBER => {qw/mon 0 tue 1 wed 2 thi 3 fri 4 sat 5 sun 6/};
use constant NUMBER_TO_WEEKDAY => {qw/0 mon 1 tue 2 wed 3 thi 4 fri 5 sat 6 sun/};
use constant DEBUG             => 1;

#returns the content of the given filename.
#returns undef on error.
sub read_file {
	my $filename = shift;
	
	if (-e $filename) {
		open(FILE, $filename);
		local($/) = undef;
		my ($file) = <FILE>;
		close(FILE);
		return $file;
	} else {
		return undef;
	}
}

#parse the config and return the results as an hash reference
sub parse_config {
	my ($config) = @_;
	
	#to convert weekday names to numbers...
	my $weekday_to_number = {qw/mon 0 tue 1 wed 2 thi 3 fri 4 sat 5 sun 6/};
	
	my $result = {};
	foreach my $line (split /(\r?\n|\r)/, $config) {
		#strip comments
		$line =~ s/\#(.*)$//g;
		#normalize white spaces
		$line =~ s/\s+/ /g;
		#remove trailing white spaces
		$line =~ s/ $//;
		#check for a valid directive
		if ($line =~ /country prefix\s+(.*)$/i) {
			$result->{country_prefix} = $1;
		} elsif ($line =~ /city prefix\s+(.*)$/i) {
			$result->{city_prefix} = $1;
		} elsif ($line =~ /class\s+(.*?)\s+(.*)$/i) {
			my ($class, $pattern) = (lc($1), $2);
			#convert asterisk pattern to perl regexp
			$pattern =~ s/x/\[0-9\]/gi;
			$pattern =~ s/z/\[1-9\]/gi;
			$pattern =~ s/n/\[2-9\]/gi;
			$pattern =~ s/\./\.\*/gi;
			$pattern .= '.*';
			#evtl. init array
			if (!exists($result->{classes})) {
				$result->{classes} = [];
			}
			#push class pattern
			push @{$result->{classes}}, [$class, $pattern];
		} elsif ($line =~ /provider\s+(.*?)\s+(.*)$/i) {
			$result->{providers}->{lc($1)} = $2;
		} elsif ($line =~ /default provider\s+(.*?)$/i) {
			$result->{default_provider} = $1;
		} elsif ($line =~ /rate\s+\S+?\s+\S+\s+\S+?\s+\S+$/i) {
			my ($class, $day1, $hour1, $day2, $hour2, $provider, $rate, $style);
			if ($line =~ /rate\s+(\S+?)\s+(\S\S\S)\:(\d|[01]\d|2[0-3])-(\S\S\S)\:(\d|[01]\d|2[0-3])\s+(\S+?)\s+(\S+)$/i) {
				# Weekday:hh-Weekday-hh #from hh at weekday 1 to hh at weekday 2
				($class, $day1, $hour1, $day2, $hour2, $provider, $rate) = ($1, $2, $3, $4, $5, $6, $7);
				$style = 1;
			} elsif ($line =~ /rate\s+(\S+?)\s+(\S\S\S)-(\S\S\S)\:(\d|[01]\d|2[0-3])-(\d|[01]\d|2[0-3])\s+(\S+?)\s+(\S+)$/i) {
				# Weekday-Weekday:hh-hh #from weekday 1 to weekday 2 but only between hh and hh at each day
				($class, $day1, $day2, $hour1, $hour2, $provider, $rate) = ($1, $2, $3, $4, $5, $6, $7);
				$style = 2;
			}
			if ($style) {
				#go through every hour at every day of the week within the specified range and add the new rate:
				$day1 = $weekday_to_number->{lc($day1)};
				$day2 = $weekday_to_number->{lc($day2)};
				if ($style == 1) {
					if ($day1 > $day2 or ($day1 == $day2 and $hour1 > $hour2)) { #wrap around one week
						$day2 += 7;
					}
				} else {
					if ($day1 > $day2) { #wrap around one week
						$day2 += 7;
					}
					if ($hour1 > $hour2) {
						$hour2 += 24;
					}
				}
				for (my $day = $day1; $day <= $day2; $day++) {
					my ($start_hour, $end_hour) = (0, 23);
					if ($style == 1) {
						if ($day == $day1) {
							$start_hour = $hour1;
						}
						if ($day == $day2) {
							$end_hour = $hour2;
						}
					} else {
						($start_hour, $end_hour) = ($hour1, $hour2);
					}
					for (my $hour = $start_hour; $hour <= $end_hour; $hour++) {
						#evtl. init array
						if (!exists($result->{rates}->{$day % 7}->{sprintf('%02d', $hour % 24)}->{$class})) {
							$result->{rates}->{$day % 7}->{sprintf('%02d', $hour % 24)}->{$class} = [];
						}
						push @{$result->{rates}->{$day % 7}->{sprintf('%02d', $hour % 24)}->{$class}}, {provider => $provider, rate => $rate};
					}
				}
			}
		} elsif ($line =~ /rate\s+(.*?)\s+(\S\S\S)-(\S\S\S)\:(\d|[01]\d|2[0-3])-(\d|[01]\d|2[0-3])\s+(.*?)\s+(.*)$/i) {
			#go through every hour at every day of the week within the specified range and add the new rate:
			my ($class, $day1, $day2, $hour1, $hour2, $provider, $rate) = ($1, $2, $3, $4, $5, $6, $7);
			$day1 = $weekday_to_number->{lc($day1)};
			$day2 = $weekday_to_number->{lc($day2)};
			if ($day1 > $day2 or ($day1 == $day2 and $hour1 > $hour2)) { #wrap around one week
				$day2 += 7;
			}
			for (my $day = $day1; $day <= $day2; $day++) {
				my ($start_hour, $end_hour) = ($hour1, $hour2);
				for (my $hour = $start_hour; $hour <= $end_hour; $hour++) {
					#evtl. init array
					if (!exists($result->{rates}->{$day % 7}->{sprintf('%02d', $hour)}->{$class})) {
						$result->{rates}->{$day % 7}->{sprintf('%02d', $hour)}->{$class} = [];
					}
					push @{$result->{rates}->{$day % 7}->{sprintf('%02d', $hour)}->{$class}}, {provider => $provider, rate => $rate};
				}
			}
		}
	}
	
	return $result;
}

#normalize number
sub normalize_number {
	my ($number, $config) = @_;
	
	#In numbers with only one leading 0 the 0 will be replaced by 00<countrty_prefix>.
	if ($number =~ /^0([^0].*)$/) {
		$number = '00' . $config->{country_prefix} . $1;
	}
	#In numbers without a leading 0 the 0 will be replaced by 00<country_prefix><city_prefix>.
	if ($number !~ /^0/) {
		$number = '00' . $config->{country_prefix} . $config->{city_prefix} . $number;
	}
	#So all numbers will be normalized to 00<country><city><number>.
	
	return $number;
}

#return the class which matches the number
sub classify_number {
	my ($number, $config) = @_;
	
	foreach my $class (@{$config->{classes}}) {
		if ($number =~ $class->[1]) {
			return $class->[0];
		}
	}
	
	return undef;
}

#return array with availaple providers for the given time and class sorted by rates. 1st = cheapest
sub cheapest_providers {
	my ($class, $day, $hour, $config) = @_;
	
	if (exists($config->{rates}->{$day % 7}->{sprintf('%02d', $hour)}->{$class})) {
		my @cheapest = sort {$a->{rate} <=> $b->{rate}} @{$config->{rates}->{$day % 7}->{sprintf('%02d', $hour)}->{$class}};
		return @cheapest;
	} else {
		return ();
	}
}


#main program
{
	#stop time for benchmarking
	my $starttime = (times)[0];
	#read config
	my $config = parse_config(read_file(CONFIG_FILE));
	
	#how has the script been started?
	if (@ARGV > 0 and lc($ARGV[0]) eq 'test') { #from the command line
		if (@ARGV == 3 and $ARGV[1] =~ /^(\S\S\S)\:(\d|[01]\d|2[0-3])$/) {
			my ($day, $hour) = (WEEKDAY_TO_NUMBER->{lc($1)}, $2);
			my $number   = normalize_number($ARGV[2], $config);
			my $class    = classify_number($number, $config);
			my @cheapest = cheapest_providers($class, $day, $hour, $config);
			if (@cheapest) {
				#put out list of available providers sorted by rate
				print "Available providers for $number (class $class) at " . NUMBER_TO_WEEKDAY->{$day} . ":$hour:\n";
				foreach my $pro (@cheapest) {
					print "$pro->{provider} \@ $pro->{rate}\n";
				}
			} else {
				my $provider = { provider => $config->{providers}->{$config->{default_provider}}, rate => '??.??' };
				print "No providers available for $number (class $class) at " . NUMBER_TO_WEEKDAY->{$day} . ":$hour! Using default provider $provider->{provider}\n";
			}
		} else {
			#output the config/plan
			use Data::Dump 'dump';
			print dump($config->{providers}) . "\n";
			print dump($config->{default_provider}) . "\n";
			print dump($config->{providers}->{$config->{default_provider}}) . "\n";
		}
	} else {
		#that should be the case when it is called from asteisk
		my $AGI = new Asterisk::AGI;
		#parse info from asterisk
		my %input  = $AGI->ReadParse();
		my $myself = $input{request};
		#get current local time
		my @localtime      = localtime(time());
		my ($day, $hour)   = (($localtime[6] - 1) % 7, $localtime[2]);
		#get normalized telephone number and the index of the n-th cheapest provider
		my $number         = normalize_number($ARGV[0], $config);
		my $provider_index = $ARGV[1] || 1;
		#classify telephone number
		my $class          = classify_number($number, $config);
		#get cheapest providers
		my @cheapest       = cheapest_providers($class, $day, $hour, $config);
		#put out some info and select provider
		my $duration  = ((times)[0]-$starttime);
		warn sprintf("$myself: Calculated cheapest providers in %.4f seconds", $duration) if DEBUG;
		my $provider;
		if (@cheapest) {
			if (DEBUG) {
				#put out list of available providers sorted by rate
				warn "$myself: Available providers for $number (class $class) at ". NUMBER_TO_WEEKDAY->{$day} . ":$hour:";
				foreach my $pro (@cheapest) {
					warn "$myself: $pro->{provider} \@ $pro->{rate}";
				}
				warn "$myself: Requested " . ($provider_index < 4 ? qw/1st 2nd 3rd/[$provider_index - 1] : $provider_index . 'th') . " cheapest provider";
			}
			if ($provider_index <= @cheapest) {
				$provider = $cheapest[$provider_index - 1];
				warn "$myself: Using provider $provider->{provider} \@ $provider->{rate}" if DEBUG;
			} else {
				$provider = { provider => $config->{providers}->{$config->{default_provider}}, rate => '??.??' };
				warn "$myself: Only " . scalar(@cheapest) . " providers available! Using default provider $provider->{provider}" if DEBUG;
			}
		} else {
			$provider = { provider => $config->{providers}->{$config->{default_provider}}, rate => '??.??' };
			warn "$myself: No providers available for $number (class $class) at " . NUMBER_TO_WEEKDAY->{$day} . ":$hour! Using default provider $provider->{provider}" if DEBUG;
		}
		#get command that should be executed
		my $command = $config->{providers}->{$provider->{provider}};
		#replace variable $number$
		$command =~ s/\$number\$/$number/gi;
		warn "$myself: Executing $command" if DEBUG;
		#split Command(parameters) into Command and parameters:
		my ($application, $parameters) = split /\(/, $command, 2; $parameters =~ s/\)$//;
		#split comma separated parameters and join them with pipes
		$parameters = join('|', split /,/, $parameters);
		#execute command
		$AGI->exec($application, $parameters);
	}
}

exit 0;

#Specification of your location:
country prefix 49
city prefix    221

#Classification of telephone numbers:
#Sipgate numbers
class sipgate          00493086870
class sipgate          00494041431
class sipgate          00496938097
class sipgate          00498942095
class sipgate          00492014263
class sipgate          00492115800
class sipgate          004922135533
class sipgate          004923110872
class sipgate          00493416001
class sipgate          00493514172
class sipgate          00494215728
class sipgate          004951169604
class sipgate          00497115088
class sipgate          00499113083
#Web.de numbers
class webde            00491212
class webde            00492222948
#General numbers
class germany_mobile_d 004915[012]
class germany_mobile_d 004916[012]
class germany_mobile_d 004917[012345]
class germany_mobile_e 0049163
class germany_mobile_e 004917[6789]
class germany_01803    00491803
class germany_01805    00491805
class germany_free     0049800
class germany_free     0049130
class germany_city     0049221
class germany          0049
class other            .

#Definition of the available providers and how to use them:
provider sipgate Dial(SIP/$number$@sipgate,60,tT)
provider webde   Dial(SIP/$number$@webde,60,tT)
provider gmx     Dial(SIP/$number$@gmx,60,tT)

#Definition of the rates at a specific time and for a specific number class.
#sipgate
rate germany_mobile_d Mon-Sun:00-23 sipgate  19.90
rate germany_mobile_e Mon-Sun:00-23 sipgate  19.90
rate germany_01803    Mon-Sun:00-23 sipgate   9.00
rate germany_01805    Mon-Sun:00-23 sipgate  12.00
rate germany_free     Mon-Sun:00-23 sipgate   0.00
rate germany_city     Mon-Sun:00-23 sipgate   1.79
rate germany          Mon-Sun:00-23 sipgate   1.79
rate sipgate          Mon-Sun:00-23 sipgate   0.00
rate webde            Mon-Sun:00-23 sipgate   1.79

#webde
rate germany_mobile_d Mon-Sun:00-23 webde    22.90
rate germany_mobile_e Mon-Sun:00-23 webde    22.90
rate germany_free     Mon-Sun:00-23 webde    -0.01 #make webde cheaper than sipgate to favour webde
rate germany_city     Mon-Sun:00-23 webde     1.49
rate germany          Mon-Sun:00-23 webde     1.49
rate sipgate          Mon-Sun:00-23 webde     1.49
rate webde            Mon-Sun:00-23 webde     0.00

#gmx
rate germany_mobile_d Mon-Sun:00-23 gmx      19.89 #make gmx cheaper than sipgate to favour gmx
rate germany_mobile_e Mon-Sun:00-23 gmx      24.90
rate germany_city     Mon-Sun:00-23 gmx       1.00
rate germany          Mon-Sun:00-23 gmx       1.00
rate sipgate          Mon-Sun:00-23 gmx       1.00
rate webde            Mon-Sun:00-23 gmx       1.00

#default provider. Should be a very reliable one since it is a "catch-all" option.
default provider sipgate