276 lines
7.1 KiB
Perl
276 lines
7.1 KiB
Perl
|
package Dahdi::Config::Gen;
|
||
|
|
#
|
||
|
|
# Written by Oron Peled <oron@actcom.co.il>
|
||
|
|
# Copyright (C) 2009, Xorcom
|
||
|
|
# This program is free software; you can redistribute and/or
|
||
|
|
# modify it under the same terms as Perl itself.
|
||
|
|
#
|
||
|
|
# $Id$
|
||
|
|
#
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
Dahdi::Config::Gen -- Wrapper class for configuration generators.
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
use Dahdi::Config::Gen qw(is_true);
|
||
|
|
my $params = Dahdi::Config::Params->new('the-config-file');
|
||
|
|
my $gconfig = Dahdi::Config::Gen->new($params);
|
||
|
|
my $num = $gconfig->{'base_exten'};
|
||
|
|
my $overlap = is_true($gconfig->{'brint_overlap'});
|
||
|
|
$gconfig->dump; # For debugging
|
||
|
|
$gconfig->run_generator('system', {}, @spans);
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
The constructor must be given an C<Dahdi::Config::Params> object.
|
||
|
|
The returned object contains all data required for generation in the
|
||
|
|
form of a hash.
|
||
|
|
|
||
|
|
The constructor maps the C<item()>s from the parameter object into semantic
|
||
|
|
configuration keys. E.g: the C<lc_country> item is mapped to C<loadzone> and
|
||
|
|
C<defaultzone> keys.
|
||
|
|
|
||
|
|
The actual generation is done by delegation to one of the generators.
|
||
|
|
This is done via the C<run_generator()> method which receive the
|
||
|
|
generator name, a generator specific options hash and a list of
|
||
|
|
span objects (from C<Dahdi::Span>) for which to generate configuration.
|
||
|
|
|
||
|
|
This module contains few helper functions. E.g: C<is_true()>, C<bchan_range()>.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
require Exporter;
|
||
|
|
@ISA = qw(Exporter);
|
||
|
|
|
||
|
|
@EXPORT_OK = qw(is_true);
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
# Parse values as true/false
|
||
|
|
sub is_true($) {
|
||
|
|
my $val = shift;
|
||
|
|
return undef unless defined $val;
|
||
|
|
return $val =~ /^(1|y|yes)$/i;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub range_string($$) {
|
||
|
|
my ($start, $end) = @_;
|
||
|
|
|
||
|
|
if($start == $end) {
|
||
|
|
sprintf "%d", $start;
|
||
|
|
} else {
|
||
|
|
sprintf "%d-%d", $start, $end;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Generate channel range strings from arrays of chan numbers
|
||
|
|
# E.g: "63-77,79-93"
|
||
|
|
sub channo_range(@) {
|
||
|
|
my @channos = sort { $a <=> $b } @_;
|
||
|
|
my $first_num = $channos[0];
|
||
|
|
my $range_start = $first_num;
|
||
|
|
my @range;
|
||
|
|
my $prev = undef;
|
||
|
|
|
||
|
|
foreach my $c (@channos) {
|
||
|
|
my $curr = $c;
|
||
|
|
if(!defined($prev)) {
|
||
|
|
# First iteration
|
||
|
|
$prev = $curr;
|
||
|
|
} elsif($curr != $prev + 1) {
|
||
|
|
# New range
|
||
|
|
push(@range, range_string($range_start, $prev));
|
||
|
|
$range_start = $curr;
|
||
|
|
}
|
||
|
|
$prev = $curr;
|
||
|
|
}
|
||
|
|
if($prev >= $first_num) {
|
||
|
|
# Last range
|
||
|
|
push(@range, range_string($range_start, $prev));
|
||
|
|
}
|
||
|
|
return join(',', @range);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Generate channel range strings from chan objects
|
||
|
|
# E.g: "63-77,79-93"
|
||
|
|
sub chan_range(@) {
|
||
|
|
my @chans = sort { $a->num <=> $b->num } @_;
|
||
|
|
my @channos = map { $_->num } @chans;
|
||
|
|
channo_range(@channos);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Generate channel range strings from digital span objects
|
||
|
|
# E.g: "63-77,79-93"
|
||
|
|
sub bchan_range($) {
|
||
|
|
my $span = shift || die;
|
||
|
|
die unless $span->is_digital();
|
||
|
|
my $first_chan = ($span->chans())[0];
|
||
|
|
my $first_num = $first_chan->num();
|
||
|
|
my $bchan_ref = $span->bchan_list();
|
||
|
|
my @channos = map { $_ + $first_num } @{$bchan_ref};
|
||
|
|
channo_range(@channos);
|
||
|
|
}
|
||
|
|
|
||
|
|
# Returns a channel numbers array from a channel range string
|
||
|
|
sub parse_chan_range($) {
|
||
|
|
my $rangestr = shift;
|
||
|
|
$rangestr =~ s/\s*//g; # Squeeze
|
||
|
|
die "Bad characters in '$rangestr'" if $rangestr =~ /[^\d\s,-]/;
|
||
|
|
my @ranges = split(/,/, $rangestr);
|
||
|
|
my @channos;
|
||
|
|
my $last_end;
|
||
|
|
|
||
|
|
foreach my $range (@ranges) {
|
||
|
|
my ($start, $end) = split(/-/, $range, 2);
|
||
|
|
$end = $start unless defined $end;
|
||
|
|
die "Bad characters in '$start'" if $start =~ /\D/;
|
||
|
|
die "Bad characters in '$end'" if $end =~ /\D/;
|
||
|
|
die "Reversed range $end < $start" if $end < $start;
|
||
|
|
die "Channel number < 1" if $start < 1;
|
||
|
|
die "New range begins below previous $start <= $last_end" if defined($last_end) && $last_end >= $start;
|
||
|
|
for(my $i = $start + 0; $i <= $end; $i++) {
|
||
|
|
push(@channos, $i);
|
||
|
|
}
|
||
|
|
$last_end = $end;
|
||
|
|
}
|
||
|
|
return sort { $a <=> $b } @channos;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub new($) {
|
||
|
|
my $pack = shift || die "$0: Missing package argument";
|
||
|
|
my $p = shift || die "$0: Missing parameters argument";
|
||
|
|
|
||
|
|
# Set defaults
|
||
|
|
my $fxs_default_start = $p->item('fxs_default_start');
|
||
|
|
my $fxo_default_start = $p->item('fxo_default_start');
|
||
|
|
|
||
|
|
my %default_context = (
|
||
|
|
FXO => $p->item('context_lines'),
|
||
|
|
FXS => $p->item('context_phones'),
|
||
|
|
IN => $p->item('context_input'),
|
||
|
|
OUT => $p->item('context_output'),
|
||
|
|
DYN => $p->item('context_lines'),
|
||
|
|
BRI_TE => $p->item('context_lines'),
|
||
|
|
BRI_NT => $p->item('context_lines'),
|
||
|
|
E1_TE => $p->item('context_lines'),
|
||
|
|
T1_TE => $p->item('context_lines'),
|
||
|
|
J1_TE => $p->item('context_lines'),
|
||
|
|
E1_NT => $p->item('context_lines'),
|
||
|
|
T1_NT => $p->item('context_lines'),
|
||
|
|
J1_NT => $p->item('context_lines'),
|
||
|
|
);
|
||
|
|
my %default_group = (
|
||
|
|
FXO => $p->item('group_lines'),
|
||
|
|
FXS => $p->item('group_phones'),
|
||
|
|
IN => '',
|
||
|
|
OUT => '',
|
||
|
|
DYN => '',
|
||
|
|
BRI_TE => $p->item('group_lines'),
|
||
|
|
BRI_NT => $p->item('group_lines'),
|
||
|
|
E1_TE => $p->item('group_lines'),
|
||
|
|
T1_TE => $p->item('group_lines'),
|
||
|
|
J1_TE => $p->item('group_lines'),
|
||
|
|
E1_NT => $p->item('group_lines'),
|
||
|
|
T1_NT => $p->item('group_lines'),
|
||
|
|
J1_NT => $p->item('group_lines'),
|
||
|
|
);
|
||
|
|
my %default_dahdi_signalling = (
|
||
|
|
FXO => "fxs$fxo_default_start",
|
||
|
|
FXS => "fxo$fxs_default_start",
|
||
|
|
IN => "fxo$fxs_default_start",
|
||
|
|
OUT => "fxo$fxs_default_start",
|
||
|
|
DYN => "clear",
|
||
|
|
);
|
||
|
|
my %default_chan_dahdi_signalling = (
|
||
|
|
FXO => "fxs_$fxo_default_start",
|
||
|
|
FXS => "fxo_$fxs_default_start",
|
||
|
|
IN => "fxo_$fxs_default_start",
|
||
|
|
OUT => "fxo_$fxs_default_start",
|
||
|
|
DYN => "auto", # Cheating. Won't really work
|
||
|
|
);
|
||
|
|
|
||
|
|
# First complex mapping
|
||
|
|
my $gconfig = {
|
||
|
|
PARAMETERS => $p,
|
||
|
|
'loadzone' => $p->item('lc_country'),
|
||
|
|
'defaultzone' => $p->item('lc_country'),
|
||
|
|
'context' => \%default_context,
|
||
|
|
'group' => \%default_group,
|
||
|
|
'dahdi_signalling' => \%default_dahdi_signalling,
|
||
|
|
'chan_dahdi_signalling' => \%default_chan_dahdi_signalling,
|
||
|
|
};
|
||
|
|
# Now add trivial mappings
|
||
|
|
my @trivial = qw(
|
||
|
|
base_exten
|
||
|
|
freepbx
|
||
|
|
fxs_immediate
|
||
|
|
bri_hardhdlc
|
||
|
|
bri_sig_style
|
||
|
|
r2_idle_bits
|
||
|
|
tdm_framing
|
||
|
|
echo_can
|
||
|
|
brint_overlap
|
||
|
|
pri_termtype
|
||
|
|
pri_connection_type
|
||
|
|
em_signalling
|
||
|
|
);
|
||
|
|
foreach my $k (@trivial) {
|
||
|
|
$gconfig->{$k} = $p->item($k);
|
||
|
|
}
|
||
|
|
bless $gconfig,$pack;
|
||
|
|
|
||
|
|
return $gconfig;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub run_generator($$@) {
|
||
|
|
my $gconfig = shift || die;
|
||
|
|
my $name = shift || die "$0: Missing generator name argument";
|
||
|
|
my $genopts = shift || die "$0: Missing genopts argument";
|
||
|
|
ref($genopts) eq 'HASH' or die "$0: Bad genopts argument";
|
||
|
|
my @spans = @_;
|
||
|
|
|
||
|
|
my $module = "Dahdi::Config::Gen::$name";
|
||
|
|
#print STDERR "DEBUG: $module\n";
|
||
|
|
eval "use $module";
|
||
|
|
if($@) {
|
||
|
|
die "Failed to load configuration generator for '$name': $@\n";
|
||
|
|
}
|
||
|
|
my $cfg = $module->new($gconfig, $genopts);
|
||
|
|
$cfg->generate(@spans);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub dump($) {
|
||
|
|
my $self = shift || die;
|
||
|
|
printf STDERR "%s dump:\n", ref $self;
|
||
|
|
my $width = 30;
|
||
|
|
foreach my $k (sort keys %$self) {
|
||
|
|
my $val = $self->{$k};
|
||
|
|
my $ref = ref $val;
|
||
|
|
#print STDERR "DEBUG: '$k', '$ref', '$val'\n";
|
||
|
|
if($ref eq '') {
|
||
|
|
printf STDERR "%-${width}s %s\n", $k, $val;
|
||
|
|
} elsif($ref eq 'SCALAR') {
|
||
|
|
printf STDERR "%-${width}s %s\n", $k, ${$val};
|
||
|
|
} elsif($ref eq 'ARRAY') {
|
||
|
|
#printf STDERR "%s:\n", $k;
|
||
|
|
my $i = 0;
|
||
|
|
foreach my $v (@{$val}) {
|
||
|
|
printf STDERR "%-${width}s %s\n", "$k\->[$i]", $v;
|
||
|
|
$i++;
|
||
|
|
}
|
||
|
|
} elsif($ref eq 'HASH') {
|
||
|
|
#printf STDERR "%s:\n", $k;
|
||
|
|
foreach my $k1 (keys %{$val}) {
|
||
|
|
printf STDERR "%-${width}s %s\n", "$k\->\{$k1\}", ${$val}{$k1};
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
printf STDERR "%-${width}s (-> %s)\n", $k, $ref;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
1;
|