diff options
Diffstat (limited to 'xpp/utils/zconf/Zaptel')
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Chans.pm | 40 | ||||
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Hardware.pm | 33 | ||||
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Hardware/PCI.pm | 37 | ||||
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Hardware/USB.pm | 45 | ||||
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Span.pm | 50 | ||||
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Xpp.pm | 113 | ||||
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Xpp/Xbus.pm | 80 | ||||
| -rw-r--r-- | xpp/utils/zconf/Zaptel/Xpp/Xpd.pm | 67 |
8 files changed, 292 insertions, 173 deletions
diff --git a/xpp/utils/zconf/Zaptel/Chans.pm b/xpp/utils/zconf/Zaptel/Chans.pm index f105a8c..236d6af 100644 --- a/xpp/utils/zconf/Zaptel/Chans.pm +++ b/xpp/utils/zconf/Zaptel/Chans.pm @@ -8,34 +8,30 @@ package Zaptel::Chans; # $Id$ # use strict; - -# 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}; - } -} +use XppUtils; 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 $num = shift or die "Missing a channel number parameter\n"; - my $fqn = shift or die "Missing a channel fqn parameter\n"; - my $signalling = shift || ''; - my $info = shift || ''; + my $line = shift or die "Missing an input line\n"; + 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 = ''; + if(defined $rest && ($rest =~ s/(\w+)//)) { + $signalling = $1; + } + my $info = ''; + if(defined $rest && ($rest =~ s/(.*)//)) { + $info = $1; + } my $self = {}; bless $self, $pack; - $self->span($span); - $self->num($num); - $self->fqn($fqn); - $self->signalling($signalling); - $self->info($info); + $self->{SPAN} = $span; + $self->{NUM} = $num; + $self->{FQN} = $fqn; + $self->{SIGNALLING} = $signalling; + $self->{INFO} = $info; my $type; if($fqn =~ m|\bXPP_(\w+)/.*$|) { $type = $1; # One of our AB diff --git a/xpp/utils/zconf/Zaptel/Hardware.pm b/xpp/utils/zconf/Zaptel/Hardware.pm index 8423c18..5af22f7 100644 --- a/xpp/utils/zconf/Zaptel/Hardware.pm +++ b/xpp/utils/zconf/Zaptel/Hardware.pm @@ -11,33 +11,35 @@ use strict; use Zaptel::Hardware::USB; use Zaptel::Hardware::PCI; -my @zaptel_devices; - sub device_detected($$) { my $dev = shift || die; my $name = shift || die; - warn "Device '$name' already known\n" - if grep { $_->hardware_name eq $name } @zaptel_devices; + die unless defined $dev->{'BUS_TYPE'}; + $dev->{IS_ASTRIBANK} = 0 unless defined $dev->{'IS_ASTRIBANK'}; $dev->{'HARDWARE_NAME'} = $name; - push(@zaptel_devices, $dev); } sub device_removed($) { my $dev = shift || die; my $name = $dev->hardware_name; die "Missing zaptel device hardware name" unless $name; - @zaptel_devices = grep { $_->hardware_name ne $name } @zaptel_devices; } -sub devices($) { - my $pack = shift || die; +sub device_list($) { + my $self = shift || die; + my @types = @_; + my @list; - return @zaptel_devices; + @types = qw(USB PCI) unless @types; + foreach my $t (@types) { + @list = ( @list, @{$self->{$t}} ); + } + return @list; } sub drivers($) { - my $pack = shift or die "Wasn't called as a class method\n"; - my @devs = $pack->devices(); + my $self = shift || die; + my @devs = $self->device_list; my @drvs = map { $_->{DRIVER} } @devs; # Make unique my %drivers; @@ -45,11 +47,14 @@ sub drivers($) { return sort keys %drivers; } -sub scan_hardware($) { +sub scan($) { my $pack = shift || die; + my $self = {}; + bless $self, $pack; - Zaptel::Hardware::USB->scan_devices; - Zaptel::Hardware::PCI->scan_devices; + $self->{USB} = [ Zaptel::Hardware::USB->devices ]; + $self->{PCI} = [ Zaptel::Hardware::PCI->scan_devices ]; + return $self; } 1; diff --git a/xpp/utils/zconf/Zaptel/Hardware/PCI.pm b/xpp/utils/zconf/Zaptel/Hardware/PCI.pm index d471c1f..7d4e2b3 100644 --- a/xpp/utils/zconf/Zaptel/Hardware/PCI.pm +++ b/xpp/utils/zconf/Zaptel/Hardware/PCI.pm @@ -8,6 +8,7 @@ package Zaptel::Hardware::PCI; # $Id$ # use strict; +use XppUtils; use Zaptel::Hardware; our @ISA = qw(Zaptel::Hardware); @@ -45,9 +46,10 @@ my %pci_ids = ( 'e159:0001/e16b' => { DRIVER => 'pciradio', DESCRIPTION => 'PCIRADIO' }, # from wcfxo + 'e159:0001/8084' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P clone' }, 'e159:0001/8085' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P' }, - 'e159:0001/8086' => { DRIVER => 'wcfxo', DESCRIPTION => 'Generic Clone' }, - 'e159:0001/8087' => { DRIVER => 'wcfxo', DESCRIPTION => 'Generic Clone' }, + 'e159:0001/8086' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P clone' }, + 'e159:0001/8087' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P clone' }, '1057:5608' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X100P' }, # from wct1xxp @@ -104,25 +106,16 @@ my %pci_ids = ( '0b0b:0705' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino R24FXS' }, '0b0b:0706' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB24FXO 24-Channel FXO analog telphony card' }, '0b0b:0906' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB24FXX 24-channel modular analog telphony card' }, + + # Sangoma cards (based on pci.ids) + '1923:0040' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A200/Remora FXO/FXS Analog AFT card' }, + '1923:0100' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A104d QUAD T1/E1 AFT card' }, + '1923:0300' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A101 single-port T1/E1' }, + '1923:0400' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A104u Quad T1/E1 AFT' }, ); $ENV{PATH} .= ":/usr/sbin:/sbin:/usr/bin:/bin"; -# 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}; - } -} - -my @devices; - sub pci_sorter { return $a->priv_device_name() cmp $b->priv_device_name(); } @@ -136,11 +129,6 @@ sub new($$) { return $self; } -sub devices($) { - my $pack = shift or die "Wasn't called as a class method\n"; - return sort pci_sorter @devices; -} - my %pci_devs; sub readfile($) { @@ -153,6 +141,8 @@ sub readfile($) { } sub scan_devices($) { + my @devices; + while(</sys/bus/pci/devices/*>) { m,([^/]+)$,,; my $name = $1; @@ -182,6 +172,7 @@ sub scan_devices($) { next unless defined $pci_ids{$key}; my $d = Zaptel::Hardware::PCI->new( + BUS_TYPE => 'PCI', PRIV_DEVICE_NAME => $dev->{PRIV_DEVICE_NAME}, VENDOR => $dev->{VENDOR}, PRODUCT => $dev->{PRODUCT}, @@ -193,6 +184,8 @@ sub scan_devices($) { ); push(@devices, $d); } + @devices = sort pci_sorter @devices; + return @devices; } 1; diff --git a/xpp/utils/zconf/Zaptel/Hardware/USB.pm b/xpp/utils/zconf/Zaptel/Hardware/USB.pm index 4d87536..a5501d1 100644 --- a/xpp/utils/zconf/Zaptel/Hardware/USB.pm +++ b/xpp/utils/zconf/Zaptel/Hardware/USB.pm @@ -8,6 +8,7 @@ package Zaptel::Hardware::USB; # $Id$ # use strict; +use XppUtils; use Zaptel::Hardware; use Zaptel::Xpp; use Zaptel::Xpp::Xbus; @@ -30,25 +31,14 @@ my %usb_ids = ( 'e4e4:1150' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-multi no-firmware' }, 'e4e4:1151' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-multi USB-firmware' }, 'e4e4:1152' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-multi FPGA-firmware' }, + 'e4e4:1160' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-modular no-firmware' }, + 'e4e4:1161' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-modular USB-firmware' }, + 'e4e4:1162' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-modular FPGA-firmware' }, ); $ENV{PATH} .= ":/usr/sbin:/sbin:/usr/bin:/bin"; -# 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}; - } -} - -my @devices; my @xbuses = Zaptel::Xpp::xbuses('SORT_CONNECTOR'); sub usb_sorter() { @@ -59,7 +49,10 @@ sub xbus_of_usb($) { my $priv_device_name = shift; my $dev = shift; - my ($wanted) = grep { $priv_device_name eq $_->usb_devname } @xbuses; + my ($wanted) = grep { + defined($_->usb_devname) && + $priv_device_name eq $_->usb_devname + } @xbuses; return $wanted; } @@ -71,6 +64,9 @@ sub new($$) { if(defined $xbus) { $self->{XBUS} = $xbus; $self->{LOADED} = 'xpp_usb'; + } else { + $self->{XBUS} = undef; + $self->{LOADED} = undef; } Zaptel::Hardware::device_detected($self, sprintf("usb:%s", $self->{PRIV_DEVICE_NAME})); @@ -78,36 +74,43 @@ sub new($$) { } sub devices($) { - my $pack = shift or die "Wasn't called as a class method\n"; - return sort usb_sorter @devices; -} - -sub scan_devices($) { my $pack = shift || die; my $usb_device_list = "/proc/bus/usb/devices"; return unless (-r $usb_device_list); + my @devices; open(F, $usb_device_list) || die "Failed to open $usb_device_list: $!"; - $/ = ''; + local $/ = ''; while(<F>) { my @lines = split(/\n/); my ($tline) = grep(/^T/, @lines); my ($pline) = grep(/^P/, @lines); + my ($sline) = grep(/^S:.*SerialNumber=/, @lines); my ($busnum,$devnum) = ($tline =~ /Bus=(\w+)\W.*Dev#=\s*(\w+)\W/); my $devname = sprintf("%03d/%03d", $busnum, $devnum); my ($vendor,$product) = ($pline =~ /Vendor=(\w+)\W.*ProdID=(\w+)\W/); + my $serial; + if(defined $sline) { + $sline =~ /SerialNumber=(.*)/; + $serial = $1; + #$serial =~ s/[[:^print:]]/_/g; + } my $model = $usb_ids{"$vendor:$product"}; next unless defined $model; my $d = Zaptel::Hardware::USB->new( + IS_ASTRIBANK => ($model->{DRIVER} eq 'xpp_usb')?1:0, + BUS_TYPE => 'USB', PRIV_DEVICE_NAME => $devname, VENDOR => $vendor, PRODUCT => $product, + SERIAL => $serial, DESCRIPTION => $model->{DESCRIPTION}, DRIVER => $model->{DRIVER}, ); push(@devices, $d); } close F; + @devices = sort usb_sorter @devices; } 1; diff --git a/xpp/utils/zconf/Zaptel/Span.pm b/xpp/utils/zconf/Zaptel/Span.pm index 47a5a56..eacac8b 100644 --- a/xpp/utils/zconf/Zaptel/Span.pm +++ b/xpp/utils/zconf/Zaptel/Span.pm @@ -8,6 +8,7 @@ package Zaptel::Span; # $Id$ # use strict; +use XppUtils; use Zaptel::Chans; my $proc_base = "/proc/zaptel"; @@ -17,19 +18,6 @@ sub chans($) { return @{$span->{CHANS}}; } -# 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 by_number($) { my $span_number = shift; die "Missing span number" unless defined $span_number; @@ -47,7 +35,7 @@ my @bri_strings = ( ); my @pri_strings = ( - 'PRI_(NT|TE)' + '(E1|T1|J1)_(NT|TE)' ); our $ZAPBRI_NET = 'bri_net'; @@ -65,6 +53,9 @@ sub new($$) { open(F, "$proc_base/$num") or die "Failed to open '$proc_base/$num\n"; my $head = <F>; chomp $head; + $self->{IS_DIGITAL} = 0; + $self->{IS_BRI} = 0; + $self->{IS_PRI} = 0; foreach my $cardtype (@bri_strings) { if($head =~ m/$cardtype/) { $self->{IS_DIGITAL} = 1; @@ -80,11 +71,17 @@ sub new($$) { if($head =~ m/$cardtype/) { $self->{IS_DIGITAL} = 1; $self->{IS_PRI} = 1; - $self->{TERMTYPE} = $1; - $self->{TYPE} = "PRI_$1"; - { - $self->{DCHAN_IDX} = 15; # Depends on E1/T1/J1 + $self->{PROTO} = "$1"; + $self->{TERMTYPE} = $2; + $self->{TYPE} = "$1_$2"; + if($self->{PROTO} eq 'E1') { + $self->{DCHAN_IDX} = 15; $self->{BCHAN_LIST} = [ 0 .. 14, 16 .. 30 ]; + } elsif($self->{PROTO} eq 'T1') { + $self->{DCHAN_IDX} = 23; + $self->{BCHAN_LIST} = [ 0 .. 22 ]; + } else { + die "'$self->{PROTO}' unsupported yet"; } last; } @@ -100,8 +97,7 @@ sub new($$) { s/^\s*//; s/\s*$//; next unless /\S/; - my ($chan, $name, $signalling, $info) = split(/\s+/, $_, 4); - my $c = Zaptel::Chans->new($self, $chan, $name, $signalling, $info); + my $c = Zaptel::Chans->new($self, $_); push(@{$self->{CHANS}}, $c); } close F; @@ -125,11 +121,19 @@ sub new($$) { if($self->is_pri()) { $self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}]; $self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ]; - $self->{CODING} = 'hdb3'; + if($self->{PROTO} eq 'E1') { + $self->{CODING} = 'hdb3'; + $self->{FRAMING} = 'ccs'; + $self->{SWITCHTYPE} = 'euroisdn'; + } elsif($self->{PROTO} eq 'T1') { + $self->{CODING} = 'b8zs'; + $self->{FRAMING} = 'esf'; + $self->{SWITCHTYPE} = 'national'; + } else { + die "'$self->{PROTO}' unsupported yet"; + } $self->{YELLOW} = undef; - $self->{FRAMING} = 'ccs'; $self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $ZAPPRI_NET : $ZAPPRI_CPE ; - $self->{SWITCHTYPE} = 'euroisdn'; } return $self; } diff --git a/xpp/utils/zconf/Zaptel/Xpp.pm b/xpp/utils/zconf/Zaptel/Xpp.pm index 3c4b52c..8a2a6eb 100644 --- a/xpp/utils/zconf/Zaptel/Xpp.pm +++ b/xpp/utils/zconf/Zaptel/Xpp.pm @@ -10,35 +10,89 @@ package Zaptel::Xpp; use strict; use Zaptel::Xpp::Xbus; -my $proc_base = "/proc/xpp"; +=head1 NAME + +Zaptel::Xpp - Perl interface to the Xorcom Astribank drivers. + +=head1 SYNOPSIS -# Static Functions + # Listing all Astribanks: + use Zaptel::Xpp; + # scans hardware: + my @xbuses = Zaptel::Xpp::xbuses("SORT_CONNECTOR"); + for my $xbus (@xbuses) { + print $xbus->name." (".$xbus->label .", ". $xbus->connector .")\n"; + for my $xpd ($xbus->xpds) { + print " - ".$xpd->fqn,"\n"; + } + } +=cut + + +my $proc_base = "/proc/xpp"; # Nominal sorters for xbuses sub by_name { - return $a cmp $b; + return $a->name cmp $b->name; } sub by_connector { return $a->connector cmp $b->connector; } -sub by_serial { - my $cmp = $a->serial cmp $b->serial; +sub by_label { + my $cmp = $a->label cmp $b->label; return $cmp if $cmp != 0; return $a->connector cmp $b->connector; } +=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: + +=over + +=item SORT_CONNECTOR + +Sort by the connector string. For USB this defines the "path" to get to +the device through controllers, hubs etc. + +=item SORT_LABEL + +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). + +=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 custom function + +Instead of using a predefined sorter, you can pass your own sorting +function. See the example sorters in the code of this module. + +=back + +=cut + sub xbuses { - my $optsort = shift || 'SORT_NAME'; + my $optsort = shift || 'SORT_CONNECTOR'; my @xbuses; - -d "/proc/xpp" or return (); + -d "$proc_base" or return (); + my @lines; + local $/ = "\n"; open(F, "$proc_base/xbuses") || die "$0: Failed to open $proc_base/xbuses: $!\n"; - while(<F>) { - chomp; - my ($name, @attr) = split; + @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; @@ -46,20 +100,20 @@ sub xbuses { my $xbus = Zaptel::Xpp::Xbus->new(NAME => $name, NUM => $num, @attr); push(@xbuses, $xbus); } - close F; my $sorter; if($optsort eq "SORT_CONNECTOR") { $sorter = \&by_connector; } elsif($optsort eq "SORT_NAME") { $sorter = \&by_name; - } elsif($optsort eq "SORT_SERIAL") { - $sorter = \&by_serial; + } elsif($optsort eq "SORT_LABEL") { + $sorter = \&by_label; } elsif(ref($optsort) eq 'CODE') { $sorter = $optsort; } else { die "Unknown optional sorter '$optsort'"; } - return sort $sorter @xbuses; + @xbuses = sort $sorter @xbuses; + return @xbuses; } sub xpd_of_span($) { @@ -73,6 +127,16 @@ sub xpd_of_span($) { return undef; } +=head1 sync([new_sync_source]) + +Gets (and optionally sets) the internal Astribanks synchronization +source. When used to set sync source, returns the original sync source. + +A synchronization source is a value valid writing into /proc/xpp/sync . +For more information read that file and see README.Astribank . + +=cut + sub sync { my $newsync = shift; my $result; @@ -94,17 +158,26 @@ sub sync { } close F; if(defined($newsync)) { # Now change - open(F, ">$file") or die "Failed to open $file for writing: $!"; - if($newsync eq 'HOST') { - print F "HOST"; - } elsif($newsync =~ /^(\d+)$/) { - print F ($newapi)? "SYNC=$1" : "$1 0"; - } else { + $newsync =~ s/.*/\U$&/; + if($newsync =~ /^(\d+)$/) { + $newsync = ($newapi)? "SYNC=$1" : "$1 0"; + } 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 + +For the documentation of xbus objects, see L<Zaptel::Xpp::Xbus>. For +information about XPD objects, see L<Zaptel::Xpp::Xpd>. + +General documentation can be found in the master package L<Zaptel>. + +=cut + 1; 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; } |