[zaptel-commits] tzafrir: branch 1.2 r2223 - in
/branches/1.2/xpp/utils: ./ zconf/ zconf/Zapte...
zaptel-commits at lists.digium.com
zaptel-commits at lists.digium.com
Fri Feb 23 18:05:06 MST 2007
Author: tzafrir
Date: Fri Feb 23 19:05:05 2007
New Revision: 2223
URL: http://svn.digium.com/view/zaptel?view=rev&rev=2223
Log:
Add the Zaptel and Zaptel::Xpp perl modules, and some simple
utilities that use them. disabled by default for now.
Added:
branches/1.2/xpp/utils/lszaptel (with props)
branches/1.2/xpp/utils/xpp_sync (with props)
branches/1.2/xpp/utils/zconf/
branches/1.2/xpp/utils/zconf/Zaptel/
branches/1.2/xpp/utils/zconf/Zaptel.pm (with props)
branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm (with props)
branches/1.2/xpp/utils/zconf/Zaptel/Span.pm (with props)
branches/1.2/xpp/utils/zconf/Zaptel/Xpp/
branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm (with props)
branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm (with props)
branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm (with props)
branches/1.2/xpp/utils/zt_registration (with props)
Modified:
branches/1.2/xpp/utils/Makefile
Modified: branches/1.2/xpp/utils/Makefile
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/Makefile?view=diff&rev=2223&r1=2222&r2=2223
==============================================================================
--- branches/1.2/xpp/utils/Makefile (original)
+++ branches/1.2/xpp/utils/Makefile Fri Feb 23 19:05:05 2007
@@ -9,6 +9,8 @@
MANDIR = /usr/share/man/man8
HOTPLUG_USB_DIR = /etc/hotplug/usb
UDEV_RULES_DIR = /etc/udev/rules.d
+# Perl disabled by default, until we see it is safe:
+#PERLLIBDIR = $(shell eval `perl -V:sitelib`; echo "$$sitelib")
XPD_FIRMWARE = $(wildcard ../firmwares/*.hex)
XPD_INIT_DATA = $(XPD_FIRMWARE) init_fxo_modes
@@ -29,6 +31,11 @@
CFLAGS = -g -Wall $(EXTRA_CFLAGS)
+%.8: %
+ pod2man $^ > $@ || $(RM) $@
+PERL_SCRIPTS = zt_registration xpp_sync lszaptel
+PERL_MANS = zt_registration.8 xpp_sync.8 lszaptel.8
+
TARGETS = init_fxo_modes print_modes adj_clock
PROG_INSTALL = genzaptelconf adj_clock
MAN_INSTALL = genzaptelconf.8 adj_clock.8
@@ -37,8 +44,14 @@
PROG_INSTALL += fpga_load
MAN_INSTALL += fpga_load.8
endif
+ifneq (,$(PERLLIBDIR))
+PROG_INSTALL += $(PERL_SCRIPTS)
+MAN_INSTALL += $(PERL_MANS)
+endif
all: $(TARGETS)
+
+docs: $(PERL_MANS)
install: all
$(INSTALL) -d $(DESTDIR)$(SBINDIR)
@@ -53,6 +66,17 @@
$(INSTALL) xpp_fxloader $(DESTDIR)$(HOTPLUG_USB_DIR)/
$(INSTALL) -d $(DESTDIR)$(UDEV_RULES_DIR)
$(INSTALL_DATA) xpp.rules $(DESTDIR)$(UDEV_RULES_DIR)/
+ifneq (,$(PERLLIBDIR))
+ $(INSTALL) -d $(DESTDIR)$(PERLLIBDIR)
+ for i in Zaptel Zaptel/Xpp; \
+ do \
+ $(INSTALL) -d "$(DESTDIR)$(PERLLIBDIR)/$$i"; \
+ done
+ for i in Zaptel.pm Zaptel/Xpp/Xbus.pm Zaptel/Xpp/Xpd.pm Zaptel/Xpp.pm Zaptel/Span.pm Zaptel/Chans.pm; \
+ do \
+ $(INSTALL_DATA) "zconf/$$i" "$(DESTDIR)$(PERLLIBDIR)/$$i"; \
+ done
+endif
libhexfile.a: hexfile.o
$(AR) cru $@ $^
Added: branches/1.2/xpp/utils/lszaptel
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/lszaptel?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/lszaptel (added)
+++ branches/1.2/xpp/utils/lszaptel Fri Feb 23 19:05:05 2007
@@ -1,0 +1,54 @@
+#! /usr/bin/perl -w
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+BEGIN { my $dir = $0; $dir =~ s:/[^/]+$::; unshift(@INC, "$dir", "$dir/zconf"); }
+
+use Zaptel;
+use Zaptel::Span;
+
+foreach my $span (Zaptel::spans()) {
+ printf "### Span %2d: %s %s\n", $span->num, $span->name, $span->description;
+ foreach my $chan ($span->chans()) {
+ my %type_map = (
+ OUT => 'Output',
+ IN => 'Input'
+ );
+ my ($type) = map { $type_map{$_} or $_ } $chan->type;
+ printf "%3d %s\n", $chan->num, $type;
+ }
+}
+
+__END__
+
+=head1 NAME
+
+lszaptel - List all zaptel channels with their types and spans.
+
+=head1 SYNOPSIS
+
+lszaptel
+
+=head1 DESCRIPTION
+
+Example output:
+
+ ### Span 1: XBUS-03/XPD-00 "Xorcom XPD #3/0: FXS"
+ 1 FXS
+ 2 FXS
+ 3 FXS
+ 4 FXS
+ 5 FXS
+ 6 FXS
+ 7 FXS
+ 8 FXS
+ 9 Output
+ 10 Output
+ 11 Input
+ 12 Input
+ 13 Input
+ 14 Input
Propchange: branches/1.2/xpp/utils/lszaptel
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/lszaptel
------------------------------------------------------------------------------
svn:executable = *
Propchange: branches/1.2/xpp/utils/lszaptel
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/lszaptel
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/xpp_sync
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/xpp_sync?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/xpp_sync (added)
+++ branches/1.2/xpp/utils/xpp_sync Fri Feb 23 19:05:05 2007
@@ -1,0 +1,152 @@
+#! /usr/bin/perl -w
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+BEGIN { my $dir = $0; $dir =~ s:/[^/]+$::; unshift(@INC, "$dir", "$dir/zconf"); }
+
+use Zaptel::Xpp;
+use Zaptel::Xpp::Xbus;
+
+my $sync;
+my $autoselect;
+
+if(@ARGV == 1) {
+ $sync = shift;
+ $autoselect = 1 if $sync =~ /^auto$/i;
+}
+
+sub get_sorted_xpds() {
+ my @good_xpds;
+
+ foreach my $xbus (Zaptel::Xpp::xbuses('SORT_CONNECTOR')) {
+ next unless $xbus->status eq 'CONNECTED';
+ foreach my $xpd ($xbus->xpds()) {
+ my $isreg = $xpd->zt_registration();
+ if(!defined($isreg)) { # Failure
+ printf STDERR "%s: Failed %s\n", $xpd->fqn, $!;
+ next;
+ }
+ next unless $isreg; # Skip unregistered XPDs
+ push(@good_xpds, $xpd);
+ }
+ }
+
+ my @bri_xpds = grep { $_->type =~ /BRI/; } @good_xpds;
+ my @fxo_xpds = grep { $_->type eq 'FXO'; } @good_xpds;
+ my @fxs_xpds = grep { $_->type eq 'FXS'; } @good_xpds;
+ return (@bri_xpds, @fxo_xpds, @fxs_xpds);
+}
+
+sub do_select(@) {
+ my $found;
+
+ foreach my $xpd (@_) {
+ my $xbus = $xpd->xbus;
+ my $busnum = $xbus->name;
+ die "Uknown bus name" unless $busnum;
+ $busnum =~ s/XBUS-//;
+ die "bad bus name" unless $busnum =~ /^\d+$/;
+ #printf "Setting sync: %-10s (%s)\n", $xpd->fqn, $xpd->type;
+ if(Zaptel::Xpp::sync($busnum)) {
+ #print "SET $busnum\n";
+ $found = 1;
+ last;
+ } else {
+ print STDERR "Failed to set $busnum: $!\n";
+ }
+ }
+ if(!$found) {
+ print STDERR "Fall back to HOST sync\n";
+ die "Failed to set HOST sync\n" unless Zaptel::Xpp::sync('HOST');
+ }
+}
+
+sub do_set($) {
+ my $sync = shift;
+ die "Failed to set sync to '$sync'" unless Zaptel::Xpp::sync($sync);
+}
+
+my $curr_sync = Zaptel::Xpp::sync;
+my %xbus_seen;
+my @sorted_xpds = grep { !$xbus_seen{$_->xbus}++; } get_sorted_xpds;
+if($sync) {
+ if($autoselect) {
+ do_select(@sorted_xpds);
+ } else {
+ $sync = uc($sync);
+ do_set($sync);
+ }
+ #print "New sync: ", Zaptel::Xpp::sync, "\n";
+} else {
+ print "Current sync: ", $curr_sync, "\n";
+ print "Best Available Syncers:\n";
+ foreach my $xpd (@sorted_xpds) {
+ my $xbus = $xpd->xbus;
+ my @xpds = $xbus->xpds;
+ my @types = map { $_->type } @xpds;
+ my $mark = ($curr_sync =~ /\d+/ and $xbus->num == $curr_sync)?"+":"";
+ printf "\t%1s %s [ ", $mark, $xbus->name;
+ my $next = 0;
+ foreach my $x (sort { $a->num <=> $b->num } @xpds) {
+ my $n = $x->num;
+ # Fill spaces
+ for(my $i = $next; $i < $n; $i++) {
+ printf "%-3s ", "";
+ }
+ printf "%-3s ", $x->type;
+ $next = $n + 1;
+ }
+ # Fill spaces to end
+ $n = 4;
+ for(my $i = $next; $i < $n; $i++) {
+ printf "%-3s ", "";
+ }
+ printf "] (%s)\n", $xbus->connector;
+ }
+}
+
+__END__
+
+=head1 NAME
+
+xpp_sync - Handle sync selection of Xorcom XPD's.
+
+=head1 SYNOPSIS
+
+xpp_sync [auto|host|nn]
+
+=head1 DESCRIPTION
+
+Without parameters, the current syncer. Either HOST or the XBUS number.
+Then a list of the 3 best XPD's for syncing.
+
+=head2 Parameters
+
+=over
+
+=item auto
+
+Automatically selects the best XPD for syncing (with HOST fallback).
+
+=item host
+
+Set HOST synchronization (XPP timers).
+
+=item nn
+
+Set XBUS number nn as sync source.
+
+=back
+
+=head2 Example output:
+
+ Current sync: 03
+ Best Available Syncers:
+ XBUS-00: FXS FXO (USB-0000:00:10.4-4)
+ + XBUS-03: FXS FXS FXS FXS (USB-0000:00:10.4-1)
+ XBUS-02: FXS FXS FXS FXS (USB-0000:00:10.4-2)
+ XBUS-01: FXS FXS FXS FXS (USB-0000:00:10.4-3)
Propchange: branches/1.2/xpp/utils/xpp_sync
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/xpp_sync
------------------------------------------------------------------------------
svn:executable = *
Propchange: branches/1.2/xpp/utils/xpp_sync
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/xpp_sync
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/zconf/Zaptel.pm
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/zconf/Zaptel.pm?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/zconf/Zaptel.pm (added)
+++ branches/1.2/xpp/utils/zconf/Zaptel.pm Fri Feb 23 19:05:05 2007
@@ -1,0 +1,24 @@
+package Zaptel;
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+
+my $proc_base = "/proc/zaptel";
+
+sub spans() {
+ my @spans;
+
+ -d $proc_base or die "Missing '$proc_base'. Perhaps zaptel module isn't loaded?\n";
+ foreach my $zfile (glob "$proc_base/*") {
+ $zfile =~ s:$proc_base/::;
+ my $span = Zaptel::Span->new($zfile);
+ push(@spans, $span);
+ }
+ return sort { $a->num <=> $b->num } @spans;
+}
+
+1;
Propchange: branches/1.2/xpp/utils/zconf/Zaptel.pm
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/zconf/Zaptel.pm
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/zconf/Zaptel.pm
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm (added)
+++ branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm Fri Feb 23 19:05:05 2007
@@ -1,0 +1,46 @@
+package Zaptel::Chans;
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+
+# Accessors (miniperl does not have Class:Accessor)
+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 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 $info = shift;
+ my $self = {};
+ bless $self, $pack;
+ $self->span($span);
+ $self->num($num);
+ $self->fqn($fqn);
+ $self->info($info);
+ my $type;
+ if($fqn =~ m|\bXPP_(\w+)/.*$|) {
+ $type = $1; # One of our AB
+ } elsif(defined $info) {
+ $type = (split(/\s+/, $info))[0];
+ } else {
+ $type = $fqn;
+ }
+ $self->type($type);
+ return $self;
+}
+
+1;
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Chans.pm
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/zconf/Zaptel/Span.pm
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/zconf/Zaptel/Span.pm?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/zconf/Zaptel/Span.pm (added)
+++ branches/1.2/xpp/utils/zconf/Zaptel/Span.pm Fri Feb 23 19:05:05 2007
@@ -1,0 +1,53 @@
+package Zaptel::Span;
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+use Zaptel::Chans;
+
+my $proc_base = "/proc/zaptel";
+
+sub chans($) {
+ my $span = shift;
+ return @{$span->{CHANS}};
+}
+
+# Accessors (miniperl does not have Class:Accessor)
+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 new($$) {
+ my $pack = shift or die "Wasn't called as a class method\n";
+ my $num = shift or die "Missing a span number parameter\n";
+ my $self = { NUM => $num };
+ bless $self, $pack;
+ open(F, "$proc_base/$num") or die "Failed to open '$proc_base/$num\n";
+ my $head = <F>;
+ chomp $head;
+ ($self->{NAME}, $self->{DESCRIPTION}) = (split(/\s+/, $head, 4))[2, 3];
+ $self->{CHANS} = [];
+ while(<F>) {
+ chomp;
+ s/^\s*//;
+ s/\s*$//;
+ next unless /\S/;
+ my ($chan, $name, $info) = split(/\s+/, $_, 3);
+ my $c = Zaptel::Chans->new($self, $chan, $name, $info);
+ push(@{$self->{CHANS}}, $c);
+ }
+ close F;
+ return $self;
+}
+
+1;
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Span.pm
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Span.pm
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Span.pm
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm (added)
+++ branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm Fri Feb 23 19:05:05 2007
@@ -1,0 +1,88 @@
+package Zaptel::Xpp;
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+use Zaptel::Xpp::Xbus;
+
+my $proc_base = "/proc/xpp";
+
+# Static Functions
+
+# Nominal sorters for xbuses
+sub by_name {
+ return $a cmp $b;
+}
+
+sub by_connector {
+ return $a->connector cmp $b->connector;
+}
+
+sub xbuses {
+ my $optsort = shift || 'SORT_NAME';
+ my @xbuses;
+
+ open(F, "$proc_base/xbuses") ||
+ die "$0: Failed to open $proc_base/xbuses. xpp module is loaded?\n";
+ while(<F>) {
+ chomp;
+ my ($name, @attr) = split;
+ $name =~ s/://;
+ $name =~ /XBUS-(\d\d)/ or die "Bad XBUS number: $name";
+ my $num = $1;
+ @attr = map { $_ = uc($_); split(/=/); } @attr;
+ 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(ref($optsort) eq 'CODE') {
+ $sorter = $optsort;
+ } else {
+ die "Unknown optional sorter '$optsort'";
+ }
+ return sort $sorter @xbuses;
+}
+
+sub sync {
+ my $newsync = shift;
+ my $result;
+ my $newapi = 0;
+
+ my $file = "$proc_base/sync";
+ die "$file is missing" unless -f $file;
+ # First query
+ open(F, "$file") or die "Failed to open $file for reading: $!";
+ while(<F>) {
+ chomp;
+ /SYNC=/ and $newapi = 1;
+ s/#.*//;
+ if(/\S/) { # First non-comment line
+ s/^SYNC=\D*// if $newapi;
+ $result = $_;
+ last;
+ }
+ }
+ 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 {
+ die "Bad sync parameter '$newsync'";
+ }
+ close(F) or die "Failed in closing $file: $!";
+ }
+ return $result;
+}
+
+1;
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp.pm
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm (added)
+++ branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm Fri Feb 23 19:05:05 2007
@@ -1,0 +1,50 @@
+package Zaptel::Xpp::Xbus;
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+use Zaptel::Xpp::Xpd;
+
+my $proc_base = "/proc/xpp";
+
+# Accessors (miniperl does not have Class:Accessor)
+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}};
+}
+
+sub new($$) {
+ my $pack = shift or die "Wasn't called as a class method\n";
+ my $self = { @_ };
+ bless $self, $pack;
+ $self->{NAME} or die "Missing xbus name";
+ my $prefix = "$proc_base/" . $self->{NAME};
+ 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
+ );
+ push(@{$self->{XPDS}}, $xpd);
+ }
+ return $self;
+}
+
+1;
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm (added)
+++ branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm Fri Feb 23 19:05:05 2007
@@ -1,0 +1,64 @@
+package Zaptel::Xpp::Xpd;
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+
+my $proc_base = "/proc/xpp";
+
+# Accessors (miniperl does not have Class:Accessor)
+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 zt_registration($$) {
+ my $self = shift;
+ my $on = shift;
+ my $result;
+
+ my $file = "$proc_base/" . $self->fqn . "/zt_registration";
+ 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;
+ if(defined($on) and $on ne $result) { # Now change
+ open(F, ">$file") or die "Failed to open $file for writing: $!";
+ print F ($on)?"1":"0";
+ if(!close(F)) {
+ if($! == 17) { # EEXISTS
+ # good
+ } else {
+ undef $result;
+ }
+ }
+ }
+ return $result;
+}
+
+sub new($$) {
+ my $pack = shift or die "Wasn't called as a class method\n";
+ my $self = { @_ };
+ bless $self, $pack;
+ my $dir = "$proc_base/" . $self->fqn;
+ $self->{DIR} = $dir;
+ my ($name) = glob "$dir/*_info";
+ die "Missing info file in $dir" unless $name;
+ $name =~ s|^.*/||; # basename
+ die "Bad info file name ($name) in $dir" if $name !~ /(\w+)_info/;
+ $self->{TYPE} = uc($1);
+ return $self;
+}
+
+1;
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
------------------------------------------------------------------------------
svn:mime-type = text/plain
Added: branches/1.2/xpp/utils/zt_registration
URL: http://svn.digium.com/view/zaptel/branches/1.2/xpp/utils/zt_registration?view=auto&rev=2223
==============================================================================
--- branches/1.2/xpp/utils/zt_registration (added)
+++ branches/1.2/xpp/utils/zt_registration Fri Feb 23 19:05:05 2007
@@ -1,0 +1,77 @@
+#! /usr/bin/perl -w
+#
+# Written by Oron Peled <oron at actcom.co.il>
+# Copyright (C) 2007, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#use strict;
+BEGIN { my $dir = $0; $dir =~ s:/[^/]+$::; unshift(@INC, "$dir", "$dir/zconf"); }
+
+use Zaptel;
+use Zaptel::Span;
+use Zaptel::Xpp;
+use Zaptel::Xpp::Xbus;
+
+sub usage {
+ die "Usage: $0 [on|off|1|0]\n";
+}
+
+ at ARGV == 0 or @ARGV == 1 or usage;
+my $on = shift;
+
+if(defined($on)) { # Translate to booleans
+ $on = uc($on);
+ $on =~ /^(ON|OFF|1|0)$/ or usage;
+ $on = ($on eq 'ON') ? 1 : 0;
+}
+
+sub state2str($) {
+ return (shift)?"on":"off";
+}
+
+my @spans = Zaptel::spans;
+
+foreach my $xbus (Zaptel::Xpp::xbuses('SORT_CONNECTOR')) {
+ printf "%-10s\t\t%s\n", $xbus->name, $xbus->connector;
+ next unless $xbus->status eq 'CONNECTED';
+ foreach my $xpd ($xbus->xpds()) {
+ my $prev = $xpd->zt_registration($on);
+ printf "\t%-10s: ", $xpd->fqn;
+ if(!defined($on)) { # Query only
+ my ($span) = grep { $_->name eq $xpd->fqn } @spans;
+ my $spanstr = ($span) ? ("Span " . $span->num) : "";
+ printf "%s %s\n", state2str($prev), $spanstr;
+ next;
+ }
+ if(!defined($prev)) { # Failure
+ printf "Failed %s\n", $!;
+ next;
+ }
+ printf("%3s ==> %3s\n", state2str($prev), state2str($on));
+ }
+}
+
+__END__
+
+=head1 NAME
+
+zt_registration - Handle registration of Xorcom XPD modules in zaptel.
+
+=head1 SYNOPSIS
+
+zt_registration [on|off]
+
+=head1 DESCRIPTION
+
+Without parameters, show all connected XPD's sorted by physical connector order.
+Each one is show to be unregistered (off), or registered to a specific zaptel span
+(the span number is shown).
+
+All registerations/deregisterations are sorted by physical connector string.
+
+=head2 Parameters
+
+off -- deregisters all XPD's from zaptel.
+
+on -- registers all XPD's to zaptel.
Propchange: branches/1.2/xpp/utils/zt_registration
------------------------------------------------------------------------------
svn:eol-style = native
Propchange: branches/1.2/xpp/utils/zt_registration
------------------------------------------------------------------------------
svn:executable = *
Propchange: branches/1.2/xpp/utils/zt_registration
------------------------------------------------------------------------------
svn:keywords = Author Date Id Revision
Propchange: branches/1.2/xpp/utils/zt_registration
------------------------------------------------------------------------------
svn:mime-type = text/plain
More information about the zaptel-commits
mailing list