XPP tool updates to match r5663: sysfs migration.

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

6 files changed, 258 insertions, 155 deletions

diff --git a/xpp/perl_modules/Dahdi/Chans.pm b/xpp/perl_modules/Dahdi/Chans.pm
index e2f4033..b2fdc15 100644
--- a/xpp/perl_modules/Dahdi/Chans.pm
+++ b/xpp/perl_modules/Dahdi/Chans.pm
@@ -140,7 +140,7 @@ sub new($$$$$$) {
 		$type = "FXS"; # likely Rhino
 	} elsif ($fqn =~ m{\bFXO/.*}) {
 		$type = "FXO"; # likely Rhino
-	} elsif ($fqn =~ m{---/.*}) {
+	} elsif ($fqn =~ m{\b---/.*}) {
 		$type = "EMPTY"; # likely Rhino, empty slot.
 	} elsif ($fqn =~ m{\b(TE[24]|WCT1|Tor2|TorISA|WP[TE]1|cwain[12])/.*}) {
 		# TE[24]: Digium wct4xxp
@@ -158,11 +158,11 @@ sub new($$$$$$) {
 	} elsif ($fqn =~ m{\bztgsm/.*}) {
 		# Junghanns GSM card
 		$type = "GSM";
-	} elsif(defined $signalling) {
-		$type = 'FXS' if $signalling =~ /^FXS/;
-		$type = 'FXO' if $signalling =~ /^FXO/;
+	} 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)
@@ -218,7 +218,7 @@ sub battery($) {
 	my $self = shift or die;
 	my $span = $self->span or die;
 
-	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/xpp/perl_modules/Dahdi/Span.pm b/xpp/perl_modules/Dahdi/Span.pm
index 0e59f32..d907a3a 100644
--- a/xpp/perl_modules/Dahdi/Span.pm
+++ b/xpp/perl_modules/Dahdi/Span.pm
@@ -145,7 +145,7 @@ my @pri_strings = (
 		'Wildcard TE120P',                 # wcte12xp
 		'Wildcard TE121',                  # wcte12xp
 		'Wildcard TE122',                  # wcte12xp
-		'T[24]XXP PCI Card ',              # wct4xxp
+		'T[24]XXP \(PCI\) Card ',          # wct4xxp
 		);
 
 our $DAHDI_BRI_NET = 'bri_net';
@@ -166,6 +166,7 @@ sub init_proto($$) {
 		$self->{DCHAN_IDX} = 23;
 		$self->{BCHAN_LIST} = [ 0 .. 22 ];
 	}
+	$self->{TYPE} = "${proto}_$self->{TERMTYPE}";
 }
 
 sub new($$) {
diff --git a/xpp/perl_modules/Dahdi/Xpp.pm b/xpp/perl_modules/Dahdi/Xpp.pm
index eeb7bcb..847dedc 100644
--- a/xpp/perl_modules/Dahdi/Xpp.pm
+++ b/xpp/perl_modules/Dahdi/Xpp.pm
@@ -26,43 +26,13 @@ Dahdi::Xpp - Perl interface to the Xorcom Astribank drivers.
       print " - ".$xpd->fqn,"\n";
     }
   }
-
 =cut
 
 
 my $proc_base = "/proc/xpp";
-
-sub xpd_attr_path($$$@) {
-	my ($busnum, $unitnum, $subunitnum, @attr) = @_;
-	foreach my $attr (@attr) {
-		my $file = sprintf "/sys/bus/xpds/devices/%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: OLD DRIVER: missing '$file'. Fall back to /proc\n";
-			$file = $procfile;
-		}
-		next unless -f $file;
-		return $file;
-	}
-	return undef;
-}
-
-sub xbus_attr_path($$) {
-	my ($busnum, @attr) = @_;
-	foreach my $attr (@attr) {
-		my $file = sprintf "/sys/bus/astribanks/devices/xbus-%02d/$attr", $busnum;
-		unless(-f $file) {
-			my $procfile = sprintf "/proc/xpp/XBUS-%02d/$attr", $busnum;
-			warn "$0: OLD DRIVER: missing '$file'. Fall back to '$procfile'\n";
-			$file = $procfile;
-		}
-		next unless -f $file;
-		return $file;
-	}
-	return undef;
-}
+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 {
@@ -174,23 +144,13 @@ 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 = Dahdi::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 = Dahdi::Xpp::Xbus->new($1);
 		push(@xbuses, $xbus);
 	}
+	closedir D;
 	my $sorter = sorters($optsort);
 	die "Unknown optional sorter '$optsort'" unless defined $sorter;
 	@xbuses = sort $sorter @xbuses;
@@ -218,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;
@@ -252,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 'DAHDI') {
+			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/xpp/perl_modules/Dahdi/Xpp/Line.pm b/xpp/perl_modules/Dahdi/Xpp/Line.pm
index 507b2e2..1302a9e 100644
--- a/xpp/perl_modules/Dahdi/Xpp/Line.pm
+++ b/xpp/perl_modules/Dahdi/Xpp/Line.pm
@@ -26,17 +26,7 @@ sub blink($$) {
 	my $self = shift;
 	my $on = shift;
 	my $xpd = $self->xpd;
-	my $result;
-	my $file = Dahdi::Xpp::xpd_attr_path(
-			$xpd->xbus->num,
-			$xpd->unit,
-			$xpd->subunit, "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;
@@ -44,15 +34,7 @@ sub blink($$) {
 
 		$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;
 }
@@ -69,15 +51,9 @@ sub create_all($$) {
 	}
 	$xpd->{LINES} = \@lines;
 	if($xpd->type eq 'FXO') {
-		my $file = Dahdi::Xpp::xpd_attr_path(
-				$xpd->xbus->num,
-				$xpd->unit,
-				$xpd->subunit, "fxo_battery");
-		if(defined $file) {
-			open(F, "$file") || die "Failed opening '$file': $!";
-			my $battery_line = <F>;
-			close F;
-			my @batt = split(/\s+/, $battery_line);
+		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;
diff --git a/xpp/perl_modules/Dahdi/Xpp/Xbus.pm b/xpp/perl_modules/Dahdi/Xpp/Xbus.pm
index 4e6b2b3..2cae6f8 100644
--- a/xpp/perl_modules/Dahdi/Xpp/Xbus.pm
+++ b/xpp/perl_modules/Dahdi/Xpp/Xbus.pm
@@ -40,48 +40,93 @@ 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;
 }
 
+sub xbus_attr_path($$) {
+	my ($busnum, @attr) = @_;
+	foreach my $attr (@attr) {
+		my $file = sprintf "$Dahdi::Xpp::sysfs_astribanks/xbus-%02d/$attr", $busnum;
+		unless(-f $file) {
+			my $procfile = sprintf "/proc/xpp/XBUS-%02d/$attr", $busnum;
+			warn "$0: OLD DRIVER: missing '$file'. Fall back to '$procfile'\n";
+			$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 new($$) {
 	my $pack = shift or die "Wasn't called as a class method\n";
-	my $self = {};
+	my $num = shift;
+	my $xbus_dir = "$Dahdi::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;
 	}
 	@{$self->{XPDS}} = ();
-	foreach my $dir (glob "$prefix/XPD-??") {
-		my $xpd = Dahdi::Xpp::Xpd->new($self, $dir);
+	opendir(D, $xbus_dir) || die "Failed opendir($xbus_dir): $!";
+	while(my $entry = readdir D) {
+		$entry =~ /^([0-9]+):([0-9]+):([0-9]+)$/ or next;
+		my ($busnum, $unit, $subunit) = ($1, $2, $3);
+		my $procdir = "/proc/xpp/XBUS-$busnum/XPD-$unit$subunit";
+		#print STDERR "busnum=$busnum, unit=$unit, subunit=$subunit procdir=$procdir\n";
+		my $xpd = Dahdi::Xpp::Xpd->new($self, $unit, $subunit, $procdir, "$xbus_dir/$entry");
 		push(@{$self->{XPDS}}, $xpd);
 	}
+	closedir D;
 	@{$self->{XPDS}} = sort { $a->id <=> $b->id } @{$self->{XPDS}};
 	return $self;
 }
diff --git a/xpp/perl_modules/Dahdi/Xpp/Xpd.pm b/xpp/perl_modules/Dahdi/Xpp/Xpd.pm
index 591c52f..21ce8b6 100644
--- a/xpp/perl_modules/Dahdi/Xpp/Xpd.pm
+++ b/xpp/perl_modules/Dahdi/Xpp/Xpd.pm
@@ -12,31 +12,81 @@ use Dahdi::Utils;
 use Dahdi::Xpp;
 use Dahdi::Xpp::Line;
 
-sub blink($$) {
-	my $self = shift;
-	my $on = shift;
-	my $result;
-	my $file = Dahdi::Xpp::xpd_attr_path(
+sub xpd_attr_path($@) {
+	my $self = shift || die;
+	my ($busnum, $unitnum, $subunitnum, @attr) = (
 		$self->xbus->num,
 		$self->unit,
-		$self->subunit, "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;
+		$self->subunit,
+		@_);
+	foreach my $attr (@attr) {
+		my $file = sprintf "$Dahdi::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: OLD DRIVER: missing '$file'. Fall back to /proc\n";
+			$file = $procfile;
+		}
+		next unless -f $file;
+		return $file;
+	}
+	return undef;
+}
+
+# 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_getattr($$) {
+	my $xpd = shift || die;
+	my $attr = shift || die;
+	$attr = lc($attr);
+	my $file = xpd_attr_path($xpd, lc($attr));
+
+	return xpd_old_gettype($xpd) if $attr eq 'type' and !defined $file;
+	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,10 +94,7 @@ sub dahdi_registration($$) {
 	my $self = shift;
 	my $on = shift;
 	my $result;
-	my $file = Dahdi::Xpp::xpd_attr_path(
-		$self->xbus->num,
-		$self->unit,
-		$self->subunit, "span", "dahdi_registration");
+	my $file = $self->xpd_attr_path("span", "dahdi_registration");
 	die "$file is missing" unless -f $file;
 	# First query
 	open(F, "$file") or die "Failed to open $file for reading: $!";
@@ -79,14 +126,22 @@ 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",
+		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>;
@@ -103,19 +158,10 @@ sub new($$) {
 		}
 	}
 	close F;
-	$head =~ s/^(XPD-(\d)(\d))\s+// || die;
-	$self->{ID} = "$2$3";
-	$self->{UNIT} = "$2";
-	$self->{SUBUNIT} = "$3";
-	$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;
-	}
+	$self->{FQN} = $xbus->name . "/" . "XPD-$unit$subunit";
+	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/);
@@ -124,4 +170,53 @@ sub new($$) {
 	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;