2 files changed, 96 insertions, 51 deletions

diff --git a/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm b/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
index 7951d98..57c93f5 100644
--- a/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
+++ b/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
@@ -8,23 +8,11 @@ package Zaptel::Xpp::Xbus;
 # $Id$
 #
 use strict;
+use XppUtils;
 use Zaptel::Xpp::Xpd;
 
 my $proc_base = "/proc/xpp";
 
-# Accessors (miniperl does not have Class:Accessor)
-our $AUTOLOAD;
-sub AUTOLOAD {
-	my $self = shift;
-	my $name = uc($AUTOLOAD);
-	$name =~ s/.*://;   # strip fully-qualified portion
-	if (@_) {
-		return $self->{$name} = shift;
-	} else {
-		return $self->{$name};
-	}
-}
-
 sub xpds($) {
 	my $xbus = shift;
 	return @{$xbus->{XPDS}};
@@ -39,17 +27,27 @@ sub by_number($) {
 	return $xbus;
 }
 
+sub by_label($) {
+	my $label = shift;
+	die "Missing xbus label parameter" unless defined $label;
+	my @xbuses = Zaptel::Xpp::xbuses();
+
+	my ($xbus) = grep { $_->label eq $label } @xbuses;
+	return $xbus;
+}
+
 sub get_xpd_by_number($$) {
 	my $xbus = shift;
-	my $xpdnum = shift;
-	die "Missing XPD number parameter" unless defined $xpdnum;
+	my $xpdid = shift;
+	die "Missing XPD id parameter" unless defined $xpdid;
 	my @xpds = $xbus->xpds;
-	return $xpds[$xpdnum];
+	return $xpds[$xpdid];
 }
 
 sub new($$) {
 	my $pack = shift or die "Wasn't called as a class method\n";
 	my $self = {};
+	bless $self, $pack;
 	while(@_) {
 		my ($k, $v) = @_;
 		shift; shift;
@@ -61,7 +59,13 @@ sub new($$) {
 		}
 		$self->{$k} = $v;
 	}
-	bless $self, $pack;
+	# 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";
@@ -73,19 +77,41 @@ sub new($$) {
 		$self->{USB_DEVNAME} = $head;
 	}
 	@{$self->{XPDS}} = ();
-	foreach my $fqn (glob "$prefix/XPD-??") {
-		$fqn =~ s:$proc_base/::;
-		$fqn =~ /(\d+)$/;
-		my $num = $1;
-		my $xpd = Zaptel::Xpp::Xpd->new(
-					FQN => $fqn,
-					NUM =>, $num,
-					XBUS => $self
-					);
+	foreach my $dir (glob "$prefix/XPD-??") {
+		my $xpd = Zaptel::Xpp::Xpd->new($self, $dir);
 		push(@{$self->{XPDS}}, $xpd);
 	}
-	@{$self->{XPDS}} = sort { $a->num <=> $b->num } @{$self->{XPDS}};
+	@{$self->{XPDS}} = sort { $a->id <=> $b->id } @{$self->{XPDS}};
 	return $self;
 }
 
+sub pretty_xpds($) {
+		my $xbus = shift;
+		my @xpds = sort { $a->id <=> $b->id } $xbus->xpds();
+		my @xpd_types = map { $_->type } @xpds;
+		my $last_type = '';
+		my $mult = 0;
+		my $xpdstr = '';
+		foreach my $curr (@xpd_types) {
+			if(!$last_type || ($curr eq $last_type)) {
+				$mult++;
+			} else {
+				if($mult == 1) {
+					$xpdstr .= "$last_type ";
+				} elsif($mult) {
+					$xpdstr .= "$last_type*$mult ";
+				}
+				$mult = 1;
+			}
+			$last_type = $curr;
+		}
+		if($mult == 1) {
+			$xpdstr .= "$last_type ";
+		} elsif($mult) {
+			$xpdstr .= "$last_type*$mult ";
+		}
+		$xpdstr =~ s/\s*$//;	# trim trailing space
+		return $xpdstr;
+}
+
 1;
diff --git a/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm b/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
index 852aaea..ef479fb 100644
--- a/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
+++ b/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
@@ -8,22 +8,10 @@ package Zaptel::Xpp::Xpd;
 # $Id$
 #
 use strict;
+use XppUtils;
 
 my $proc_base = "/proc/xpp";
 
-# Accessors (miniperl does not have Class:Accessor)
-our $AUTOLOAD;
-sub AUTOLOAD {
-	my $self = shift;
-	my $name = uc($AUTOLOAD);
-	$name =~ s/.*://;   # strip fully-qualified portion
-	if (@_) {
-		return $self->{$name} = shift;
-	} else {
-		return $self->{$name};
-	}
-}
-
 sub blink($$) {
 	my $self = shift;
 	my $on = shift;
@@ -76,23 +64,54 @@ sub zt_registration($$) {
 	return $result;
 }
 
+#
+# Backward compatibility for old drivers
+# before changeset:5119
+#
+# Newer drivers should directly have $xpd->spanno
+#
+sub spanno_of_xpd($) {
+	my $xpd = shift || die;
+
+	warn "Running on old driver. Keep going...\n";
+	use Zaptel;
+	my @spans = Zaptel::spans;
+
+	my ($span) = grep { $_->name eq $xpd->fqn } @spans;
+	return ($span) ? $span->num : 0;
+}
+
 sub new($$) {
 	my $pack = shift or die "Wasn't called as a class method\n";
-	my $self = { @_ };
+	my $xbus = shift || die;
+	my $procdir = shift || die;
+	my $self = {};
 	bless $self, $pack;
-	my $dir = "$proc_base/" . $self->fqn;
-	$self->{DIR} = $dir;
-	open(F, "$dir/summary") || die "Missing summary file in $dir";
+	$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 registered) SYNC MASTER"
+	# "XPD-00 (BRI_TE ,card present, span 3)"
 	close F;
-	$head =~ s/^.*\(//;
-	$head =~ s/\) */, /;
-	$head =~ s/\s*,\s*/,/g;
-	my ($type,$present,$registered,$sync) = split(/,/, $head);
-	$self->{TYPE} = uc($type);
-	$self->{IS_SYNC_MASTER} = ($sync =~ /MASTER/);
+	$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;
+	} else {
+		$self->{SPANNO} = $self->spanno_of_xpd;
+	}
+	$self->{TYPE} = $type;
+	$self->{IS_BRI} = ($type =~ /BRI_(NT|TE)/);
+	$self->{IS_PRI} = ($type =~ /[ETJ]1_(NT|TE)/);
+	$self->{IS_DIGITAL} = ( $self->{IS_BRI} || $self->{IS_PRI} );
 	return $self;
 }