xpp: twinstar-related perl improvements

 * New generator Dahdi::Config::Gen::Xpporder can generate
   and xpp_order config for an existing setup.
 * Add more TwinStar related logic to Dahdi::Xpp::Mpp. Simplifies
   the twinstar utility accordingly.
 * twinstar_hook: for the multiple Astribanks case.
 * twinstar_setup: More logic tests. Now delegates configuration
   generation to dahdi_genconf (with new Xpporder generator).
 * dahdi_hardware: Show number of channels with -v



git-svn-id: http://svn.asterisk.org/svn/dahdi/tools/trunk@6417 a0bf4364-ded3-4de4-8d8a-66a801d63aff

3 files changed, 187 insertions, 7 deletions

diff --git a/xpp/perl_modules/Dahdi/Config/Gen/Xpporder.pm b/xpp/perl_modules/Dahdi/Config/Gen/Xpporder.pm
new file mode 100644
index 0000000..2b5166a
--- /dev/null
+++ b/xpp/perl_modules/Dahdi/Config/Gen/Xpporder.pm
@@ -0,0 +1,141 @@
+package Dahdi::Config::Gen::Xpporder;
+use strict;
+
+use Dahdi::Config::Gen qw(is_true);
+
+sub new($$$) {
+	my $pack = shift || die;
+	my $gconfig = shift || die;
+	my $genopts = shift || die;
+	my $file = $ENV{XPPORDER_CONF} || "/etc/dahdi/xpp_order";
+	my $self = {
+			FILE	=> $file,
+			GCONFIG	=> $gconfig,
+			GENOPTS	=> $genopts,
+		};
+	bless $self, $pack;
+	return $self;
+}
+
+#
+# Returns list of xbuses sorted by the span numbers assigned
+# to their XPD's. Also checks that each XBUS span numbers are sequential.
+sub get_sorted_xbuses(@) {
+	my @spans = @_;	# Verify our spans
+	my @xbuses = Dahdi::Xpp::xbuses;
+	my %xbus_of_span;
+	my %xbus_beginning;
+	my %seen_spans;
+	my @sorted_xbuses;
+	foreach my $xbus (@xbuses) {
+		my $last_spanno;
+		foreach my $xpd ($xbus->xpds) {
+			my $spanno = $xpd->spanno;
+			if(!$spanno) {
+				printf STDERR "%s: Is not registered. Skipping.\n", $xpd->fqn;
+				next;
+			}
+			$seen_spans{$spanno}++;
+			if($xbus_of_span{$spanno}) {
+				printf STDERR "%s: Span %d already seen on %s\n",
+					$xpd->fqn, $spanno, $xbus_of_span{$spanno}->name;
+				die;
+			}
+			$xbus_of_span{$spanno} = $xbus;
+			# Check XPD's sequential numbering
+			if(defined $last_spanno) {
+				if($last_spanno + 1 != $spanno) {
+					printf STDERR "%s: Bad span numbers (%d, %d)\n",
+						$xpd->fqn, $last_spanno, $spanno;
+					die;
+				}
+			} else {
+				$xbus_beginning{$xbus} = $spanno;
+			}
+			$last_spanno = $spanno;
+		}
+	}
+	foreach my $span (@spans) {
+		my $spanno = $span->num;
+		if(!defined($seen_spans{$spanno})) {
+			warn "Span $span does not belong to any XPD!\n";
+		}
+	}
+	@sorted_xbuses = sort { $xbus_beginning{$a} <=> $xbus_beginning{$b} } @xbuses;
+	return @sorted_xbuses;
+}
+
+sub generate($$$) {
+	my $self = shift || die;
+	my $file = $self->{FILE};
+	my $gconfig = $self->{GCONFIG};
+	my $genopts = $self->{GENOPTS};
+	my @spans = @_;		# Verify it's all our spans
+	my @xbuses = get_sorted_xbuses(@spans);
+	warn "Empty configuration -- no xbuses\n" unless @xbuses;
+	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 $0 on %s\n", scalar(localtime);
+	print  "# If you edit this file and execute $0 again,\n";
+	print  "# your manual changes will be LOST.\n";
+	print <<'HEAD';
+#
+# This is an optional configuration file for ordering
+# Dahdi registration.
+#
+# It is read from /etc/dahdi/xpp_order. This location
+# may be overriden via the environment variable XPPORDER_CONF
+#
+# Lines may contain:
+#   - The Astribank label (verbatim)
+#   - The Astribank connector string (prefixed with @)
+# Ordering number of each listed Astribank is determined
+# by its position in this file.
+# Astribanks not listed in this file, get an ordering
+# number of 999 (last).
+#
+# Astribanks with same ordering number are sorted by their
+# connectors (to preserve legacy behaviour).
+#
+# Examples:
+#usb:TWS-08
+#@usb-0000:06:02.2-2
+HEAD
+	foreach my $xbus (@xbuses) {
+		my $label = $xbus->label;
+		my $connector = $xbus->connector;
+		my $name = $xbus->name;
+		printf "%s\t# %s (%s)\n", $label, $connector, $name;
+	}
+	close F;
+	select $old;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Xpporder - Generate Astribank ordering information for dahdi_registration.
+
+=head1 SYNOPSIS
+
+ use Dahdi::Config::Gen::Xpporder;
+
+ my $cfg = new Dahdi::Config::Gen::Xpporder(\%global_config, \%genopts);
+ $cfg->generate;
+
+=head1 DESCRIPTION
+
+Generate the F</etc/dahdi/xpp_order>.
+This is the configuration for dahdi_registration(1).
+The order is determined according to current Dahdi registration
+order.
+
+Its location may be overriden via the environment variable F<XPPORDER_CONF>.
diff --git a/xpp/perl_modules/Dahdi/Xpp/Mpp.pm b/xpp/perl_modules/Dahdi/Xpp/Mpp.pm
index 6e23260..a19e0fe 100644
--- a/xpp/perl_modules/Dahdi/Xpp/Mpp.pm
+++ b/xpp/perl_modules/Dahdi/Xpp/Mpp.pm
@@ -102,15 +102,10 @@ sub showinfo($$) {
 	}
 }
 
-sub new($$$) {
-	my $pack = shift || die;
+sub astribank_tool_cmd($) {
 	my $dev = shift || die;
-	my $product = $dev->product;
 	my $usb_top;
 
-	return undef unless $dev->is_astribank;
-	return undef unless $dev->bus_type eq 'USB';
-	return undef unless $product =~ /116./;
 	# Find USB bus toplevel
 	$usb_top = '/dev/bus/usb';
 	$usb_top = '/proc/bus/usb' unless -d $usb_top;
@@ -118,6 +113,17 @@ sub new($$$) {
 	my $name = $dev->priv_device_name();
 	die "$0: Unkown private device name" unless defined $name;
 	my $path = "$usb_top/$name";
+	return ($astribank_tool, '-D', "$path");
+}
+
+sub new($$$) {
+	my $pack = shift || die;
+	my $dev = shift || die;
+	my $product = $dev->product;
+
+	return undef unless $dev->is_astribank;
+	return undef unless $dev->bus_type eq 'USB';
+	return undef unless $product =~ /116./;
 	my $mppinfo = {
 			DEV	=> $dev,
 			HAS_MPP	=> 1,
@@ -130,11 +136,13 @@ sub new($$$) {
 	}
 	return $mppinfo unless $product =~ /116[12]/;
 	$mppinfo->{'MPP_TALK'} = 1;
+	my @cmd = astribank_tool_cmd($dev);
+	my $name = $dev->priv_device_name();
 	my $dbg_file = "$name";
 	$dbg_file =~ s/\W/_/g;
 	#$dbg_file = "/tmp/twinstar-debug-$dbg_file";
 	$dbg_file = "/dev/null";
-	unless(open(F, "$astribank_tool -D '$path' 2> '$dbg_file' |")) {
+	unless(open(F, "@cmd 2> '$dbg_file' |")) {
 		warn "Failed running '$astribank_tool': $!";
 		return undef;
 	}
@@ -142,6 +150,7 @@ sub new($$$) {
 	local $_;
 	while(<F>) {
 		chomp;
+		#printf STDERR "'%s'\n", $_;
 		if(s/^INFO:\s*//) {
 			$mppinfo->{'PROTOCOL'} = $1 if /^protocol\s+version:\s*(\d+)/i;
 		} elsif(s/^EEPROM:\s*//) {
@@ -149,6 +158,9 @@ sub new($$$) {
 			$mppinfo->{'EEPROM_LABEL'} = $1 if /^label\s*:\s*([\w._'-]+)/i;
 		} elsif(s/^Extrainfo:\s+:\s*(.+?)$//) {
 			$mppinfo->{'EEPROM_EXTRAINFO'} = $1;
+		} elsif(s/^Capabilities:\s*TwinStar\s*:\s*(.+?)$//) {
+			my $cap = $1;
+			$mppinfo->{'TWINSTAR_CAPABLE'} = ($cap =~ /yes/i) ? 1 : 0;
 		} elsif(s/^TwinStar:\s*//) {
 			$mppinfo->{'TWINSTAR_PORT'} = $1 if /^connected\s+to\s*:\s*usb-(\d+)/i;
 			if(s/^USB-(\d+)\s*POWER\s*:\s*//) {
@@ -172,6 +184,31 @@ sub new($$$) {
 	return $mppinfo;
 }
 
+sub mpp_setwatchdog($$) {
+	my $mppinfo = shift || die;
+	my $on = shift;
+	die "$0: Bad value '$on'" unless defined($on) && $on =~ /^[0-1]$/;
+	my $dev = $mppinfo->dev || die;
+	return undef unless defined $mppinfo->mpp_talk;
+	my $old = $mppinfo->tws_watchdog;
+	my @cmd = astribank_tool_cmd($dev);
+	print STDERR "DEBUG($on): '@cmd'\n";
+	system(@cmd, '-w', $on);
+	die "Running $astribank_tool failed: $?" if $?;
+}
+
+sub mpp_jump($) {
+	my $mppinfo = shift || die;
+	my $dev = $mppinfo->dev || die;
+	return undef unless defined $mppinfo->mpp_talk;
+	my $port = $mppinfo->twinstar_port;
+	$port = ($port == 1) ? 0 : 1;
+	die "Unknown TwinStar port" unless defined $port;
+	my @cmd = astribank_tool_cmd($dev);
+	system(@cmd, '-p', $port);
+	die "Running $astribank_tool failed: $?" if $?;
+}
+
 sub mpp_addinfo($@) {
 	my $pack = shift || die;
 	my @devlist = @_;
diff --git a/xpp/perl_modules/Dahdi/Xpp/Xbus.pm b/xpp/perl_modules/Dahdi/Xpp/Xbus.pm
index b57148c..4bc1844 100644
--- a/xpp/perl_modules/Dahdi/Xpp/Xbus.pm
+++ b/xpp/perl_modules/Dahdi/Xpp/Xbus.pm
@@ -88,6 +88,8 @@ sub read_attrs() {
 		if($attr eq 'STATUS') {
 			# Some values are in all caps as well
 			$val = uc($val);
+		} elsif($attr eq 'CONNECTOR') {
+			$val =~ s/^/@/;	# Add prefix
 		} elsif($attr eq 'LABEL') {
 			# Fix badly burned labels.
 			$val =~ s/[[:^print:]]/_/g;