summaryrefslogtreecommitdiff
path: root/xpp/perl_modules
diff options
context:
space:
mode:
authorTzafrir Cohen <tzafrir.cohen@xorcom.com>2009-03-02 20:43:25 +0000
committerTzafrir Cohen <tzafrir.cohen@xorcom.com>2009-03-02 20:43:25 +0000
commitbf8893ba35004a7f6649a90b5995b0eba457c66f (patch)
treef8fdd408ff830fdc38a0ebc15b3abb652def3108 /xpp/perl_modules
parente594beaf47f16883bce725a686440d086683baff (diff)
dahdi_genconf: configuration handling cleanup.
* Parsing genconf_parameters is now in Dahdi::Config::Params All hard-coded defaults are there too (in the item() method). * Dahdi::Config::Genconf is gone (merged into Dahdi::Config::Gen) All semantic mapping is in the constructor. * dahdi_genconf is now lean and mean. * Add some implementation docs into these files. git-svn-id: http://svn.asterisk.org/svn/dahdi/tools/trunk@6075 a0bf4364-ded3-4de4-8d8a-66a801d63aff
Diffstat (limited to 'xpp/perl_modules')
-rw-r--r--xpp/perl_modules/Dahdi/Config/Gen.pm181
-rw-r--r--xpp/perl_modules/Dahdi/Config/Gen/Chandahdi.pm2
-rw-r--r--xpp/perl_modules/Dahdi/Config/Gen/System.pm2
-rw-r--r--xpp/perl_modules/Dahdi/Config/Gen/Unicall.pm2
-rw-r--r--xpp/perl_modules/Dahdi/Config/Gen/Users.pm2
-rw-r--r--xpp/perl_modules/Dahdi/Config/Params.pm148
6 files changed, 324 insertions, 13 deletions
diff --git a/xpp/perl_modules/Dahdi/Config/Gen.pm b/xpp/perl_modules/Dahdi/Config/Gen.pm
index 556e193..b68fa28 100644
--- a/xpp/perl_modules/Dahdi/Config/Gen.pm
+++ b/xpp/perl_modules/Dahdi/Config/Gen.pm
@@ -1,4 +1,46 @@
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);
@@ -6,21 +48,15 @@ require Exporter;
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 show_gconfig($) {
- my $gconfig = shift || die;
-
- print "Global configuration:\n";
- foreach my $key (sort keys %{$gconfig}) {
- printf " %-20s %s\n", $key, $gconfig->{$key};
- }
-}
-
+# Generate channel range strings from span objects
+# E.g: "63-77,79-93"
sub bchan_range($) {
my $span = shift || die;
my $first_chan = ($span->chans())[0];
@@ -46,4 +82,131 @@ sub bchan_range($) {
return join(',', @range);
}
+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 %default_context = (
+ FXO => $p->item('context_lines'),
+ FXS => $p->item('context_phones'),
+ IN => $p->item('context_input'),
+ OUT => $p->item('context_output'),
+ BRI_TE => $p->item('context_lines'),
+ BRI_NT => $p->item('context_phones'),
+ E1_TE => $p->item('context_lines'),
+ T1_TE => $p->item('context_lines'),
+ J1_TE => $p->item('context_lines'),
+ E1_NT => $p->item('context_phones'),
+ T1_NT => $p->item('context_phones'),
+ J1_NT => $p->item('context_phones'),
+ );
+ my %default_group = (
+ FXO => $p->item('group_lines'),
+ FXS => $p->item('group_phones'),
+ IN => '',
+ OUT => '',
+ BRI_TE => 0,
+ BRI_NT => 6,
+ E1_TE => 0,
+ T1_TE => 0,
+ J1_TE => 0,
+ E1_NT => 6,
+ T1_NT => 6,
+ J1_NT => 6,
+ );
+ my %default_dahdi_signalling = (
+ FXO => 'fxsks',
+ FXS => "fxo$fxs_default_start",
+ IN => "fxo$fxs_default_start",
+ OUT => "fxo$fxs_default_start",
+ );
+ my %default_chan_dahdi_signalling = (
+ FXO => 'fxs_ks',
+ FXS => "fxo_$fxs_default_start",
+ IN => "fxo_$fxs_default_start",
+ OUT => "fxo_$fxs_default_start",
+ );
+
+ # 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
+ echo_can
+ brint_overlap
+ pri_termtype
+ pri_connection_type
+ );
+ 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;
diff --git a/xpp/perl_modules/Dahdi/Config/Gen/Chandahdi.pm b/xpp/perl_modules/Dahdi/Config/Gen/Chandahdi.pm
index f48455d..1f39a7a 100644
--- a/xpp/perl_modules/Dahdi/Config/Gen/Chandahdi.pm
+++ b/xpp/perl_modules/Dahdi/Config/Gen/Chandahdi.pm
@@ -131,7 +131,7 @@ sub generate($) {
my $file = $self->{FILE};
my $gconfig = $self->{GCONFIG};
my $genopts = $self->{GENOPTS};
- #Dahdi::Config::Gen::show_gconfig($gconfig);
+ #$gconfig->dump;
my @spans = @_;
warn "Empty configuration -- no spans\n" unless @spans;
rename "$file", "$file.bak"
diff --git a/xpp/perl_modules/Dahdi/Config/Gen/System.pm b/xpp/perl_modules/Dahdi/Config/Gen/System.pm
index da60ec4..f805b65 100644
--- a/xpp/perl_modules/Dahdi/Config/Gen/System.pm
+++ b/xpp/perl_modules/Dahdi/Config/Gen/System.pm
@@ -107,7 +107,7 @@ sub generate($$$) {
rename "$file", "$file.bak"
or $! == 2 # ENOENT (No dependency on Errno.pm)
or die "Failed to backup old config: $!\n";
- #Dahdi::Config::Gen::show_gconfig($gconfig);
+ #$gconfig->dump;
print "Generating $file\n" if $genopts->{verbose};
open(F, ">$file") || die "$0: Failed to open $file: $!\n";
my $old = select F;
diff --git a/xpp/perl_modules/Dahdi/Config/Gen/Unicall.pm b/xpp/perl_modules/Dahdi/Config/Gen/Unicall.pm
index 526b62b..1a796f4 100644
--- a/xpp/perl_modules/Dahdi/Config/Gen/Unicall.pm
+++ b/xpp/perl_modules/Dahdi/Config/Gen/Unicall.pm
@@ -22,7 +22,7 @@ sub generate($) {
my $file = $self->{FILE};
my $gconfig = $self->{GCONFIG};
my $genopts = $self->{GENOPTS};
- #Dahdi::Config::Gen::show_gconfig($gconfig);
+ #$gconfig->dump;
my @spans = @_;
warn "Empty configuration -- no spans\n" unless @spans;
die "Only for R2" unless $gconfig->{'pri_connection_type'} eq 'R2';
diff --git a/xpp/perl_modules/Dahdi/Config/Gen/Users.pm b/xpp/perl_modules/Dahdi/Config/Gen/Users.pm
index 36c2e65..e9d8ab9 100644
--- a/xpp/perl_modules/Dahdi/Config/Gen/Users.pm
+++ b/xpp/perl_modules/Dahdi/Config/Gen/Users.pm
@@ -73,7 +73,7 @@ sub generate($) {
my $file = $self->{FILE};
my $gconfig = $self->{GCONFIG};
my $genopts = $self->{GENOPTS};
- #Dahdi::Config::Gen::show_gconfig($gconfig);
+ #$gconfig->dump;
my @spans = @_;
warn "Empty configuration -- no spans\n" unless @spans;
rename "$file", "$file.bak"
diff --git a/xpp/perl_modules/Dahdi/Config/Params.pm b/xpp/perl_modules/Dahdi/Config/Params.pm
new file mode 100644
index 0000000..b6d9cdc
--- /dev/null
+++ b/xpp/perl_modules/Dahdi/Config/Params.pm
@@ -0,0 +1,148 @@
+package Dahdi::Config::Params;
+#
+# 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$
+#
+use strict;
+
+=head1 NAME
+
+Dahdi::Config::Params -- Object oriented representation of F<genconf_parameters> file.
+
+=head1 SYNOPSIS
+
+ use Dahdi::Config::Params;
+ my $params = Dahdi::Config::Params->new('the-config-file');
+ print $params->item{'some-key'};
+ $params->dump; # For debugging
+
+=head1 DESCRIPTION
+
+The constructor must be given a configuration file name:
+
+=over 4
+
+=item * Missing file is B<not> an error.
+
+=item * Other opening errors cause a C<die> to be thrown.
+
+=item * The file name is saved as the value of C<GENCONF_FILE> key.
+
+=back
+
+The access to config keys should only be done via the C<item()> method:
+
+=over 4
+
+=item * It contains all hard-coded defaults.
+
+=item * All these values are overriden by directives in the config file.
+
+=back
+
+=cut
+
+sub new($$) {
+ my $pack = shift || die;
+ my $cfg_file = shift || die;
+ my $self = {
+ GENCONF_FILE => $cfg_file,
+ };
+ bless $self, $pack;
+ if(!open(F, $cfg_file)) {
+ if(defined($!{ENOENT})) {
+ #print STDERR "No $cfg_file. Assume empty config\n";
+ return $self; # Empty configuration
+ }
+ die "$pack: Failed to open '$cfg_file': $!\n";
+ }
+ #print STDERR "$pack: $cfg_file\n";
+ my $array_key;
+ while(<F>) {
+ my ($key, $val);
+ chomp;
+ s/#.*$//;
+ s/\s+$//; # trim tail whitespace
+ next unless /\S/;
+ if(defined $array_key && /^\s+/) {
+ s/^\s+//; # trim beginning whitespace
+ push(@{$self->{$array_key}}, $_);
+ next;
+ }
+ undef $array_key;
+ ($key, $val) = split(/\s+/, $_, 2);
+ $key = lc($key);
+ if(! defined $val) {
+ $array_key = $key;
+ next;
+ }
+ die "$cfg_file:$.: Duplicate key '$key'\n", if exists $self->{$key};
+ $self->{$key} = $val;
+ }
+ close F;
+ return $self;
+}
+
+sub item($$) {
+ my $self = shift || die;
+ my $key = shift || die;
+ my %defaults = (
+ base_exten => '4000',
+ freepbx => 'no', # Better via -F command line
+ fxs_immediate => 'no',
+ fxs_default_start => 'ks',
+ lc_country => 'us',
+ context_lines => 'from-pstn',
+ context_phones => 'from-internal',
+ context_input => 'astbank-input',
+ context_output => 'astbank-output',
+ group_phones => '5',
+ group_lines => '0',
+ brint_overlap => 'no',
+ bri_sig_style => 'bri_ptmp',
+ echo_can => 'mg2',
+ bri_hardhdlc => 'no',
+ pri_connection_type => 'PRI',
+ r2_idle_bits => '1101',
+ 'pri_termtype' => [ 'SPAN/* TE' ],
+ );
+
+ return (exists($self->{$key})) ? $self->{$key} :$defaults{$key};
+}
+
+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;
+