Add the Zaptel and Zaptel::Xpp perl modules, and some simple

utilities that use them. disabled by default for now.


git-svn-id: http://svn.digium.com/svn/zaptel/branches/1.2@2223 5390a7c7-147a-4af0-8ec9-7488f05a26cb

6 files changed, 325 insertions, 0 deletions

diff --git a/xpp/utils/zconf/Zaptel.pm b/xpp/utils/zconf/Zaptel.pm
new file mode 100644
index 0000000..394aa8e
--- /dev/null
+++ b/xpp/utils/zconf/Zaptel.pm
@@ -0,0 +1,24 @@
+package Zaptel;
+#
+# Written by Oron Peled <oron@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;
diff --git a/xpp/utils/zconf/Zaptel/Chans.pm b/xpp/utils/zconf/Zaptel/Chans.pm
new file mode 100644
index 0000000..31bc5f7
--- /dev/null
+++ b/xpp/utils/zconf/Zaptel/Chans.pm
@@ -0,0 +1,46 @@
+package Zaptel::Chans;
+#
+# Written by Oron Peled <oron@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;
diff --git a/xpp/utils/zconf/Zaptel/Span.pm b/xpp/utils/zconf/Zaptel/Span.pm
new file mode 100644
index 0000000..08ebae2
--- /dev/null
+++ b/xpp/utils/zconf/Zaptel/Span.pm
@@ -0,0 +1,53 @@
+package Zaptel::Span;
+#
+# Written by Oron Peled <oron@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;
diff --git a/xpp/utils/zconf/Zaptel/Xpp.pm b/xpp/utils/zconf/Zaptel/Xpp.pm
new file mode 100644
index 0000000..b627438
--- /dev/null
+++ b/xpp/utils/zconf/Zaptel/Xpp.pm
@@ -0,0 +1,88 @@
+package Zaptel::Xpp;
+#
+# Written by Oron Peled <oron@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;
diff --git a/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm b/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
new file mode 100644
index 0000000..0f27d76
--- /dev/null
+++ b/xpp/utils/zconf/Zaptel/Xpp/Xbus.pm
@@ -0,0 +1,50 @@
+package Zaptel::Xpp::Xbus;
+#
+# Written by Oron Peled <oron@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;
diff --git a/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm b/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
new file mode 100644
index 0000000..180b7ea
--- /dev/null
+++ b/xpp/utils/zconf/Zaptel/Xpp/Xpd.pm
@@ -0,0 +1,64 @@
+package Zaptel::Xpp::Xpd;
+#
+# Written by Oron Peled <oron@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;