summaryrefslogtreecommitdiff
path: root/kernel/xpp/utils/zconf
diff options
context:
space:
mode:
Diffstat (limited to 'kernel/xpp/utils/zconf')
-rw-r--r--kernel/xpp/utils/zconf/Zaptel.pm2
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Chans.pm10
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Config/Defaults.pm12
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Config/Gen.pm212
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Config/Gen/Unicall.pm70
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Config/Gen/Users.pm177
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zapata.pm213
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zaptel.pm158
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Config/Params.pm149
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Hardware/PCI.pm7
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Span.pm71
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Xpp.pm125
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Xpp/Line.pm68
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm148
-rw-r--r--kernel/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm244
15 files changed, 1498 insertions, 168 deletions
diff --git a/kernel/xpp/utils/zconf/Zaptel.pm b/kernel/xpp/utils/zconf/Zaptel.pm
index 431689e..1b73d5b 100644
--- a/kernel/xpp/utils/zconf/Zaptel.pm
+++ b/kernel/xpp/utils/zconf/Zaptel.pm
@@ -25,7 +25,7 @@ hardware and loaded Zaptel devices.
my @spans = Zaptel::spans();
for my $span (@spans) {
next if ($span->is_digital);
- $span->num. " - [". $span->type ."] ". $span->name. "\n";
+ $span->num. " - [". $span->type ."] ". $span->name. "\n";
for my $chan ($span->chans) {
print " - ".$chan->num . " - [". $chan->type. "] ". $chan->fqn". \n";
}
diff --git a/kernel/xpp/utils/zconf/Zaptel/Chans.pm b/kernel/xpp/utils/zconf/Zaptel/Chans.pm
index 53ed277..aa58d1d 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Chans.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Chans.pm
@@ -149,18 +149,19 @@ sub new($$$$$$) {
# WP[TE]1: Sangoma. TODO: this one tells us if it is TE or NT.
# cwain: Junghanns E1 card.
$type = "PRI";
- } elsif ($fqn =~ m{\b(ZTHFC%d*|ztqoz\d*)/.*}) {
+ } elsif ($fqn =~ m{\b(B4|ZTHFC\d*|ztqoz\d*)/.*}) {
+ # B4: The Digium wcb4xxp ZAPTEL driver
# ZTHFC: HFC-s single-port card (zaphfc/vzaphfc)
# ztqoz: qozap (Junghanns) multi-port HFC card
$type = "BRI";
} elsif ($fqn =~ m{\bztgsm/.*}) {
# Junghanns GSM card
$type = "GSM";
- } elsif(defined $signalling) {
+ } elsif($signalling ne '') {
$type = 'FXO' if $signalling =~ /^FXS/;
$type = 'FXS' if $signalling =~ /^FXO/;
} else {
- $type = undef;
+ $type = $self->probe_type();
}
$self->type($type);
$self->span()->type($type)
@@ -216,8 +217,7 @@ sub battery($) {
my $self = shift or die;
my $span = $self->span or die;
- return undef if (not defined $self->type);
- return undef unless $self->type eq 'FXO';
+ return undef unless defined $self->type && $self->type eq 'FXO';
return $self->{BATTERY} if defined $self->{BATTERY};
my $xpd = $span->xpd;
diff --git a/kernel/xpp/utils/zconf/Zaptel/Config/Defaults.pm b/kernel/xpp/utils/zconf/Zaptel/Config/Defaults.pm
index 360ca0a..9a3dec9 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Config/Defaults.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Config/Defaults.pm
@@ -1,4 +1,16 @@
package Zaptel::Config::Defaults;
+
+#
+# !!!! DEPRECATION WARNING!!!
+#
+# This module is used by older versions of init_card_* scripts and
+# their related drivers.
+#
+# Zaptel drivers *after* 1.4.12.1 and DAHDI drivers do not use it.
+# Their configuration is read via XppConfig.pm which is always
+# bundled with the init_card_* scripts.
+#
+
#
# Written by Oron Peled <oron@actcom.co.il>
# Copyright (C) 2007, Xorcom
diff --git a/kernel/xpp/utils/zconf/Zaptel/Config/Gen.pm b/kernel/xpp/utils/zconf/Zaptel/Config/Gen.pm
new file mode 100644
index 0000000..05bb9be
--- /dev/null
+++ b/kernel/xpp/utils/zconf/Zaptel/Config/Gen.pm
@@ -0,0 +1,212 @@
+package Zaptel::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
+
+Zaptel::Config::Gen -- Wrapper class for configuration generators.
+
+=head1 SYNOPSIS
+
+ use Zaptel::Config::Gen qw(is_true);
+ my $params = Zaptel::Config::Params->new('the-config-file');
+ my $gconfig = Zaptel::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<Zaptel::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<Zaptel::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;
+}
+
+# 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];
+ my $first_num = $first_chan->num();
+ my $range_start = $first_num;
+ my @range;
+ my $prev = undef;
+
+ die unless $span->is_digital();
+ foreach my $c (@{$span->bchan_list()}) {
+ my $curr = $c + $first_num;
+ if(!defined($prev)) {
+ $prev = $curr;
+ } elsif($curr != $prev + 1) {
+ push(@range, sprintf("%d-%d", $range_start, $prev));
+ $range_start = $curr;
+ }
+ $prev = $curr;
+ }
+ if($prev >= $first_num) {
+ push(@range, sprintf("%d-%d", $range_start, $prev));
+ }
+ 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 $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'),
+ 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 => $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_zaptel_signalling = (
+ FXO => "fxs$fxo_default_start",
+ FXS => "fxo$fxs_default_start",
+ IN => "fxo$fxs_default_start",
+ OUT => "fxo$fxs_default_start",
+ );
+ my %default_zapata_signalling = (
+ FXO => "fxs_$fxo_default_start",
+ 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,
+ 'zaptel_signalling' => \%default_zaptel_signalling,
+ 'zapata_signalling' => \%default_zapata_signalling,
+ };
+ # Now add trivial mappings
+ my @trivial = qw(
+ base_exten
+ freepbx
+ fxs_immediate
+ bri_hardhdlc
+ bri_sig_style
+ r2_idle_bits
+ 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 = "Zaptel::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/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Unicall.pm b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Unicall.pm
new file mode 100644
index 0000000..3e1048d
--- /dev/null
+++ b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Unicall.pm
@@ -0,0 +1,70 @@
+package Zaptel::Config::Gen::Unicall;
+use strict;
+
+use Zaptel::Config::Gen qw(is_true);
+
+sub new($$$) {
+ my $pack = shift || die;
+ my $gconfig = shift || die;
+ my $genopts = shift || die;
+ my $file = $ENV{UNICALL_CHANNELS_FILE} || "/etc/asterisk/unicall-channels.conf";
+ my $self = {
+ FILE => $file,
+ GCONFIG => $gconfig,
+ GENOPTS => $genopts,
+ };
+ bless $self, $pack;
+ return $self;
+}
+
+sub generate($) {
+ my $self = shift || die;
+ my $file = $self->{FILE};
+ my $gconfig = $self->{GCONFIG};
+ my $genopts = $self->{GENOPTS};
+ #$gconfig->dump;
+ my @spans = @_;
+ warn "Empty configuration -- no spans\n" unless @spans;
+ die "Only for R2" unless $gconfig->{'pri_connection_type'} eq 'R2';
+ rename "$file", "$file.bak"
+ or $! == 2 # ENOENT (No dependency on Errno.pm)
+ or die "Failed to backup old config: $!\n";
+ print "Generating $file\n" if $genopts->{verbose};
+ open(F, ">$file") || die "$0: Failed to open $file: $!\n";
+ my $old = select F;
+ printf "; Autogenerated by %s on %s -- do not hand edit\n", $0, scalar(localtime);
+ print "; This file should be #included in unicall.conf\n\n";
+ foreach my $span (@spans) {
+ next unless $span->is_digital();
+ printf "; Span %d: %s %s\n", $span->num, $span->name, $span->description;
+ my $idle_bits = $gconfig->{'r2_idle_bits'};
+ printf "protocolend=%s\n", ($span->termtype() eq 'TE') ? 'cpe' : 'co';
+ printf "channel=%s\n", Zaptel::Config::Gen::bchan_range($span);
+ print "\n";
+ }
+ close F;
+ select $old;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+unicall - Generate configuration for unicall channels.
+
+=head1 SYNOPSIS
+
+ use Zaptel::Config::Gen::Unicall;
+
+ my $cfg = new Zaptel::Config::Gen::Unicall(\%global_config, \%genopts);
+ $cfg->generate(@span_list);
+
+=head1 DESCRIPTION
+
+Generate the F</etc/asterisk/unicall-channels.conf> to be included in
+F</etc/asterisk/unicall.conf>
+
+Its location may be overriden via the environment variable
+C<UNICALL_CHANNELS_FILE>.
diff --git a/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Users.pm b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Users.pm
new file mode 100644
index 0000000..7c9e937
--- /dev/null
+++ b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Users.pm
@@ -0,0 +1,177 @@
+package Zaptel::Config::Gen::Users;
+use strict;
+
+use File::Basename;
+use Zaptel::Config::Gen qw(is_true);
+
+sub new($$$) {
+ my $pack = shift || die;
+ my $gconfig = shift || die;
+ my $genopts = shift || die;
+ my $file = $ENV{USERS_FILE} || "/etc/asterisk/users.conf";
+ my $self = {
+ FILE => $file,
+ GCONFIG => $gconfig,
+ GENOPTS => $genopts,
+ };
+ bless $self, $pack;
+ return $self;
+}
+
+sub gen_channel($) {
+ my $self = shift || die;
+ my $chan = shift || die;
+ my $gconfig = $self->{GCONFIG};
+ my $type = $chan->type;
+ my $num = $chan->num;
+ die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital();
+ my $exten = $gconfig->{'base_exten'} + $num;
+ my $sig = $gconfig->{'zapata_signalling'}{$type};
+ my $full_name = "$type $num";
+
+ die "missing default_zapata_signalling for chan #$num type $type" unless $sig;
+ print << "EOF";
+[$exten]
+callwaiting = yes
+context = numberplan-custom-1
+fullname = $full_name
+cid_number = $exten
+hasagent = no
+hasdirectory = no
+hasiax = no
+hasmanager = no
+hassip = no
+hasvoicemail = yes
+host = dynamic
+mailbox = $exten
+threewaycalling = yes
+vmsecret = 1234
+secret = 1234
+signalling = $sig
+zapchan = $num
+registeriax = no
+registersip = no
+canreinvite = no
+nat = no
+dtmfmode = rfc2833
+disallow = all
+allow = all
+
+EOF
+}
+
+# generate users.conf . The specific users.conf is strictly oriented
+# towards using with the asterisk-gui .
+#
+# This code could have generated a much simpler and smaller
+# configuration file, had there been minimal level of support for
+# configuration templates in the asterisk configuration rewriting. Right
+# now Asterisk's configuration rewriting simply freaks out in the face
+# of templates: http://bugs.digium.com/11442 .
+sub generate($) {
+ my $self = shift || die;
+ my $file = $self->{FILE};
+ my $gconfig = $self->{GCONFIG};
+ my $genopts = $self->{GENOPTS};
+ #$gconfig->dump;
+ my @spans = @_;
+ warn "Empty configuration -- no spans\n" unless @spans;
+ rename "$file", "$file.bak"
+ or $! == 2 # ENOENT (No dependency on Errno.pm)
+ or die "Failed to backup old config: $!\n";
+ print "Generating $file\n" if $genopts->{verbose};
+ open(F, ">$file") || die "$0: Failed to open $file: $!\n";
+ my $old = select F;
+ print <<"HEAD";
+;!
+;! Automatically generated configuration file
+;! Filename: @{[basename($file)]} ($file)
+;! Generator: $0
+;! Creation Date: @{[scalar(localtime)]}
+;!
+[general]
+;
+; Full name of a user
+;
+fullname = New User
+;
+; Starting point of allocation of extensions
+;
+userbase = @{[$gconfig->{'base_exten'}+1]}
+;
+; Create voicemail mailbox and use use macro-stdexten
+;
+hasvoicemail = yes
+;
+; Set voicemail mailbox @{[$gconfig->{'base_exten'}+1]} password to 1234
+;
+vmsecret = 1234
+;
+; Create SIP Peer
+;
+hassip = no
+;
+; Create IAX friend
+;
+hasiax = no
+;
+; Create Agent friend
+;
+hasagent = no
+;
+; Create H.323 friend
+;
+;hash323 = yes
+;
+; Create manager entry
+;
+hasmanager = no
+;
+; Remaining options are not specific to users.conf entries but are general.
+;
+callwaiting = yes
+threewaycalling = yes
+callwaitingcallerid = yes
+transfer = yes
+canpark = yes
+cancallforward = yes
+callreturn = yes
+callgroup = 1
+pickupgroup = 1
+localextenlength = @{[length($gconfig->{'base_exten'})]}
+
+
+HEAD
+ foreach my $span (@spans) {
+ next unless grep { $_ eq $span->type} ( 'FXS', 'IN', 'OUT' );
+ printf "; Span %d: %s %s\n", $span->num, $span->name, $span->description;
+ foreach my $chan ($span->chans()) {
+ $self->gen_channel($chan);
+ }
+ print "\n";
+ }
+ close F;
+ select $old;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+users - Generate configuration for users.conf.
+
+=head1 SYNOPSIS
+
+ use Zaptel::Config::Gen::Users;
+
+ my $cfg = new Zaptel::Config::Gen::Users(\%global_config, \%genopts);
+ $cfg->generate(@span_list);
+
+=head1 DESCRIPTION
+
+Generate the F</etc/asterisk/users.conf> which is used by asterisk(1)
+and AsteriskGUI.
+
+Its location may be overriden via the environment variable F<USERS_FILE>.
diff --git a/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zapata.pm b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zapata.pm
new file mode 100644
index 0000000..e8fd733
--- /dev/null
+++ b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zapata.pm
@@ -0,0 +1,213 @@
+package Zaptel::Config::Gen::Zapata;
+use strict;
+
+use Zaptel::Config::Gen qw(is_true);
+
+sub new($$$) {
+ my $pack = shift || die;
+ my $gconfig = shift || die;
+ my $genopts = shift || die;
+ my $file = $ENV{ZAPATA_FILE} || "/etc/asterisk/zapata-channels.conf";
+ my $self = {
+ FILE => $file,
+ GCONFIG => $gconfig,
+ GENOPTS => $genopts,
+ };
+ bless $self, $pack;
+ return $self;
+}
+
+# Since zapata definitions "leak" to the next ones, we try
+# To reset some important definitions to their chan_zap defaults.
+my %chan_zap_defaults = (
+ context => 'default',
+ group => '63', # FIXME: should not be needed.
+ overlapdial => 'no',
+ busydetect => 'no',
+ rxgain => 0,
+ txgain => 0,
+);
+
+sub reset_zapata_values {
+ foreach my $arg (@_) {
+ if (exists $chan_zap_defaults{$arg}) {
+ print "$arg = $chan_zap_defaults{$arg}\n";
+ } else {
+ print "$arg =\n";
+ }
+ }
+}
+
+sub gen_digital($$) {
+ my $self = shift || die;
+ my $span = shift || die;
+ my $gconfig = $self->{GCONFIG};
+ my $num = $span->num() || die;
+ die "Span #$num is analog" unless $span->is_digital();
+ if($span->is_pri && $gconfig->{'pri_connection_type'} eq 'R2') {
+ printf "; Skipped: $gconfig->{'pri_connection_type'}\n\n";
+ return;
+ }
+ my $type = $span->type() || die "$0: Span #$num -- unkown type\n";
+ my $termtype = $span->termtype() || die "$0: Span #$num -- unkown termtype [NT/TE]\n";
+ my $group = $gconfig->{'group'}{"$type"};
+ my $context = $gconfig->{'context'}{"$type"};
+ my @to_reset = qw/context group/;
+
+ die "$0: missing default group (termtype=$termtype)\n" unless defined($group);
+ die "$0: missing default context\n" unless $context;
+
+ my $sig = $span->signalling || die "missing signalling info for span #$num type $type";
+ grep($gconfig->{'bri_sig_style'} eq $_, 'bri', 'bri_ptmp', 'pri') or die "unknown signalling style for BRI";
+ if($span->is_bri() and $gconfig->{'bri_sig_style'} eq 'bri_ptmp') {
+ $sig .= '_ptmp';
+ }
+ if ($span->is_bri() && $termtype eq 'NT' && is_true($gconfig->{'brint_overlap'})) {
+ print "overlapdial = yes\n";
+ push(@to_reset, qw/overlapdial/);
+ }
+
+ $group .= "," . (10 + $num); # Invent unique group per span
+ printf "group=$group\n";
+ printf "context=$context\n";
+ printf "switchtype = %s\n", $span->switchtype;
+ printf "signalling = %s\n", $sig;
+ printf "channel => %s\n", Zaptel::Config::Gen::bchan_range($span);
+ reset_zapata_values(@to_reset);
+}
+
+sub gen_channel($$) {
+ my $self = shift || die;
+ my $chan = shift || die;
+ my $gconfig = $self->{GCONFIG};
+ my $type = $chan->type;
+ my $num = $chan->num;
+ die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital();
+ my $exten = $gconfig->{'base_exten'} + $num;
+ my $sig = $gconfig->{'zapata_signalling'}{$type};
+ my $context = $gconfig->{'context'}{$type};
+ my $group = $gconfig->{'group'}{$type};
+ my $callerid;
+ my $immediate;
+
+ return if $type eq 'EMPTY';
+ die "missing default_zapata_signalling for chan #$num type $type" unless $sig;
+ $callerid = ($type eq 'FXO')
+ ? 'asreceived'
+ : sprintf "\"Channel %d\" <%04d>", $num, $exten;
+ if($type eq 'IN') {
+ $immediate = 'yes';
+ }
+ # FIXME: $immediage should not be set for 'OUT' channels, but meanwhile
+ # it's better to be compatible with genzaptelconf
+ $immediate = 'yes' if $gconfig->{'fxs_immediate'} eq 'yes' and $sig =~ /^fxo_/;
+ my $signalling = $chan->signalling;
+ $signalling = " " . $signalling if $signalling;
+ my $info = $chan->info;
+ $info = " " . $info if $info;
+ printf ";;; line=\"%d %s%s%s\"\n", $num, $chan->fqn, $signalling, $info;
+ printf "signalling=$sig\n";
+ printf "callerid=$callerid\n";
+ printf "mailbox=%04d\n", $exten unless $type eq 'FXO';
+ if(defined $group) {
+ printf "group=$group\n";
+ }
+ printf "context=$context\n";
+ printf "immediate=$immediate\n" if defined $immediate;
+ printf "channel => %d\n", $num;
+ # Reset following values to default
+ printf "callerid=\n";
+ printf "mailbox=\n" unless $type eq 'FXO';
+ if(defined $group) {
+ printf "group=\n";
+ }
+ printf "context=default\n";
+ printf "immediate=no\n" if defined $immediate;
+ print "\n";
+}
+
+sub generate($) {
+ my $self = shift || die;
+ my $file = $self->{FILE};
+ my $gconfig = $self->{GCONFIG};
+ my $genopts = $self->{GENOPTS};
+ #$gconfig->dump;
+ my @spans = @_;
+ warn "Empty configuration -- no spans\n" unless @spans;
+ rename "$file", "$file.bak"
+ or $! == 2 # ENOENT (No dependency on Errno.pm)
+ or die "Failed to backup old config: $!\n";
+ print "Generating $file\n" if $genopts->{verbose};
+ open(F, ">$file") || die "$0: Failed to open $file: $!\n";
+ my $old = select F;
+ printf "; Autogenerated by %s on %s -- do not hand edit\n", $0, scalar(localtime);
+ print <<"HEAD";
+; Zaptel Channels Configurations (zapata.conf)
+;
+; This is not intended to be a complete zapata.conf. Rather, it is intended
+; to be #include-d by /etc/zapata.conf that will include the global settings
+;
+
+HEAD
+ foreach my $span (@spans) {
+ printf "; Span %d: %s %s\n", $span->num, $span->name, $span->description;
+ if($span->is_digital()) {
+ $self->gen_digital($span);
+ } else {
+ foreach my $chan ($span->chans()) {
+ if(is_true($genopts->{'freepbx'}) || is_true($gconfig->{'freepbx'})) {
+ # Freepbx has its own idea about channels
+ my $type = $chan->type;
+ if($type eq 'FXS' || $type eq 'OUT' || $type eq 'IN') {
+ printf "; Skip channel=%s($type) -- freepbx option.\n",
+ $chan->num;
+ next;
+ }
+ }
+ $self->gen_channel($chan);
+ }
+ }
+ print "\n";
+ }
+ close F;
+ select $old;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+zapata - Generate configuration for zapata channels.
+
+=head1 SYNOPSIS
+
+ use Zaptel::Config::Gen::Zapata;
+
+ my $cfg = new Zaptel::Config::Gen::Zapata(\%global_config, \%genopts);
+ $cfg->generate(@span_list);
+
+=head1 DESCRIPTION
+
+Generate the F</etc/asterisk/zapata-channels.conf>
+This is used as a configuration for asterisk(1).
+It should be included in the main F</etc/asterisk/zapata.conf>.
+
+Its location may be overriden via the environment variable
+C<ZAPATA_FILE>.
+
+=head1 OPTIONS
+
+=over 4
+
+=item freepbx
+
+With this option we do not generate channel definitions for FXS, Input and
+Output ports. This is done because these channel definitions need to be
+generated and inserted into I<freepbx> database anyway.
+
+=back
+
+The I<freepbx> option may be activated also by adding a C<freepbx yes> line
+to the C<genconf_parameters> file.
diff --git a/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zaptel.pm b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zaptel.pm
new file mode 100644
index 0000000..2c30c33
--- /dev/null
+++ b/kernel/xpp/utils/zconf/Zaptel/Config/Gen/Zaptel.pm
@@ -0,0 +1,158 @@
+package Zaptel::Config::Gen::Zaptel;
+use strict;
+
+use Zaptel::Config::Gen qw(is_true);
+
+sub new($$$) {
+ my $pack = shift || die;
+ my $gconfig = shift || die;
+ my $genopts = shift || die;
+ my $file = $ENV{ZAPCONF_FILE} || "/etc/zaptel.conf";
+ my $self = {
+ FILE => $file,
+ GCONFIG => $gconfig,
+ GENOPTS => $genopts,
+ };
+ bless $self, $pack;
+ return $self;
+}
+
+my $bri_te_last_timing = 1;
+
+sub gen_digital($$) {
+ my $gconfig = shift || die;
+ my $span = shift || die;
+ my $num = $span->num() || die;
+ die "Span #$num is analog" unless $span->is_digital();
+ my $termtype = $span->termtype() || die "$0: Span #$num -- unkown termtype [NT/TE]\n";
+ my $timing;
+ my $lbo = 0;
+ my $framing = $span->framing() || die "$0: No framing information for span #$num\n";
+ my $coding = $span->coding() || die "$0: No coding information for span #$num\n";
+ my $span_crc4 = $span->crc4();
+ $span_crc4 = (defined $span_crc4) ? ",$span_crc4" : '';
+ my $span_yellow = $span->yellow();
+ $span_yellow = (defined $span_yellow) ? ",$span_yellow" : '';
+ # "MFC/R2 does not normally use CRC4"
+ # FIXME: a finer way to override:
+ if ($gconfig->{'pri_connection_type'} eq 'R2') {
+ $span_crc4 = '';
+ $framing = 'cas';
+ }
+ my $dchan_type = 'dchan';
+ if ($span->is_bri() && is_true($gconfig->{'bri_hardhdlc'})) {
+ $dchan_type = 'hardhdlc';
+ }
+
+ $timing = ($termtype eq 'NT') ? 0 : $bri_te_last_timing++;
+ printf "span=%d,%d,%d,%s,%s%s%s\n",
+ $num,
+ $timing,
+ $lbo,
+ $framing,
+ $coding,
+ $span_crc4,
+ $span_yellow;
+ printf "# termtype: %s\n", lc($termtype);
+ if ($gconfig->{'pri_connection_type'} eq 'PRI') {
+ printf "bchan=%s\n", Zaptel::Config::Gen::bchan_range($span);
+ my $dchan = $span->dchan();
+ printf "$dchan_type=%d\n", $dchan->num();
+ } elsif ($gconfig->{'pri_connection_type'} eq 'R2' ) {
+ my $idle_bits = $gconfig->{'r2_idle_bits'};
+ printf "cas=%s:$idle_bits\n", Zaptel::Config::Gen::bchan_range($span);
+ printf "dchan=%d\n", $span->dchan()->num();
+ }
+}
+
+sub gen_signalling($$) {
+ my $gconfig = shift || die;
+ my $chan = shift || die;
+ my $type = $chan->type;
+ my $num = $chan->num;
+
+ die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital();
+ if($type eq 'EMPTY') {
+ printf "# channel %d, %s, no module.\n", $num, $chan->fqn;
+ return;
+ }
+ my $signalling = $gconfig->{'zaptel_signalling'};
+ my $sig = $signalling->{$type} || die "unknown default zaptel signalling for chan $num type $type";
+ if ($type eq 'IN') {
+ printf "# astbanktype: input\n";
+ } elsif ($type eq 'OUT') {
+ printf "# astbanktype: output\n";
+ }
+ printf "$sig=$num\n";
+}
+
+sub generate($$$) {
+ my $self = shift || die;
+ my $file = $self->{FILE};
+ my $gconfig = $self->{GCONFIG};
+ my $genopts = $self->{GENOPTS};
+ my @spans = @_;
+ warn "Empty configuration -- no spans\n" unless @spans;
+ rename "$file", "$file.bak"
+ or $! == 2 # ENOENT (No dependency on Errno.pm)
+ or die "Failed to backup old config: $!\n";
+ #$gconfig->dump;
+ print "Generating $file\n" if $genopts->{verbose};
+ open(F, ">$file") || die "$0: Failed to open $file: $!\n";
+ my $old = select F;
+ printf "# Autogenerated by %s on %s -- do not hand edit\n", $0, scalar(localtime);
+ print <<"HEAD";
+# Zaptel Configuration File
+#
+# This file is parsed by the Zaptel Configurator, ztcfg
+#
+HEAD
+ foreach my $span (@spans) {
+ printf "# Span %d: %s %s\n", $span->num, $span->name, $span->description;
+ if($span->is_digital()) {
+ gen_digital($gconfig, $span);
+ } else {
+ foreach my $chan ($span->chans()) {
+ if(1 || !defined $chan->type) {
+ my $type = $chan->probe_type;
+ my $num = $chan->num;
+ die "Failed probing type for channel $num"
+ unless defined $type;
+ $chan->type($type);
+ }
+ gen_signalling($gconfig, $chan);
+ }
+ }
+ print "\n";
+ }
+ print <<"TAIL";
+# Global data
+
+loadzone = $gconfig->{'loadzone'}
+defaultzone = $gconfig->{'defaultzone'}
+TAIL
+ close F;
+ select $old;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+zaptel - Generate configuration for zaptel drivers.
+
+=head1 SYNOPSIS
+
+ use Zaptel::Config::Gen::Zaptel;
+
+ my $cfg = new Zaptel::Config::Gen::Zaptel(\%global_config, \%genopts);
+ $cfg->generate(@span_list);
+
+=head1 DESCRIPTION
+
+Generate the F</etc/zaptel.conf>.
+This is the configuration for ztcfg(1).
+
+Its location may be overriden via the environment variable F<ZAPCONF_FILE>.
diff --git a/kernel/xpp/utils/zconf/Zaptel/Config/Params.pm b/kernel/xpp/utils/zconf/Zaptel/Config/Params.pm
new file mode 100644
index 0000000..7f6ae80
--- /dev/null
+++ b/kernel/xpp/utils/zconf/Zaptel/Config/Params.pm
@@ -0,0 +1,149 @@
+package Zaptel::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
+
+Zaptel::Config::Params -- Object oriented representation of F<genconf_parameters> file.
+
+=head1 SYNOPSIS
+
+ use Zaptel::Config::Params;
+ my $params = Zaptel::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',
+ fxo_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;
+
diff --git a/kernel/xpp/utils/zconf/Zaptel/Hardware/PCI.pm b/kernel/xpp/utils/zconf/Zaptel/Hardware/PCI.pm
index c03b0d1..e9166c7 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Hardware/PCI.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Hardware/PCI.pm
@@ -84,10 +84,13 @@ my %pci_ids = (
'd161:8000' => { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE121' },
'd161:8001' => { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE122' },
+ # from wcb4xxp
+ 'd161:b410' => { DRIVER => 'wcb4xxp', DESCRIPTION => 'Digium Wildcard B410P' },
+
# from tor2
'10b5:9030' => { DRIVER => 'tor2', DESCRIPTION => 'PLX 9030' },
'10b5:3001' => { DRIVER => 'tor2', DESCRIPTION => 'PLX Development Board' },
- '10b5:D00D' => { DRIVER => 'tor2', DESCRIPTION => 'Tormenta 2 Quad T1/PRI or E1/PRA' },
+ '10b5:d00d' => { DRIVER => 'tor2', DESCRIPTION => 'Tormenta 2 Quad T1/PRI or E1/PRA' },
'10b5:4000' => { DRIVER => 'tor2', DESCRIPTION => 'Tormenta 2 Quad T1/E1 (non-Digium clone)' },
# Cologne Chips:
@@ -97,6 +100,8 @@ my %pci_ids = (
'1397:16b8' => { DRIVER => 'qozap', DESCRIPTION => 'Junghanns OctoBRI ISDN card' },
'1397:30b1' => { DRIVER => 'cwain', DESCRIPTION => 'HFC-E1 ISDN E1 card' },
'1397:2bd0' => { DRIVER => 'zaphfc', DESCRIPTION => 'HFC-S ISDN BRI card' },
+ # Has three submodels. Tested with 0675:1704:
+ '1043:0675' => { DRIVER => 'zaphfc', DESCRIPTION => 'ASUSTeK Computer Inc. ISDNLink P-IN100-ST-D' },
'1397:f001' => { DRIVER => 'ztgsm', DESCRIPTION => 'HFC-GSM Cologne Chips GSM' },
# Rhino cards (based on pci.ids)
diff --git a/kernel/xpp/utils/zconf/Zaptel/Span.pm b/kernel/xpp/utils/zconf/Zaptel/Span.pm
index be49c28..c771a26 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Span.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Span.pm
@@ -133,12 +133,13 @@ my @bri_strings = (
'BRI_(NT|TE)',
'(?:quad|octo)BRI PCI ISDN Card.* \[(NT|TE)\]\ ',
'octoBRI \[(NT|TE)\] ',
- 'HFC-S PCI A ISDN.* \[(NT|TE)\] '
+ 'HFC-S PCI A ISDN.* \[(NT|TE)\] ',
+ '(B4XXP) \(PCI\) Card', # Does not expose NT/TE type
);
my @pri_strings = (
- '(E1|T1|J1)_(NT|TE)',
'Tormenta 2 .*Quad (E1|T1)', # tor2.
+ 'Xorcom XPD.*: (E1|T1)', # Astribank PRI
'Digium Wildcard .100P (T1|E1)/', # wct1xxp
'ISA Tormenta Span 1', # torisa
'TE110P T1/E1', # wcte11xp
@@ -189,10 +190,12 @@ sub new($$) {
$self->{IS_PRI} = 0;
foreach my $cardtype (@bri_strings) {
if($head =~ m/$cardtype/) {
+ my $termtype = $1;
+ $termtype = 'TE' if ( $1 eq 'B4XXP' );
$self->{IS_DIGITAL} = 1;
$self->{IS_BRI} = 1;
- $self->{TERMTYPE} = $1;
- $self->{TYPE} = "BRI_$1";
+ $self->{TERMTYPE} = $termtype;
+ $self->{TYPE} = "BRI_$termtype";
$self->{DCHAN_IDX} = 2;
$self->{BCHAN_LIST} = [ 0, 1 ];
last;
@@ -207,7 +210,7 @@ sub new($$) {
my ($proto) = grep(/(E1|T1|J1)/, @info);
$proto = 'UNKNOWN' unless defined $proto;
my ($termtype) = grep(/(NT|TE)/, @info);
- $termtype = 'TE' unless defined $termtype;
+ $termtype = 'UNKNOWN' unless defined $termtype;
$self->{IS_DIGITAL} = 1;
$self->{IS_PRI} = 1;
@@ -216,8 +219,6 @@ sub new($$) {
last;
}
}
- die "$0: Unkown TERMTYPE [NT/TE]\n"
- if $self->is_digital and !defined $self->{TERMTYPE};
($self->{NAME}, $self->{DESCRIPTION}) = (split(/\s+/, $head, 4))[2, 3];
$self->{IS_ZAPTEL_SYNC_MASTER} =
($self->{DESCRIPTION} =~ /\(MASTER\)/) ? 1 : 0;
@@ -262,7 +263,7 @@ sub new($$) {
# Infer some info from channel name:
my $first_chan = ($self->chans())[0] || die "$0: No channels in span #$num\n";
my $chan_fqn = $first_chan->fqn();
- if($chan_fqn =~ m(ZTHFC.*/|ztqoz.*/|XPP_BRI_.*/)) { # BRI
+ if($chan_fqn =~ m(ZTHFC.*/|ztqoz.*/|XPP_BRI_.*|B4/.*)) { # BRI
$self->{FRAMING} = 'ccs';
$self->{SWITCHTYPE} = 'euroisdn';
$self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $ZAPBRI_NET : $ZAPBRI_CPE ;
@@ -286,7 +287,6 @@ sub new($$) {
} else {
die "'$self->{PROTO}' unsupported yet";
}
- $self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $ZAPPRI_NET : $ZAPPRI_CPE ;
}
return $self;
}
@@ -297,4 +297,57 @@ sub bchans($) {
return @{$self->{BCHANS}};
}
+sub set_termtype($$) {
+ my $span = shift || die;
+ my $termtype = shift || die;
+ $span->{TERMTYPE} = $termtype;
+ $span->{SIGNALLING} = ($termtype eq 'NT') ? $ZAPPRI_NET : $ZAPPRI_CPE ;
+ $span->{TYPE} = $span->proto . "_$termtype";
+}
+
+sub pri_set_fromconfig($$) {
+ my $span = shift || die;
+ my $genconf = shift || die;
+ my $name = $span->name;
+# if(defined $termtype) {
+# die "Termtype for $name already defined as $termtype\n";
+# }
+ my $pri_termtype = $genconf->{pri_termtype};
+ my @pri_specs;
+ if(defined $pri_termtype) {
+ @pri_specs = @{$pri_termtype};
+ }
+ push(@pri_specs , 'SPAN/* TE'); # Default
+ my @patlist = ( "SPAN/" . $span->num );
+ my ($xbus_name, $xpd_name) = ($name =~ m|(XBUS-\d+)/(XPD-\d+)|);
+ if(defined $xbus_name) {
+ push(@patlist, "NUM/$xbus_name/$xpd_name");
+# push(@patlist, "CONNECTOR/$ENV{XBUS_CONNECTOR}/$xpd_name");
+ }
+ #print STDERR "PATLIST=@patlist\n";
+ my $match_termtype;
+SPEC:
+ for(my $i = 0; $i < @pri_specs; $i++) {
+ my $spec = $pri_specs[$i];
+ #print STDERR "spec: $spec\n";
+ my ($match, $termtype) = split(/\s+/, $spec);
+ next unless defined $match and defined $termtype;
+ # Convert "globs" to regex
+ $match =~ s/\*/.*/g;
+ $match =~ s/\?/./g;
+ #print STDERR "match: $match\n";
+ foreach my $pattern (@patlist) {
+ #print STDERR "testmatch: $pattern =~ $match\n";
+ if($pattern =~ $match) {
+ #print STDERR "$xpd_name: MATCH '$pattern' ~ '$match' termtype=$termtype\n";
+ $match_termtype = $termtype;
+ last SPEC;
+ }
+ }
+ }
+ die "Unknown pri_termtype" unless defined $match_termtype;
+ $span->set_termtype($match_termtype);
+}
+
+
1;
diff --git a/kernel/xpp/utils/zconf/Zaptel/Xpp.pm b/kernel/xpp/utils/zconf/Zaptel/Xpp.pm
index 8b7458f..b626bfa 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Xpp.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Xpp.pm
@@ -30,6 +30,9 @@ Zaptel::Xpp - Perl interface to the Xorcom Astribank drivers.
my $proc_base = "/proc/xpp";
+our $sysfs_astribanks = "/sys/bus/astribanks/devices";
+our $sysfs_xpds = "/sys/bus/xpds/devices";
+our $sysfs_ab_driver = "/sys/bus/astribanks/drivers/xppdrv";
# Nominal sorters for xbuses
sub by_name {
@@ -46,12 +49,46 @@ sub by_label {
return $a->connector cmp $b->connector;
}
+sub score_type {
+ my $score;
+
+ return 1 if grep(/\b[ETJ]1/, @_);
+ return 2 if grep(/\bBRI/, @_);
+ return 3 if grep(/\bFXO/, @_);
+ return 4; # FXS
+}
+
+sub by_type {
+ my @a_types = map { $_->type } $a->xpds();
+ my @b_types = map { $_->type } $b->xpds();
+ my $res;
+
+ my $a_score = score_type(@a_types);
+ my $b_score = score_type(@b_types);
+ #printf STDERR "DEBUG-a: %s %s %s\n", $a->name, $a_score, join(',',@a_types);
+ #printf STDERR "DEBUG-b: %s %s %s\n", $b->name, $b_score, join(',',@b_types);
+ $res = $a_score <=> $b_score;
+ $res = $a->connector cmp $b->connector if $res == 0;
+ return $res;
+}
+
+
=head1 xbuses([sort_order])
Scans system (/proc and /sys) and returns a list of Astribank (Xbus)
objects. The optional parameter sort_order is the order in which
the Astribanks will be returns:
+
+=head1 sorters([sort_order])
+
+With no parameters, returns the names of built in sorters.
+With a single parameter, returns a reference to the requested built in sorter.
+Also, for convenience, a reference to a custom sorter function may be passed
+and returned as is.
+
+The built in sorters are:
+
=over
=item SORT_CONNECTOR
@@ -63,13 +100,20 @@ the device through controllers, hubs etc.
Sorts by the label of the Astribank. The label field is unique to the
Astribank. It can also be viewed through 'lsusb -v' without the drivers
-loaded (the iSerial field in the Device Descriptor).
+loaded (the iSerial field in the Device Descriptor). This is normally
+relieble, but some older Astribanks have an empty label.
=item SORT_NAME
Sort by the "name". e.g: "XBUS-00". The order of Astribank names depends
on the load order, and hence may change between different runs.
+=item SORT_TYPE
+
+Sort by XPD types. First Astribanks with E1/T1/J1 XPDs, then with BRI,
+then with FXO, then ones with only FXS ports. Within each type they
+are sorted by the connector field (as in SORT_CONNECTOR above).
+
=item custom function
Instead of using a predefined sorter, you can pass your own sorting
@@ -79,39 +123,36 @@ function. See the example sorters in the code of this module.
=cut
+sub sorters {
+ my %sorter_table = (
+ SORT_CONNECTOR => \&by_connector,
+ SORT_NAME => \&by_name,
+ SORT_LABEL => \&by_label,
+ SORT_TYPE => \&by_type,
+ # Aliases
+ connector => \&by_connector,
+ name => \&by_name,
+ label => \&by_label,
+ type => \&by_type,
+ );
+ my $which_sorter = shift || return sort keys %sorter_table;
+ return $which_sorter if ref($which_sorter) eq 'CODE';
+ return $sorter_table{$which_sorter};
+}
+
sub xbuses {
my $optsort = shift || 'SORT_CONNECTOR';
my @xbuses;
- -d "$proc_base" or return ();
- my @lines;
- local $/ = "\n";
- open(F, "$proc_base/xbuses") ||
- die "$0: Failed to open $proc_base/xbuses: $!\n";
- @lines = <F>;
- close F;
- foreach my $line (@lines) {
- chomp $line;
- my ($name, @attr) = split(/\s+/, $line);
- $name =~ s/://;
- $name =~ /XBUS-(\d\d)/ or die "Bad XBUS number: $name";
- my $num = $1;
- @attr = map { split(/=/); } @attr;
- my $xbus = Zaptel::Xpp::Xbus->new(NAME => $name, NUM => $num, @attr);
+ opendir(D, $sysfs_astribanks) || return();
+ while(my $entry = readdir D) {
+ next unless $entry =~ /xbus-(\d+)/;
+ my $xbus = Zaptel::Xpp::Xbus->new($1);
push(@xbuses, $xbus);
}
- my $sorter;
- if($optsort eq "SORT_CONNECTOR") {
- $sorter = \&by_connector;
- } elsif($optsort eq "SORT_NAME") {
- $sorter = \&by_name;
- } elsif($optsort eq "SORT_LABEL") {
- $sorter = \&by_label;
- } elsif(ref($optsort) eq 'CODE') {
- $sorter = $optsort;
- } else {
- die "Unknown optional sorter '$optsort'";
- }
+ closedir D;
+ my $sorter = sorters($optsort);
+ die "Unknown optional sorter '$optsort'" unless defined $sorter;
@xbuses = sort $sorter @xbuses;
return @xbuses;
}
@@ -137,7 +178,7 @@ For more information read that file and see README.Astribank .
=cut
-sub sync {
+sub sync_via_proc {
my $newsync = shift;
my $result;
my $newapi = 0;
@@ -171,6 +212,32 @@ sub sync {
return $result;
}
+sub sync {
+ my ($newsync) = @_;
+ my $result;
+ my $file = "$sysfs_ab_driver/sync";
+ if(! -f $file) { # Old /proc interface
+ return sync_via_proc(@_);
+ }
+ open(F, "$file") or die "Failed to open $file for reading: $!";
+ $result = <F>;
+ close F;
+ chomp $result;
+ $result =~ s/^SYNC=\D*//;
+ if(defined $newsync) { # Now change
+ $newsync =~ s/.*/\U$&/;
+ if($newsync =~ /^(\d+)$/) {
+ $newsync = "SYNC=$1";
+ } elsif($newsync ne 'ZAPTEL') {
+ die "Bad sync parameter '$newsync'";
+ }
+ open(F, ">$file") or die "Failed to open $file for writing: $!";
+ print F $newsync;
+ close(F) or die "Failed in closing $file: $!";
+ }
+ return $result;
+}
+
=head1 SEE ALSO
=over
diff --git a/kernel/xpp/utils/zconf/Zaptel/Xpp/Line.pm b/kernel/xpp/utils/zconf/Zaptel/Xpp/Line.pm
index 2472c3b..895e4f2 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Xpp/Line.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Xpp/Line.pm
@@ -10,8 +10,6 @@ package Zaptel::Xpp::Line;
use strict;
use Zaptel::Utils;
-my $proc_base = "/proc/xpp";
-
sub new($$$) {
my $pack = shift or die "Wasn't called as a class method\n";
my $xpd = shift or die;
@@ -28,30 +26,15 @@ sub blink($$) {
my $self = shift;
my $on = shift;
my $xpd = $self->xpd;
- my $result;
-
- my $file = "$proc_base/" . $xpd->fqn . "/blink";
- die "$file is missing" unless -f $file;
- # First query
- open(F, "$file") or die "Failed to open $file for reading: $!";
- $result = <F>;
- chomp $result;
- close F;
+ my $result = $xpd->xpd_getattr("blink");
+ $result = hex($result);
if(defined($on)) { # Now change
my $onbitmask = 1 << $self->index;
my $offbitmask = $result & ~$onbitmask;
$result = $offbitmask;
$result |= $onbitmask if $on;
- open(F, ">$file") or die "Failed to open $file for writing: $!";
- print F "$result";
- if(!close(F)) {
- if($! == 17) { # EEXISTS
- # good
- } else {
- undef $result;
- }
- }
+ $result = $xpd->xpd_setattr("blink", $result);
}
return $result;
}
@@ -67,25 +50,36 @@ sub create_all($$) {
push(@lines, $line);
}
$xpd->{LINES} = \@lines;
- my ($infofile) = glob "$procdir/*_info";
- die "Failed globbing '$procdir/*_info'" unless defined $infofile;
- my $type = $xpd->type;
- open(F, "$infofile") || die "Failed opening '$infofile': $!";
- my $battery_info = 0;
- while (<F>) {
- chomp;
- if($type eq 'FXO') {
- $battery_info = 1 if /^Battery:/;
- if($battery_info && s/^\s*on\s*:\s*//) {
- my @batt = split;
- foreach my $l (@lines) {
- die unless @batt;
- my $state = shift @batt;
- $l->{BATTERY} = ($state eq '+') ? 1 : 0;
+ if($xpd->type eq 'FXO') {
+ my $battery = $xpd->xpd_getattr("fxo_battery");
+ if(defined $battery) {
+ my @batt = split(/\s+/, $battery);
+ foreach my $l (@lines) {
+ die unless @batt;
+ my $state = shift @batt;
+ $l->{BATTERY} = ($state eq '+') ? 1 : 0;
+ }
+ } else {
+ # Fallback to old interface
+ my ($infofile) = glob "$procdir/*_info";
+ die "Failed globbing '$procdir/*_info'" unless defined $infofile;
+ open(F, "$infofile") || die "Failed opening '$infofile': $!";
+ my $battery_info = 0;
+ while (<F>) {
+ chomp;
+ $battery_info = 1 if /^Battery:/;
+ if($battery_info && s/^\s*on\s*:\s*//) {
+ my @batt = split;
+ foreach my $l (@lines) {
+ die unless @batt;
+ my $state = shift @batt;
+ $l->{BATTERY} = ($state eq '+') ? 1 : 0;
+ }
+ $battery_info = 0;
+ die if @batt;
}
- $battery_info = 0;
- die if @batt;
}
+ close F;
}
}
close F;
diff --git a/kernel/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm b/kernel/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
index e840f14..f87e2aa 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
@@ -40,49 +40,135 @@ sub get_xpd_by_number($$) {
my $xbus = shift;
my $xpdid = shift;
die "Missing XPD id parameter" unless defined $xpdid;
+ $xpdid = sprintf("%02d", $xpdid);
my @xpds = $xbus->xpds;
my ($wanted) = grep { $_->id eq $xpdid } @xpds;
return $wanted;
}
+my %file_warned; # Prevent duplicate warnings about same file.
+
+sub xbus_attr_path($$) {
+ my ($busnum, @attr) = @_;
+ foreach my $attr (@attr) {
+ my $file = sprintf "$Zaptel::Xpp::sysfs_astribanks/xbus-%02d/$attr", $busnum;
+ unless(-f $file) {
+ my $procfile = sprintf "/proc/xpp/XBUS-%02d/$attr", $busnum;
+ warn "$0: warning - OLD DRIVER: missing '$file'. Fall back to '$procfile'\n"
+ unless $file_warned{$attr}++;
+ $file = $procfile;
+ }
+ next unless -f $file;
+ return $file;
+ }
+ return undef;
+}
+
+sub xbus_getattr($$) {
+ my $xbus = shift || die;
+ my $attr = shift || die;
+ $attr = lc($attr);
+ my $file = xbus_attr_path($xbus->num, lc($attr));
+
+ open(F, $file) || die "Failed opening '$file': $!";
+ my $val = <F>;
+ close F;
+ chomp $val;
+ return $val;
+}
+
+sub read_attrs() {
+ my $xbus = shift || die;
+ my @attrnames = qw(CONNECTOR LABEL STATUS);
+ my @attrs;
+
+ foreach my $attr (@attrnames) {
+ my $val = xbus_getattr($xbus, $attr);
+ if($attr eq 'STATUS') {
+ # Some values are in all caps as well
+ $val = uc($val);
+ } elsif($attr eq 'LABEL') {
+ # Fix badly burned labels.
+ $val =~ s/[[:^print:]]/_/g;
+ }
+ $xbus->{$attr} = $val;
+ }
+}
+
+sub read_xpdnames_old($) {
+ my $xbus_num = shift || die;
+ my $pat = sprintf "/proc/xpp/XBUS-%02d/XPD-[0-9][0-9]", $xbus_num;
+ my @xpdnames;
+
+ #print STDERR "read_xpdnames_old($xbus_num): $pat\n";
+ foreach (glob $pat) {
+ die "Bad /proc entry: '$_'" unless /^.*XPD-([0-9])([0-9])$/;
+ my $name = sprintf("%02d:%1d:%1d", $xbus_num, $1, $2);
+ #print STDERR "\t> $_ ($name)\n";
+ push(@xpdnames, $name);
+ }
+ return @xpdnames;
+}
+
+sub read_xpdnames($) {
+ my $xbus_num = shift || die;
+ my $xbus_dir = "$Zaptel::Xpp::sysfs_astribanks/xbus-$xbus_num";
+ my $pat = sprintf "%s/xbus-%02d/[0-9][0-9]:[0-9]:[0-9]", $Zaptel::Xpp::sysfs_astribanks, $xbus_num;
+ my @xpdnames;
+
+ #print STDERR "read_xpdnames($xbus_num): $pat\n";
+ foreach (glob $pat) {
+ die "Bad /sys entry: '$_'" unless m/^.*\/([0-9][0-9]):([0-9]):([0-9])$/;
+ my ($busnum, $unit, $subunit) = ($1, $2, $3);
+ my $name = sprintf("%02d:%1d:%1d", $1, $2, $3);
+ #print STDERR "\t> $_ ($name)\n";
+ push(@xpdnames, $name);
+ }
+ return @xpdnames;
+}
+
+my $warned_notransport = 0;
+
sub new($$) {
my $pack = shift or die "Wasn't called as a class method\n";
- my $self = {};
+ my $num = shift;
+ my $xbus_dir = "$Zaptel::Xpp::sysfs_astribanks/xbus-$num";
+ my $self = {
+ NUM => $num,
+ NAME => "XBUS-$num",
+ SYSFS_DIR => $xbus_dir,
+ };
bless $self, $pack;
- while(@_) {
- my ($k, $v) = @_;
- shift; shift;
- # Keys in all caps
- $k = uc($k);
- # Some values are in all caps as well
- if($k =~ /^(STATUS)$/) {
- $v = uc($v);
+ $self->read_attrs;
+ # Get transport related info
+ my $transport = "$xbus_dir/transport";
+ my ($usbdev) = glob("$transport/usb_device:*");
+ if(defined $usbdev) { # It's USB
+ if($usbdev =~ /.*usb_device:usbdev(\d+)\.(\d+)/) {
+ my $busnum = $1;
+ my $devnum = $2;
+ #printf STDERR "DEBUG: %03d/%03d\n", $busnum, $devnum;
+ $self->{USB_DEVNAME} = sprintf("%03d/%03d", $busnum, $devnum);
+ } else {
+ warn "Bad USB transport='$transport' usbdev='$usbdev'\n";
}
- $self->{$k} = $v;
- }
- # backward compat for drivers without labels.
- if(!defined $self->{LABEL}) {
- $self->{LABEL} = '[]';
}
- $self->{LABEL} =~ s/^\[(.*)\]$/$1/ or die "$self->{NAME}: Bad label";
- # Fix badly burned labels.
- $self->{LABEL} =~ s/[[:^print:]]/_/g;
- $self->{NAME} or die "Missing xbus name";
- my $prefix = "$proc_base/" . $self->{NAME};
- my $usbfile = "$prefix/xpp_usb";
- if(open(F, "$usbfile")) {
- my $head = <F>;
- chomp $head;
- close F;
- $head =~ s/^device: +([^, ]+)/$1/i or die;
- $self->{USB_DEVNAME} = $head;
+ my @xpdnames;
+ my @xpds;
+ if(-e $transport) {
+ @xpdnames = read_xpdnames($num);
+ } else {
+ @xpdnames = read_xpdnames_old($num);
+ warn "$0: warning - OLD DRIVER: missing '$transport'. Fall back to /proc\n"
+ unless $warned_notransport++;
}
- @{$self->{XPDS}} = ();
- foreach my $dir (glob "$prefix/XPD-??") {
- my $xpd = Zaptel::Xpp::Xpd->new($self, $dir);
- push(@{$self->{XPDS}}, $xpd);
+ foreach my $xpdstr (@xpdnames) {
+ my ($busnum, $unit, $subunit) = split(/:/, $xpdstr);
+ my $procdir = "/proc/xpp/XBUS-$busnum/XPD-$unit$subunit";
+ my $xpd = Zaptel::Xpp::Xpd->new($self, $unit, $subunit, $procdir, "$xbus_dir/$xpdstr");
+ push(@xpds, $xpd);
}
- @{$self->{XPDS}} = sort { $a->id <=> $b->id } @{$self->{XPDS}};
+ @{$self->{XPDS}} = sort { $a->id <=> $b->id } @xpds;
return $self;
}
diff --git a/kernel/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm b/kernel/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
index 1ddb5c8..30a0bad 100644
--- a/kernel/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
+++ b/kernel/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
@@ -12,31 +12,127 @@ use Zaptel::Utils;
use Zaptel::Xpp;
use Zaptel::Xpp::Line;
-my $proc_base = "/proc/xpp";
+my %file_warned; # Prevent duplicate warnings about same file.
-sub blink($$) {
- my $self = shift;
- my $on = shift;
- my $result;
+sub xpd_attr_path($@) {
+ my $self = shift || die;
+ my ($busnum, $unitnum, $subunitnum, @attr) = (
+ $self->xbus->num,
+ $self->unit,
+ $self->subunit,
+ @_);
+ foreach my $attr (@attr) {
+ my $file = sprintf "$Zaptel::Xpp::sysfs_xpds/%02d:%1d:%1d/$attr",
+ $busnum, $unitnum, $subunitnum;
+ unless(-f $file) {
+ my $procfile = sprintf "/proc/xpp/XBUS-%02d/XPD-%1d%1d/$attr",
+ $busnum, $unitnum, $subunitnum;
+ warn "$0: warning - OLD DRIVER: missing '$file'. Fall back to /proc\n"
+ unless $file_warned{$attr}++;
+ $file = $procfile;
+ }
+ next unless -f $file;
+ return $file;
+ }
+ return undef;
+}
- my $file = "$proc_base/" . $self->fqn . "/blink";
- die "$file is missing" unless -f $file;
- # First query
- open(F, "$file") or die "Failed to open $file for reading: $!";
- $result = <F>;
- chomp $result;
+# Backward compat plug for old /proc interface...
+sub xpd_old_gettype($) {
+ my $xpd = shift || die;
+ my $summary = "/proc/xpp/" . $xpd->fqn . "/summary";
+ open(F, $summary) or die "Failed to open '$summary': $!";
+ my $head = <F>;
close F;
- if(defined($on) and $on ne $result) { # Now change
- open(F, ">$file") or die "Failed to open $file for writing: $!";
- print F ($on)?"0xFFFF":"0";
- if(!close(F)) {
- if($! == 17) { # EEXISTS
- # good
- } else {
- undef $result;
- }
+ chomp $head;
+ $head =~ s/^XPD-\d+\s+\(//;
+ $head =~ s/,.*//;
+ return $head;
+}
+
+sub xpd_old_getspan($) {
+ my $xpd = shift || die;
+ my $zt_registration = "/proc/xpp/" . $xpd->fqn . "/zt_registration";
+ open(F, $zt_registration) or die "Failed to open '$zt_registration': $!";
+ my $head = <F>;
+ close F;
+ chomp $head;
+ return $head;
+}
+
+sub xpd_old_getoffhook($) {
+ my $xpd = shift || die;
+ my $summary = "/proc/xpp/" . $xpd->fqn . "/summary";
+ my $channels;
+
+ local $/ = "\n";
+ open(F, "$summary") || die "Failed opening $summary: $!\n";
+ my $head = <F>;
+ chomp $head; # "XPD-00 (BRI_TE ,card present, span 3)"
+ my $offhook;
+ while(<F>) {
+ chomp;
+ if(s/^\s*offhook\s*:\s*//) {
+ s/\s*$//;
+ $offhook = $_;
+ $offhook || die "No channels in '$summary'";
+ last;
}
}
+ close F;
+ return $offhook;
+}
+
+my %attr_missing_warned; # Prevent duplicate warnings
+
+sub xpd_getattr($$) {
+ my $xpd = shift || die;
+ my $attr = shift || die;
+ $attr = lc($attr);
+ my $file = $xpd->xpd_attr_path(lc($attr));
+
+ # Handle special cases for backward compat
+ return xpd_old_gettype($xpd) if $attr eq 'type' and !defined $file;
+ return xpd_old_getspan($xpd) if $attr eq 'span' and !defined $file;
+ return xpd_old_getoffhook($xpd) if $attr eq 'offhook' and !defined $file;
+ if(!defined($file)) {
+ warn "$0: xpd_getattr($attr) -- Missing attribute.\n" if
+ $attr_missing_warned{$attr};
+ return undef;
+ }
+ open(F, $file) || return undef;
+ my $val = <F>;
+ close F;
+ chomp $val;
+ return $val;
+}
+
+sub xpd_setattr($$$) {
+ my $xpd = shift || die;
+ my $attr = shift || die;
+ my $val = shift;
+ $attr = lc($attr);
+ my $file = xpd_attr_path($xpd, $attr);
+ my $oldval = $xpd->xpd_getattr($attr);
+ open(F, ">$file") or die "Failed to open $file for writing: $!";
+ print F "$val";
+ if(!close(F)) {
+ if($! == 17) { # EEXISTS
+ # good
+ } else {
+ return undef;
+ }
+ }
+ return $oldval;
+}
+
+sub blink($$) {
+ my $self = shift;
+ my $on = shift;
+ my $result = $self->xpd_getattr("blink");
+ if(defined($on)) { # Now change
+ $self->xpd_setattr("blink", ($on)?"0xFFFF":"0");
+ }
return $result;
}
@@ -44,8 +140,7 @@ sub zt_registration($$) {
my $self = shift;
my $on = shift;
my $result;
-
- my $file = "$proc_base/" . $self->fqn . "/zt_registration";
+ my $file = $self->xpd_attr_path("span", "zt_registration");
die "$file is missing" unless -f $file;
# First query
open(F, "$file") or die "Failed to open $file for reading: $!";
@@ -77,47 +172,86 @@ sub xpds_by_spanno() {
return @idx;
}
-sub new($$) {
+sub new($$$$$) {
my $pack = shift or die "Wasn't called as a class method\n";
my $xbus = shift || die;
+ my $unit = shift; # May be zero
+ my $subunit = shift; # May be zero
my $procdir = shift || die;
- my $self = {};
+ my $sysfsdir = shift || die;
+ my $self = {
+ XBUS => $xbus,
+ ID => "$unit$subunit",
+ FQN => $xbus->name . "/" . "XPD-$unit$subunit",
+ UNIT => $unit,
+ SUBUNIT => $subunit,
+ DIR => $procdir,
+ SYSFS_DIR => $sysfsdir,
+ };
bless $self, $pack;
- $self->{XBUS} = $xbus;
- $self->{DIR} = $procdir;
- local $/ = "\n";
- open(F, "$procdir/summary") || die "Missing summary file in $procdir";
- my $head = <F>;
- chomp $head; # "XPD-00 (BRI_TE ,card present, span 3)"
- # The driver does not export the number of channels...
- # Let's find it indirectly
- while(<F>) {
- chomp;
- if(s/^\s*offhook\s*:\s*//) {
- my @offhook = split;
- @offhook || die "No channels in '$procdir/summary'";
- $self->{CHANNELS} = @offhook;
- last;
- }
- }
- close F;
- $head =~ s/^(XPD-(\d\d))\s+// || die;
- $self->{ID} = $2;
- $self->{FQN} = $xbus->name . "/" . $1;
- $head =~ s/^.*\(// || die;
- $head =~ s/\) */, / || die;
- $head =~ s/\s*,\s*/,/g || die;
- my ($type,$present,$span,$rest) = split(/,/, $head);
- #warn "Garbage in '$procdir/summary': rest='$rest'\n" if $rest;
- if($span =~ s/span\s+(\d+)//) { # since changeset:5119
- $self->{SPANNO} = $1;
- }
+ my @offhook = split / /, ($self->xpd_getattr('offhook'));
+ $self->{CHANNELS} = @offhook;
+ my $type = $self->xpd_getattr('type');
+ my $span = $self->xpd_getattr('span');
+ $self->{SPANNO} = $span;
$self->{TYPE} = $type;
- $self->{IS_BRI} = ($type =~ /BRI_(NT|TE)/);
- $self->{IS_PRI} = ($type =~ /[ETJ]1_(NT|TE)/);
+ if($type =~ /BRI_(NT|TE)/) {
+ $self->{IS_BRI} = 1;
+ $self->{TERMTYPE} = $1;
+ }
+ $self->{IS_PRI} = ($type =~ /[ETJ]1/);
$self->{IS_DIGITAL} = ( $self->{IS_BRI} || $self->{IS_PRI} );
Zaptel::Xpp::Line->create_all($self, $procdir);
return $self;
}
+#------------------------------------
+# static xpd related helper functions
+#------------------------------------
+
+sub sync_priority_rank($) {
+ my $xpd = shift || die;
+ # The @rank array is ordered by priority of sync (good to bad)
+ my @rank = (
+ ($xpd->is_pri and defined($xpd->termtype) and $xpd->termtype eq 'TE'),
+ ($xpd->is_bri and defined($xpd->termtype) and $xpd->termtype eq 'TE'),
+ ($xpd->is_pri),
+ ($xpd->type eq 'FXO'),
+ ($xpd->is_bri),
+ ($xpd->type eq 'FXS'),
+ );
+ for(my $i = 0; $i < @rank; $i++) {
+ return $i if $rank[$i];
+ }
+ return @rank + 1;
+}
+
+# An XPD sync priority comparator for sort()
+sub sync_priority_compare() {
+ my $rank_a = sync_priority_rank($a);
+ my $rank_b = sync_priority_rank($b);
+ #print STDERR "DEBUG: $rank_a (", $a->fqn, ") $rank_b (", $b->fqn, ")\n";
+ return $a->fqn cmp $b->fqn if $rank_a == $rank_b;
+ return $rank_a <=> $rank_b;
+}
+
+# For debugging: show a list of XPD's with relevant sync info.
+sub show_xpd_rank(@) {
+ print STDERR "XPD's by rank\n";
+ foreach my $xpd (@_) {
+ my $type = $xpd->type;
+ my $rank = sync_priority_rank($xpd);
+ if($xpd->is_digital) {
+ $type .= " (TERMTYPE " . ($xpd->termtype || "UNKNOWN") . ")";
+ }
+ printf STDERR "%3d %-15s %s\n", $rank, $xpd->fqn, $type;
+ }
+}
+
+sub xpds_by_rank(@) {
+ my @xpd_prio = sort sync_priority_compare @_;
+ #show_xpd_rank(@xpd_prio);
+ return @xpd_prio;
+}
+
1;