[dahdi-commits] tzafrir: branch tools/tzafrir/sysfs r8611 - /tools/team/tzafrir/sysfs/xpp/per...

SVN commits to the DAHDI project dahdi-commits at lists.digium.com
Wed May 5 05:36:03 CDT 2010


Author: tzafrir
Date: Wed May  5 05:35:59 2010
New Revision: 8611

URL: http://svnview.digium.com/svn/dahdi?view=rev&rev=8611
Log:
Improve hardware detection from SysFS information

* A more correct hardware detection for analog ports from SysFS (should be
  like the procfs one, but with most hacks removed).
* Likewise for BRI (and hopefully for E1/T1, but untested).
* A separate glob2regex() for all the places we use glob(3) patterns but
  implement them using perl regex matching.

Modified:
    tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Chans.pm
    tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Span.pm
    tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Utils.pm

Modified: tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Chans.pm
URL: http://svnview.digium.com/svn/dahdi/tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Chans.pm?view=diff&rev=8611&r1=8610&r2=8611
==============================================================================
--- tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Chans.pm (original)
+++ tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Chans.pm Wed May  5 05:35:59 2010
@@ -100,95 +100,36 @@
 	return $value;
 }
 
-sub new($$$) {
-	my $pack = shift or die "Wasn't called as a class method\n";
-	my $span = shift or die "Missing a span parameter\n";
-	my $dev_dir = shift or die "Missing SysFS path parameter\n";
-	if ($dev_dir !~ /!(\d)+$/) {
-		die "Malformed SysFS device name $dev_dir\n";
-	}
-	my $self = {
-		'SPAN' => $span,
-		'DEV_DIR' => $dev_dir,
-	};
-	bless $self, $pack;
-	$self->{NUM} = $self->_get_dev_attr('channo');
-	$self->{DEV} = $self->_get_dev_attr('dev');
-	$self->{INDEX} = $self->_get_dev_attr('chanpos');
-	$self->{FQN} = $self->_get_dev_attr('name'); # TODO: correct?
-	my $poolentry = Dahdi::Pool->dev2poolentry($self->{DEV});
-	if(defined $poolentry) {
-		$self->{POOLPOS} = $poolentry->{NUM};
-		$span->{SUBDIR} = $poolentry->{SUBDIR} unless defined $span->{SUBDIR};
-		my $pool = $poolentry->{POOL};
-		$span->{POOLNAME} = $pool->{NAME} unless defined $span->{POOLNAME};
-	}
-
-	$self->{ALARMS} = [];
-	my $alarms = $self->_get_dev_attr('alarms');
-	if ($alarms) {$self->{ALARMS} = [$alarms]}
-
-	$self->{SIGNALLING} = $self->_get_dev_attr('sig');
-	$self->{SIGCAP} = hex($self->_get_dev_attr('sigcap'));
-	
-	# TODO: Where do I get __DAHDI_SIG_FXS and __DAHDI_SIG_FXO from?
-	my $maybe_fxs = $self->{SIGCAP} & (1 << 12);
-	my $maybe_fxo = $self->{SIGCAP} & (1 << 13);
-	if ( $maybe_fxs && (not $maybe_fxo) ) {
-		$self->{TYPE} = 'FXS';
-	} elsif ( (not $maybe_fxs) && $maybe_fxo) {
-		$self->{TYPE} = 'FXO';
-     	} else {
-	}
-
-	$self->{INFO} .= ($self->_get_dev_attr('chanmute')) ? '(no pcm)' : '';
-	$self->{INFO} .= ($self->_get_dev_attr('in_use')) ? '(in use)' : '';
-
-	return $self;
-}
-
-sub new_procfs($$$$$$) {
-	my $pack = shift or die "Wasn't called as a class method\n";
-	my $span = shift or die "Missing a span parameter\n";
-	my $index = shift;
-	my $line = shift or die "Missing an input line\n";
-	defined $index or die "Missing an index parameter\n";
-	my $self = {
-			'SPAN' => $span,
-			'INDEX' => $index,
-		};
-	bless $self, $pack;
-	my ($num, $fqn, $rest) = split(/\s+/, $line, 3);
-	$num or die "Missing a channel number parameter\n";
-	$fqn or die "Missing a channel fqn parameter\n";
-	my $signalling = '';
-	my @alarms = ();
-	my $info = '';
-	if(defined $rest) {
-		# remarks in parenthesis (In use), (no pcm)
-		while($rest =~ s/\s*(\([^)]+\))\s*/ /) {
-			$info .= " $1";
-		}
-		# Alarms
-		foreach my $alarm (@alarm_types) {
-			if($rest =~ s/\s*(\b${alarm}\b)\s*/ /) {
-				push(@alarms, $1);
-			}
-		}
-		foreach my $sig (@sigtypes) {
-			if($rest =~ s/^\Q$sig\E/ /) {
-				$signalling = $sig;
-				last;
-			}
-		}
-		warn "Unrecognized garbage '$rest' in $fqn\n"
-			if $rest =~ /\S/;
-	}
-	$self->{NUM} = $num;
-	$self->{FQN} = $fqn;
-	$self->{SIGNALLING} = $signalling;
-	$self->{ALARMS} = \@alarms;
-	$self->{INFO} = $info;
+sub chan_sysfs_type_heuristics {
+	my $self = shift;
+	my $span = $self->span;
+
+	my $type = $span->spantype;
+	if ($type =~ /^(TE|NT|BRI|BRI_(NT|TE))$/) {
+		$type = 'BRI';
+	} elsif ($type =~ /^(E1|J1|T1)$/) {
+		$type = 'PRI';
+	} elsif ($type eq '<NULL>') {
+		my $maybe_fxs = $self->{SIGCAP} & (1 << 12);
+		my $maybe_fxo = $self->{SIGCAP} & (1 << 13);
+		if ( $maybe_fxs && (not $maybe_fxo) ) {
+			$type = 'FXS';
+		} elsif ( (not $maybe_fxs) && $maybe_fxo) {
+			$type = 'FXO';
+		} else {
+			$type = 'EMPTY';
+		}
+	} elsif ($self->fqn =~ m{^XPP_(\w+)/}) {
+		$type = $1;		# An Astribank
+	}
+	return $type;
+}
+
+sub chan_type_heuristics {
+	my $self = shift;
+	my $span = $self->span;
+	my $fqn = $self->fqn;
+	my $signalling = $self->signalling;
 	my $type;
 	if($fqn =~ m|\bXPP_(\w+)/.*$|) {
 		$type = $1;		# An Astribank
@@ -230,6 +171,95 @@
 	} else {
 		$type = $self->probe_type();
 	}
+	return $type;
+}
+
+sub new($$$) {
+	my $pack = shift or die "Wasn't called as a class method\n";
+	my $span = shift or die "Missing a span parameter\n";
+	my $dev_dir = shift or die "Missing SysFS path parameter\n";
+	if ($dev_dir !~ /!(\d)+$/) {
+		die "Malformed SysFS device name $dev_dir\n";
+	}
+	my $self = {
+		'SPAN' => $span,
+		'DEV_DIR' => $dev_dir,
+	};
+	bless $self, $pack;
+	$self->{NUM} = $self->_get_dev_attr('channo');
+	$self->{DEV} = $self->_get_dev_attr('dev');
+	$self->{INDEX} = $self->_get_dev_attr('chanpos');
+	$self->{FQN} = $self->_get_dev_attr('name'); # TODO: correct?
+	my $poolentry = Dahdi::Pool->dev2poolentry($self->{DEV});
+	if(defined $poolentry) {
+		$self->{POOLPOS} = $poolentry->{NUM};
+		$span->{SUBDIR} = $poolentry->{SUBDIR} unless defined $span->{SUBDIR};
+		my $pool = $poolentry->{POOL};
+		$span->{POOLNAME} = $pool->{NAME} unless defined $span->{POOLNAME};
+	}
+
+	$self->{ALARMS} = [];
+	my $alarms = $self->_get_dev_attr('alarms');
+	if ($alarms) {$self->{ALARMS} = [$alarms]}
+
+	$self->{SIGNALLING} = $self->_get_dev_attr('sig');
+	$self->{SIGCAP} = hex($self->_get_dev_attr('sigcap'));
+	
+	#my $type = $self->chan_type_heuristics;
+	my $type = $self->chan_sysfs_type_heuristics;
+	if(defined $type) {
+		$self->type($type);
+	}
+
+	#$self->{INFO} .= ($self->_get_dev_attr('chanmute')) ? '(no pcm)' : '';
+	$self->{INFO} .= ($self->_get_dev_attr('in_use')) ? '(in use)' : '';
+
+	return $self;
+}
+
+sub new_procfs($$$$$$) {
+	my $pack = shift or die "Wasn't called as a class method\n";
+	my $span = shift or die "Missing a span parameter\n";
+	my $index = shift;
+	my $line = shift or die "Missing an input line\n";
+	defined $index or die "Missing an index parameter\n";
+	my $self = {
+			'SPAN' => $span,
+			'INDEX' => $index,
+		};
+	bless $self, $pack;
+	my ($num, $fqn, $rest) = split(/\s+/, $line, 3);
+	$num or die "Missing a channel number parameter\n";
+	$fqn or die "Missing a channel fqn parameter\n";
+	my $signalling = '';
+	my @alarms = ();
+	my $info = '';
+	if(defined $rest) {
+		# remarks in parenthesis (In use), (no pcm)
+		while($rest =~ s/\s*(\([^)]+\))\s*/ /) {
+			$info .= " $1";
+		}
+		# Alarms
+		foreach my $alarm (@alarm_types) {
+			if($rest =~ s/\s*(\b${alarm}\b)\s*/ /) {
+				push(@alarms, $1);
+			}
+		}
+		foreach my $sig (@sigtypes) {
+			if($rest =~ s/^\Q$sig\E/ /) {
+				$signalling = $sig;
+				last;
+			}
+		}
+		warn "Unrecognized garbage '$rest' in $fqn\n"
+			if $rest =~ /\S/;
+	}
+	$self->{NUM} = $num;
+	$self->{FQN} = $fqn;
+	$self->{SIGNALLING} = $signalling;
+	$self->{ALARMS} = \@alarms;
+	$self->{INFO} = $info;
+	my $type = $self->chan_type_heuristics;
 	$self->type($type);
 	$self->span()->type($type)
 		if ! defined($self->span()->type()) ||

Modified: tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Span.pm
URL: http://svnview.digium.com/svn/dahdi/tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Span.pm?view=diff&rev=8611&r1=8610&r2=8611
==============================================================================
--- tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Span.pm (original)
+++ tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Span.pm Wed May  5 05:35:59 2010
@@ -130,10 +130,7 @@
 
 sub match_location($) {
 	my $span_location = shift || die "Missing span location";
-	$span_location =~ s/^@//;
-	# Translate globs to regexes
-	$span_location =~ s/\?/./;
-	$span_location =~ s/\*/.*/;
+	$span_location = Dahdi::Utils::glob2regex($span_location);
 	my @spans = Dahdi::spans();
 	my @matched = grep { defined($_->location) && $_->location =~ m/^$span_location$/ } @spans;
 	return @matched;
@@ -141,9 +138,7 @@
 
 sub match_hardware_id($) {
 	my $span_hardware_id = shift || die "Missing span hardware_id";
-	# Translate globs to regexes
-	$span_hardware_id =~ s/\?/./;
-	$span_hardware_id =~ s/\*/.*/;
+	$span_hardware_id = Dahdi::Utils::glob2regex($span_hardware_id);
 	my @spans = Dahdi::spans();
 	my @matched = grep { defined($_->hardware_id) && $_->hardware_id =~ m/^$span_hardware_id$/ } @spans;
 	return @matched;
@@ -207,6 +202,14 @@
 	return $value;
 }
 
+sub set_location() {
+	my $span = shift || die;
+	my $location;
+	$location = $span->_get_dev_attr('location');
+	$location =~ s/^/@/;			# Add prefix
+	$location =~ tr/[a-zA-Z0-9.!:-]/_/c;	# Cleanup
+	$span->{LOCATION} = $location;
+}
 
 # TYPE
 # IS_BRI
@@ -226,31 +229,55 @@
 		die "Spanno mismatch: $xpd->spanno, $num" unless $xpd->spanno == $num;
 		$self->{XPD} = $xpd;
 	}
-
+	$self->set_location;
 	$self->{IS_DIGITAL} = $self->_get_dev_attr('is_digital');
 	$self->{IS_DAHDI_SYNC_MASTER} = $self->_get_dev_attr('is_sync_master');
 	$self->{NAME} = $self->_get_dev_attr('name');
 	$self->{DESCRIPTION} = $self->_get_dev_attr('desc');
 	$self->{DEVICETYPE} = $self->_get_dev_attr('devicetype');
+	$self->{SPANTYPE} = $self->_get_dev_attr('spantype');
 	$self->{IRQ} = $self->_get_dev_attr('irq');
 	$self->{IRQMISSES} = $self->_get_dev_attr('irqmisses');
 	$self->{LBO} = $self->_get_dev_attr('lbo');
-	$self->{LOCATION} = $self->_get_dev_attr('location');
 	$self->{SYNCSRC} = $self->_get_dev_attr('syncsrc');
 	$self->{MANUFACTURER} = $self->_get_dev_attr('manufacturer');
 	# FIXME: the following is a number, rather than a readable value:
 	$self->{ALARMS} = $self->_get_dev_attr('alarms');
 	$self->{HARDWARE_ID} = $self->_get_dev_attr('hardware_id');
 	$self->{HARDWARE_PORT} = $self->_get_dev_attr('hardware_port');
+	if ($self->spantype =~ /^(TE|NT|BRI|BRI_(NT|TE))$/) {
+		# FIXME: BRI modules of wct24xxp?
+		$self->{IS_DIGITAL} = 1;
+		$self->{IS_BRI} = 1;
+		# Fixme: figure out termtype for Astribanks and such
+		#$self->{TERMTYPE} = $1 || $2;
+		$self->{TERMTYPE} = 'TE';
+		$self->{FRAMING} = 'ccs';
+		$self->{CODING} = 'ami';
+		$self->{SWITCHTYPE} = 'euroisdn';
+		$self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ?
+			$DAHDI_BRI_NET : $DAHDI_BRI_CPE ;
+		$self->{IS_BRI} = 1;
+		$self->{TYPE} = "BRI_". $self->termtype;
+		$self->{DCHAN_IDX} = 2;
+		$self->{BCHAN_LIST} = [ 0, 1 ];
+	} elsif ($self->spantype =~ /^(E1|J1|T1)$/) {
+		$self->{IS_DIGITAL} = 1;
+		$self->{IS_PRI} = 1;
+	}
 	
 	$self->{CHANS} = [];
 	my @channels;
-	foreach my $chan_dev_dir (glob("$dev_dir/dahdi:dahdi![0-9]*")) {
+	foreach my $chan_dev_dir (glob("$dev_dir/dahdi!spans!*")) {
 		my $chan = Dahdi::Chans->new($self, $chan_dev_dir);
 		push(@channels, $chan);
 	}
 	@channels = sort { $a->num <=> $b->num } @channels;
 	$self->{CHANS} = \@channels;
+	if ($self->is_bri()) {
+		$self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}];
+		$self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ];
+	}
 
 
 	return $self;
@@ -418,9 +445,7 @@
 		#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;
+		$match = Dahdi::Utils::glob2regex($match);
 		#print STDERR "match: $match\n";
 		foreach my $pattern (@patlist) {
 			#print STDERR "testmatch: $pattern =~ $match\n";

Modified: tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Utils.pm
URL: http://svnview.digium.com/svn/dahdi/tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Utils.pm?view=diff&rev=8611&r1=8610&r2=8611
==============================================================================
--- tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Utils.pm (original)
+++ tools/team/tzafrir/sysfs/xpp/perl_modules/Dahdi/Utils.pm Wed May  5 05:35:59 2010
@@ -48,6 +48,12 @@
 	}
 }
 
+sub glob2regex($) {
+	my $glob = shift || die;
+	$glob =~ s/\*/.*/g;
+	$glob =~ s/\?/./g;
+	return $glob;
+}
 # Based on Autoloader
 
 sub import {




More information about the dahdi-commits mailing list