XPP utilities rename: first moves.

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

12 files changed, 1705 insertions, 0 deletions

diff --git a/xpp/perl_modules/Zaptel.pm b/xpp/perl_modules/Zaptel.pm
new file mode 100644
index 0000000..ef36bae
--- /dev/null
+++ b/xpp/perl_modules/Zaptel.pm
@@ -0,0 +1,68 @@
+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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Span;
+
+=head1 NAME
+
+Zaptel - Perl interface to Zaptel information
+
+This package allows access from Perl to information about Zaptel
+hardware and loaded Zaptel devices.
+
+=head1 SYNOPSIS
+
+  # Listing channels in analog spans:
+  use Zaptel;
+  # scans system:
+  my @xbuses = Zaptel::spans();
+  for my $span (@spans) {
+    next if ($span->is_digital);
+     $span->num. " - [". $span->type ."] ". $span->name. "\n";
+    for my $chan ($span->chans) {
+      print " - ".$chan->num . " - [". $chan->type. "] ". $chan->fqn". \n";
+    }
+  }
+=cut
+
+my $proc_base = "/proc/dahdi";
+
+=head1 spans()
+
+Returns a list of span objects, ordered by span number.
+
+=cut
+
+sub spans() {
+	my @spans;
+
+	-d $proc_base or return ();
+	foreach my $zfile (glob "$proc_base/*") {
+		$zfile =~ s:$proc_base/::;
+		my $span = Zaptel::Span->new($zfile);
+		push(@spans, $span);
+	}
+	@spans = sort { $a->num <=> $b->num } @spans;
+	return @spans;
+}
+
+=head1 SEE ALSO
+
+Span objects: L<Zaptel::Span>.
+
+Zaptel channels objects: L<Zaptel::Chan>.
+
+Zaptel hardware devices information: L<Zaptel::Hardware>.
+
+Xorcom Astribank -specific information: L<Zaptel::Xpp>.
+
+=cut
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Chans.pm b/xpp/perl_modules/Zaptel/Chans.pm
new file mode 100644
index 0000000..6f83f77
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Chans.pm
@@ -0,0 +1,202 @@
+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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Utils;
+
+=head1 NAME
+
+Zaptel::Chans - Perl interface to a Zaptel channel information
+
+This package allows access from perl to information about a Zaptel
+channel. It is part of the Zaptel Perl package.
+
+=head1 battery()
+
+Returns 1 if channel reports to have battery (A remote PBX connected to
+an FXO port), 0 if channel reports to not have battery and C<undef>
+otherwise.
+
+Currently only wcfxo and Astribank FXO modules report battery. For the
+rest of the channels 
+
+=head1 fqn()
+
+(Fully Qualified Name) Returns the full "name" of the channel.
+
+=head1 index()
+
+Returns the number of this channel (in the span).
+
+=head1 num()
+
+Returns the number of this channel as a Zaptel channel.
+
+=head signalling()
+
+Returns the signalling set for this channel through /etc/zaptel.conf .
+This is always empty before ztcfg was run. And shows the "other" type
+for FXS and for FXO.
+
+=head1 span()
+
+Returns a reference to the span to which this channel belongs.
+
+=head1 type()
+
+Returns the type of the channel: 'FXS', 'FXO', 'EMPTY', etc.
+
+=cut
+
+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 $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 $info = '';
+	if(defined $rest) {
+		if($rest =~ s/^\s*(\w+)\s*//) {
+			$signalling = $1;
+		}
+		if($rest =~ s/(.*)//) {
+			$info = $1;
+		}
+	}
+	$self->{NUM} = $num;
+	$self->{FQN} = $fqn;
+	$self->{SIGNALLING} = $signalling;
+	$self->{INFO} = $info;
+	my $type;
+	if($fqn =~ m|\bXPP_(\w+)/.*$|) {
+		$type = $1;		# An Astribank
+	} elsif ($fqn =~ m{\bWCFXO/.*}) {
+		$type = "FXO"; # wcfxo - x100p and relatives.
+		# A single port card. The driver issue RED alarm when
+		# There's no better
+		$self->{BATTERY} = !($span->description =~ /\bRED\b/);
+	} elsif ($fqn =~ m{\bFXS/.*}) {
+		$type = "FXS"; # likely Rhino
+	} elsif ($fqn =~ m{\bFXO/.*}) {
+		$type = "FXO"; # likely Rhino
+	} 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
+		# WCT1: Digium single span card drivers?
+		# Tor2: Tor PCI cards
+		# TorISA: ISA ones (still used?) 
+		# WP[TE]1: Sangoma. TODO: this one tells us if it is TE or NT.
+		# cwain: Junghanns E1 card.
+		$type = "PRI";
+	} elsif ($fqn =~ m{\b(ZTHFC%d*|ztqoz\d*)/.*}) {
+		# ZTHFC: HFC-s single-port card (zaphfc/vzaphfc)
+		# ztqoz: qozap (Junghanns) multi-port HFC card
+		$type = "BRI";
+	} elsif ($fqn =~ m{\bztgsm/.*}) {
+		# Junghanns GSM card
+		$type = "GSM";
+	} elsif(defined $signalling) {
+		$type = 'FXS' if $signalling =~ /^FXS/;
+		$type = 'FXO' if $signalling =~ /^FXO/;
+	} else {
+		$type = undef;
+	}
+	$self->type($type);
+	$self->span()->type($type)
+		if ! defined($self->span()->type()) ||
+			$self->span()->type() eq 'UNKNOWN';
+	return $self;
+}
+
+=head1 probe_type()
+
+In the case of some cards, the information in /proc/zaptel is not good
+enough to tell the type of each channel. In this case an extra explicit
+probe is needed.
+
+Currently this is implemented by using some invocations of ztcfg(8).
+
+It may later be replaced by ztscan(8).
+
+=cut
+
+my $ztcfg = $ENV{ZTCFG} || '/sbin/ztcfg';
+sub probe_type($) {
+	my $self = shift;
+	my $fqn = $self->fqn;
+	my $num = $self->num;
+	my $type;
+
+	if($fqn =~ m:WCTDM/| WRTDM/|OPVXA1200/:) {
+		my %maybe;
+
+		undef %maybe;
+		foreach my $sig (qw(fxo fxs)) {
+			my $cmd = "echo ${sig}ks=$num | $ztcfg -c /dev/fd/0";
+
+			$maybe{$sig} = system("$cmd >/dev/null 2>&1") == 0;
+		}
+		if($maybe{fxo} and $maybe{fxs}) {
+			$type = 'EMPTY';
+		} elsif($maybe{fxo}) {
+			$type = 'FXS';
+		} elsif($maybe{fxs}) {
+			$type = 'FXO';
+		} else {
+			$type = 'EMPTY';
+		}
+	} else {
+		$type = $self->type;
+	}
+	return $type;
+}
+
+sub battery($) {
+	my $self = shift or die;
+	my $span = $self->span or die;
+
+	return undef unless $self->type eq 'FXO';
+	return $self->{BATTERY} if defined $self->{BATTERY};
+
+	my $xpd = $span->xpd;
+	my $index = $self->index;
+	return undef if !$xpd;
+
+	# It's an XPD (FXO)
+	my @lines = @{$xpd->lines};
+	my $line = $lines[$index];
+	return $line->battery;
+}
+
+sub blink($$) {
+	my $self = shift or die;
+	my $on = shift;
+	my $span = $self->span or die;
+
+	my $xpd = $span->xpd;
+	my $index = $self->index;
+	return undef if !$xpd;
+
+	my @lines = @{$xpd->lines};
+	my $line = $lines[$index];
+	return $line->blink($on);
+}
+
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Config/Defaults.pm b/xpp/perl_modules/Zaptel/Config/Defaults.pm
new file mode 100644
index 0000000..360ca0a
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Config/Defaults.pm
@@ -0,0 +1,56 @@
+package Zaptel::Config::Defaults;
+#
+# 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.
+#
+# $Id$
+#
+use strict;
+
+# Use the shell to source a file and expand a given list
+# of variables.
+sub do_source($@) {
+	my $file = shift;
+	my @vars = @_;
+	my @output = `env -i sh -ec '. $file; export @vars; for i in @vars; do eval echo \$i=\\\$\$i; done'`;
+	die "$0: Sourcing '$file' exited with $?" if $?;
+	my %vars;
+	
+	foreach my $line (@output) {
+		chomp $line;
+		my ($k, $v) = split(/=/, $line, 2);
+		$vars{$k} = $v if grep /^$k$/, @vars;
+	}
+	return %vars;
+}
+
+sub source_vars {
+	my @vars = @_;
+	my $default_file;
+	my %system_files = (
+			"/etc/default/zaptel"	=> 'Debian and friends',
+			"/etc/sysconfig/zaptel"	=> 'Red Hat and friends',
+		);
+
+	if(defined $ENV{ZAPTEL_DEFAULTS}) {
+		$default_file = $ENV{ZAPTEL_DEFAULTS};
+	} else {
+		foreach my $f (keys %system_files) {
+			if(-r $f) {
+				if(defined $default_file) {
+					die "An '$f' collides with '$default_file'";
+				}
+				$default_file = $f;
+			}
+		}
+	}
+	if (! $default_file) {
+		return ("", ());
+	}
+	my %vars = Zaptel::Config::Defaults::do_source($default_file, @vars);
+	return ($default_file, %vars);
+}
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Hardware.pm b/xpp/perl_modules/Zaptel/Hardware.pm
new file mode 100644
index 0000000..ff7aeea
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Hardware.pm
@@ -0,0 +1,168 @@
+package Zaptel::Hardware;
+#
+# 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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Hardware::USB;
+use Zaptel::Hardware::PCI;
+
+=head1 NAME
+
+Zaptel::Hardware - Perl interface to a Zaptel devices listing
+
+
+  use Zaptel::Hardware;
+  
+  my $hardware = Zaptel::Hardware->scan; 
+  
+  # mini zaptel_hardware:
+  foreach my $device ($hardware->device_list) {
+    print "Vendor: device->{VENDOR}, Product: $device->{PRODUCT}\n"
+  }
+
+  # let's see if there are devices without loaded drivers, and sugggest
+  # drivers to load:
+  my @to_load = ();
+  foreach my $device ($hardware->device_list) {
+    if (! $device->{LOADED} ) {
+      push @to_load, ($device->${DRIVER});
+    }
+  }
+  if (@to_load) {
+    print "To support the extra devices you probably need to run:\n"
+    print "  modprobe ". (join ' ', @to_load). "\n";
+  }
+
+
+This module provides information about available Zaptel devices on the
+system. It identifies devices by (USB/PCI) bus IDs.
+
+
+=head1 Device Attributes
+As usual, object attributes can be used in either upp-case or
+lower-case, or lower-case functions.
+
+=head2 bus_type
+
+'PCI' or 'USB'.
+
+
+=head2 description
+
+A one-line description of the device.
+
+
+=head2 driver
+
+Name of a Zaptel device driver that should handle this device. This is
+based on a pre-made list.
+
+
+=head2 vendor, product, subvendor, subproduct
+
+The PCI and USB vendor ID, product ID, sub-vendor ID and sub-product ID.
+(The standard short lspci and lsusb listings show only vendor and
+product IDs).
+
+
+=head2 loaded
+
+If the device is handled by a module - the name of the module. Else -
+undef.
+
+
+=head2 priv_device_name
+
+A string that shows the "location" of that device on the bus.
+
+
+=head2 is_astribank
+
+True if the device is a Xorcom Astribank (which may provide some extra
+attributes).
+
+=head2 serial
+
+(Astribank-specific attrribute) - the serial number string of the
+Astribank.
+
+=cut
+
+sub device_detected($$) {
+	my $dev = shift || die;
+	my $name =  shift || die;
+	die unless defined $dev->{'BUS_TYPE'};
+	$dev->{IS_ASTRIBANK} = 0 unless defined $dev->{'IS_ASTRIBANK'};
+	$dev->{'HARDWARE_NAME'} = $name;
+}
+
+sub device_removed($) {
+	my $dev = shift || die;
+	my $name = $dev->hardware_name;
+	die "Missing zaptel device hardware name" unless $name;
+}
+
+
+=head1 device_list()
+
+Returns a list of the hardware devices on the system.
+
+You must run scan() first for this function to run meaningful output.
+
+=cut
+
+sub device_list($) {
+	my $self = shift || die;
+	my @types = @_;
+	my @list;
+
+	@types = qw(USB PCI) unless @types;
+	foreach my $t (@types) {
+		@list = ( @list, @{$self->{$t}} );
+	}
+	return @list;
+}
+
+
+=head1 drivers()
+
+Returns a list of drivers (currently sorted by name) that are used by
+the devices in the current system (regardless to whether or not they are
+loaded.
+
+=cut
+
+sub drivers($) {
+	my $self = shift || die;
+	my @devs = $self->device_list;
+	my @drvs = map { $_->{DRIVER} } @devs;
+	# Make unique
+	my %drivers;
+	@drivers{@drvs} = 1;
+	return sort keys %drivers;
+}
+
+
+=head1 scan()
+
+Scan the system for Zaptel devices (PCI and USB). Returns nothing but
+must be run to initialize the module.
+
+=cut
+
+sub scan($) {
+	my $pack = shift || die;
+	my $self = {};
+	bless $self, $pack;
+
+	$self->{USB} = [ Zaptel::Hardware::USB->devices ];
+	$self->{PCI} = [ Zaptel::Hardware::PCI->scan_devices ];
+	return $self;
+}
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Hardware/PCI.pm b/xpp/perl_modules/Zaptel/Hardware/PCI.pm
new file mode 100644
index 0000000..a63b09f
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Hardware/PCI.pm
@@ -0,0 +1,208 @@
+package Zaptel::Hardware::PCI;
+#
+# 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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Utils;
+use Zaptel::Hardware;
+
+our @ISA = qw(Zaptel::Hardware);
+
+# Lookup algorithm:
+# 	First match 'vendor:product/subvendor:subproduct' key
+#	Else match 'vendor:product/subvendor' key
+#	Else match 'vendor:product' key
+#	Else not a zaptel hardware.
+my %pci_ids = (
+	# from wct4xxp
+	'10ee:0314'		=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P/TE405P (1st Gen)' },
+	'd161:0420/0004'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE420 (4th Gen)' },
+	'd161:0410/0004'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P (4th Gen)' },
+	'd161:0405/0004'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE405P (4th Gen)' },
+	'd161:0410/0003'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P (3rd Gen)' },
+	'd161:0405/0003'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE405P (3rd Gen)' },
+	'd161:0410'		=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P (2nd Gen)' },
+	'd161:0405'		=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE405P (2nd Gen)' },
+	'd161:0220/0004'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE220 (4th Gen)' },
+	'd161:0205/0004'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE205P (4th Gen)' },
+	'd161:0210/0004'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE210P (4th Gen)' },
+	'd161:0205/0003'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE205P (3rd Gen)' },
+	'd161:0210/0003'	=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE210P (3rd Gen)' },
+	'd161:0205'		=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE205P ' },
+	'd161:0210'		=> { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE210P ' },
+
+	# from wctdm24xxp
+	'd161:2400'		=> { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard TDM2400P' },
+	'd161:0800'		=> { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard TDM800P' },
+	'd161:8002'		=> { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard AEX800' },
+	'd161:8003'		=> { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard AEX2400' },
+	'd161:8005'		=> { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard TDM410P' },
+	'd161:8006'		=> { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard AEX410P' },
+
+	# from pciradio
+	'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 => 'Wildcard X101P clone' },
+	'e159:0001/8087'	=> { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P clone' },
+	'1057:5608'		=> { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X100P' },
+
+	# from wct1xxp
+	'e159:0001/6159'	=> { DRIVER => 'wct1xxp', DESCRIPTION => 'Digium Wildcard T100P T1/PRI or E100P E1/PRA Board' },
+
+	# from wctdm
+	'e159:0001/a159'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard S400P Prototype' },
+	'e159:0001/e159'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard S400P Prototype' },
+	'e159:0001/b100'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV E/F' },
+	'e159:0001/b1d9'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV I' },
+	'e159:0001/b118'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV I' },
+	'e159:0001/b119'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV I' },
+	'e159:0001/a9fd'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' },
+	'e159:0001/a8fd'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' },
+	'e159:0001/a800'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' },
+	'e159:0001/a801'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' },
+	'e159:0001/a908'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' },
+	'e159:0001/a901'	=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' },
+	#'e159:0001'		=> { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' },
+
+	# from wcte11xp
+	'e159:0001/71fe'	=> { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' },
+	'e159:0001/79fe'	=> { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' },
+	'e159:0001/795e'	=> { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' },
+	'e159:0001/79de'	=> { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' },
+	'e159:0001/797e'	=> { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' },
+
+	# from wcte12xp
+	'd161:0120'		=> { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE12xP' },
+	'd161:8000'		=> { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE121' },
+	'd161:8001'		=> { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE122' },
+
+	# from tor2
+	'10b5:9030'		=> { DRIVER => 'tor2', DESCRIPTION => 'PLX 9030' },
+	'10b5:3001'		=> { DRIVER => 'tor2', DESCRIPTION => 'PLX Development Board' },
+	'10b5:D00D'		=> { DRIVER => 'tor2', DESCRIPTION => 'Tormenta 2 Quad T1/PRI or E1/PRA' },
+	'10b5:4000'		=> { DRIVER => 'tor2', DESCRIPTION => 'Tormenta 2 Quad T1/E1 (non-Digium clone)' },
+
+	# Cologne Chips:
+	# (Still a partial list)
+	'1397:08b4/b556'	=> { DRIVER => 'qozap', DESCRIPTION => 'Junghanns DuoBRI ISDN card' },
+	'1397:08b4'		=> { DRIVER => 'qozap', DESCRIPTION => 'Junghanns QuadBRI ISDN card' },
+	'1397:16b8'		=> { DRIVER => 'qozap', DESCRIPTION => 'Junghanns OctoBRI ISDN card' },
+	'1397:30b1'		=> { DRIVER => 'cwain', DESCRIPTION => 'HFC-E1 ISDN E1 card' },
+	'1397:2bd0'		=> { DRIVER => 'zaphfc', DESCRIPTION => 'HFC-S ISDN BRI card' },
+	'1397:f001'		=> { DRIVER => 'ztgsm', DESCRIPTION => 'HFC-GSM Cologne Chips GSM' },
+
+	# Rhino cards (based on pci.ids)
+	'0b0b:0105'	=> { DRIVER => 'r1t1', DESCRIPTION => 'Rhino R1T1' },
+	'0b0b:0205'	=> { DRIVER => 'r4fxo', DESCRIPTION => 'Rhino R14FXO' },
+	'0b0b:0206'	=> { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB4FXO 4-channel FXO analog telphony card' },
+	'0b0b:0305'	=> { DRIVER => 'r1t1', DESCRIPTION => 'Rhino R1T1' },
+	'0b0b:0405'	=> { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino R8FXX' },
+	'0b0b:0406'	=> { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB8FXX 8-channel modular analog telphony card' },
+	'0b0b:0505'	=> { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino R24FXX' },
+	'0b0b:0506'	=> { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB24FXS 24-Channel FXS analog telphony card' },
+	'0b0b:0605'	=> { DRIVER => 'rxt1', DESCRIPTION => 'Rhino R2T1' },
+	'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";
+
+sub pci_sorter {
+	return $a->priv_device_name() cmp $b->priv_device_name();
+}
+
+sub new($$) {
+	my $pack = shift or die "Wasn't called as a class method\n";
+	my $self = { @_ };
+	bless $self, $pack;
+	Zaptel::Hardware::device_detected($self,
+		sprintf("pci:%s", $self->{PRIV_DEVICE_NAME}));
+	return $self;
+}
+
+my %pci_devs;
+
+sub readfile($) {
+	my $name = shift || die;
+	open(F, $name) || die "Failed to open '$name': $!";
+	my $str = <F>;
+	close F;
+	chomp($str);
+	return $str;
+}
+
+sub scan_devices($) {
+	my @devices;
+
+	while(</sys/bus/pci/devices/*>) {
+		m,([^/]+)$,,;
+		my $name = $1;
+		my $l = readlink $_ || die;
+		$pci_devs{$name}{PRIV_DEVICE_NAME} = $name;
+		$pci_devs{$name}{DEVICE} = $l;
+		$pci_devs{$name}{VENDOR} = readfile "$_/vendor";
+		$pci_devs{$name}{PRODUCT} = readfile "$_/device";
+		$pci_devs{$name}{SUBVENDOR} = readfile "$_/subsystem_vendor";
+		$pci_devs{$name}{SUBPRODUCT} = readfile "$_/subsystem_device";
+		my $dev = $pci_devs{$name};
+		grep(s/0x//, $dev->{VENDOR}, $dev->{PRODUCT}, $dev->{SUBVENDOR}, $dev->{SUBPRODUCT});
+		$pci_devs{$name}{DRIVER} = '';
+	}
+
+	while(</sys/bus/pci/drivers/*/[0-9]*>) {
+		m,^(.*?)/([^/]+)/([^/]+)$,;
+		my $prefix = $1;
+		my $drvname = $2;
+		my $id = $3;
+		my $l = readlink "$prefix/$drvname/module";
+		# Find the real module name (if we can).
+		if(defined $l) {
+			my $moduledir = "$prefix/$drvname/$l";
+			my $modname = $moduledir;
+			$modname =~ s:^.*/::;
+			$drvname = $modname;
+		}
+		$pci_devs{$id}{LOADED} = $drvname;
+	}
+	foreach (sort keys %pci_devs) {
+		my $dev = $pci_devs{$_};
+		my $key;
+		# Try to match
+		$key = "$dev->{VENDOR}:$dev->{PRODUCT}/$dev->{SUBVENDOR}:$dev->{SUBPRODUCT}";
+		$key = "$dev->{VENDOR}:$dev->{PRODUCT}/$dev->{SUBVENDOR}" if !defined($pci_ids{$key});
+		$key = "$dev->{VENDOR}:$dev->{PRODUCT}" if !defined($pci_ids{$key});
+		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},
+			SUBVENDOR		=> $dev->{SUBVENDOR},
+			SUBPRODUCT		=> $dev->{SUBPRODUCT},
+			LOADED			=> $dev->{LOADED},
+			DRIVER			=> $pci_ids{$key}{DRIVER},
+			DESCRIPTION		=> $pci_ids{$key}{DESCRIPTION},
+			);
+		push(@devices, $d);
+	}
+	@devices = sort pci_sorter @devices;
+	return @devices;
+}
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Hardware/USB.pm b/xpp/perl_modules/Zaptel/Hardware/USB.pm
new file mode 100644
index 0000000..a2dc08f
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Hardware/USB.pm
@@ -0,0 +1,116 @@
+package Zaptel::Hardware::USB;
+#
+# 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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Utils;
+use Zaptel::Hardware;
+use Zaptel::Xpp;
+use Zaptel::Xpp::Xbus;
+
+our @ISA = qw(Zaptel::Hardware);
+
+my %usb_ids = (
+	# from wcusb
+	'06e6:831c'	=> { DRIVER => 'wcusb', DESCRIPTION => 'Wildcard S100U USB FXS Interface' },
+	'06e6:831e'	=> { DRIVER => 'wcusb2', DESCRIPTION => 'Wildcard S110U USB FXS Interface' },
+	'06e6:b210'	=> { DRIVER => 'wc_usb_phone', DESCRIPTION => 'Wildcard Phone Test driver' },
+
+	# from xpp_usb
+	'e4e4:1130'	=> { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-8/16 no-firmware' },
+	'e4e4:1131'	=> { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-8/16 USB-firmware' },
+	'e4e4:1132'	=> { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-8/16 FPGA-firmware' },
+	'e4e4:1140'	=> { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-BRI no-firmware' },
+	'e4e4:1141'	=> { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-BRI USB-firmware' },
+	'e4e4:1142'	=> { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-BRI FPGA-firmware' },
+	'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";
+
+my @xbuses = Zaptel::Xpp::xbuses('SORT_CONNECTOR');
+
+sub usb_sorter() {
+	return $a->hardware_name cmp $b->hardware_name;
+}
+
+sub xbus_of_usb($) {
+	my $priv_device_name = shift;
+	my $dev = shift;
+
+	my ($wanted) = grep {
+			defined($_->usb_devname) &&
+			$priv_device_name eq $_->usb_devname
+		} @xbuses;
+	return $wanted;
+}
+
+sub new($$) {
+	my $pack = shift or die "Wasn't called as a class method\n";
+	my $self = { @_ };
+	bless $self, $pack;
+	my $xbus = xbus_of_usb($self->priv_device_name);
+	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}));
+	return $self;
+}
+
+sub 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/perl_modules/Zaptel/Span.pm b/xpp/perl_modules/Zaptel/Span.pm
new file mode 100644
index 0000000..9aceb78
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Span.pm
@@ -0,0 +1,300 @@
+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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Utils;
+use Zaptel::Chans;
+use Zaptel::Xpp::Xpd;
+
+=head1 NAME
+
+Zaptel::Spans - Perl interface to a Zaptel span information
+
+This package allows access from perl to information about a Zaptel
+channel. It is part of the Zaptel Perl package.
+
+A span is a logical unit of Zaptel channels. Normally a port in a
+digital card or a whole analog card.
+
+See documentation of module L<Zaptel> for usage example. Specifically
+C<Zaptel::spans()> must be run initially.
+
+=head1 by_number()
+
+Get a span by its Zaptel span number.
+
+=head1 Span Properties
+
+=head2 num()
+
+The span number.
+
+=head2 name()
+
+The name field of a Zaptel span. E.g.:
+
+  TE2/0/1
+
+=head2 description()
+
+The description field of the span. e.g:
+
+  "T2XXP (PCI) Card 0 Span 1" HDB3/CCS/CRC4 RED
+
+=head2 chans()
+
+The list of the channels (L<Zaptel::Chan> objects) of this span.
+In a scalar context returns the number of channels this span has.
+
+=head2 bchans()
+
+Likewise a list of bchannels (or a count in a scalar context).
+
+=head2 is_sync_master()
+
+Is this span the source of timing for Zaptel?
+
+=head2 type()
+
+Type of span, or "UNKNOWN" if could not be detected. Current known
+types: 
+
+BRI_TE, BRI_NT, E1_TE, E1_NT, J1_TE, J1_NT, T1_TE, T1_NT, FXS, FXO
+
+=head2 is_pri()
+
+Is this an E1/J1/T1 span?
+
+=head2 is_bri()
+
+Is this a BRI span?
+
+=head2 is_digital()
+
+Is this a digital (as opposed to analog) span?
+
+=head2 termtype()
+
+Set for digital spans. "TE" or "NT". Will probably be assumed to be "TE"
+if there's no information pointing either way.
+
+=head2 coding()
+
+Suggested sane coding type (e.g.: "hdb3", "b8zs") for this type of span. 
+
+=head2 framing()
+
+Suggested sane framing type (e.g.: "ccs", "esf") for this type of span. 
+
+=head2 yellow(), crc4()
+
+Likewise, suggestions ofr the respective fields in the span= line in
+zaptel.conf for this span.
+
+=head2 signalling()
+
+Suggested zapata.conf signalling for channels of this span.
+
+=head2 switchtype()
+
+Suggested zapata.conf switchtype for channels of this span.
+
+=head1 Note
+
+Most of those properties are normally used as lower-case functions, but
+actually set in the module as capital-letter propeties. To look at e.g.
+"signalling" is set, look for "SIGNALLING".
+
+=cut
+
+my $proc_base = "/proc/dahdi";
+
+sub chans($) {
+	my $span = shift;
+	return @{$span->{CHANS}};
+}
+
+sub by_number($) {
+	my $span_number = shift;
+	die "Missing span number" unless defined $span_number;
+	my @spans = Zaptel::spans();
+
+	my ($span) = grep { $_->num == $span_number } @spans;
+	return $span;
+}
+
+my @bri_strings = (
+		'BRI_(NT|TE)',
+		'(?:quad|octo)BRI PCI ISDN Card.* \[(NT|TE)\]\ ',
+		'octoBRI \[(NT|TE)\] ',
+		'HFC-S PCI A ISDN.* \[(NT|TE)\] '
+		);
+
+my @pri_strings = (
+		'(E1|T1|J1)_(NT|TE)',
+		'Tormenta 2 .*Quad (E1|T1)',       # tor2.
+		'Digium Wildcard .100P (T1|E1)/', # wct1xxp
+		'ISA Tormenta Span 1',	           # torisa
+		'TE110P T1/E1',                    # wcte11xp
+		'Wildcard TE120P',                 # wcte12xp
+		'Wildcard TE121',                  # wcte12xp
+		'Wildcard TE122',                  # wcte12xp
+		'T[24]XXP \(PCI\) Card ',          # wct4xxp
+		);
+
+our $ZAPBRI_NET = 'bri_net';
+our $ZAPBRI_CPE = 'bri_cpe';
+
+our $ZAPPRI_NET = 'pri_net';
+our $ZAPPRI_CPE = 'pri_cpe';
+
+sub init_proto($$) {
+	my $self = shift;
+	my $proto = shift;
+
+	$self->{PROTO} = $proto;
+	if($proto eq 'E1') {
+		$self->{DCHAN_IDX} = 15;
+		$self->{BCHAN_LIST} = [ 0 .. 14, 16 .. 30 ];
+	} elsif($proto eq 'T1') {
+		$self->{DCHAN_IDX} = 23;
+		$self->{BCHAN_LIST} = [ 0 .. 22 ];
+	}
+	$self->{TYPE} = "${proto}_$self->{TERMTYPE}";
+}
+
+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;
+	$self->{TYPE} = "UNKNOWN";
+	my @xpds = Zaptel::Xpp::Xpd::xpds_by_spanno;
+	my $xpd = $xpds[$num];
+	if(defined $xpd) {
+		die "Spanno mismatch: $xpd->spanno, $num" unless $xpd->spanno == $num;
+		$self->{XPD} = $xpd;
+	}
+	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;
+			$self->{IS_BRI} = 1;
+			$self->{TERMTYPE} = $1;
+			$self->{TYPE} = "BRI_$1";
+			$self->{DCHAN_IDX} = 2;
+			$self->{BCHAN_LIST} = [ 0, 1 ];
+			last;
+		}
+	}
+	foreach my $cardtype (@pri_strings) {
+		if($head =~ m/$cardtype/) {
+			my @info;
+
+			push(@info, $1) if defined $1;
+			push(@info, $2) if defined $2;
+			my ($proto) = grep(/(E1|T1|J1)/, @info);
+			$proto = 'UNKNOWN' unless defined $proto;
+			my ($termtype) = grep(/(NT|TE)/, @info);
+			$termtype = 'TE' unless defined $termtype;
+
+			$self->{IS_DIGITAL} = 1;
+			$self->{IS_PRI} = 1;
+			$self->{TERMTYPE} = $termtype;
+			$self->init_proto($proto);
+			last;
+		}
+	}
+	die "$0: Unkown TERMTYPE [NT/TE]\n"
+		if $self->is_digital  and !defined $self->{TERMTYPE};
+	($self->{NAME}, $self->{DESCRIPTION}) = (split(/\s+/, $head, 4))[2, 3];
+	$self->{IS_ZAPTEL_SYNC_MASTER} =
+		($self->{DESCRIPTION} =~ /\(MASTER\)/) ? 1 : 0;
+	$self->{CHANS} = [];
+	my @channels;
+	my $index = 0;
+	while(<F>) {
+		chomp;
+		s/^\s*//;
+		s/\s*$//;
+		next unless /\S/;
+		next unless /^\s*\d+/; # must be a real channel string.
+		my $c = Zaptel::Chans->new($self, $index, $_);
+		push(@channels, $c);
+		$index++;
+	}
+	close F;
+	if($self->is_pri()) {
+		# Check for PRI with unknown type strings
+		if($index == 31) {
+			if($self->{PROTO} eq 'UNKNOWN') {
+				$self->init_proto('E1');
+			} elsif($self->{PROTO} ne 'E1')  {
+				die "$index channels in a $self->{PROTO} span";
+			}
+		} elsif($index == 24) {
+			if($self->{PROTO} eq 'UNKNOWN') {
+				$self->init_proto('T1');	# FIXME: J1?
+			} elsif($self->{PROTO} ne 'T1') {
+				die "$index channels in a $self->{PROTO} span";
+			}
+		}
+	}
+	@channels = sort { $a->num <=> $b->num } @channels;
+	$self->{CHANS} = \@channels;
+	$self->{YELLOW} = undef;
+	$self->{CRC4} = undef;
+	if($self->is_bri()) {
+		$self->{CODING} = 'ami';
+		$self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}];
+		$self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ];
+		# Infer some info from channel name:
+		my $first_chan = ($self->chans())[0] || die "$0: No channels in span #$num\n";
+		my $chan_fqn = $first_chan->fqn();
+		if($chan_fqn =~ m(ZTHFC.*/|ztqoz.*/|XPP_BRI_.*/)) {		# BRI
+			$self->{FRAMING} = 'ccs';
+			$self->{SWITCHTYPE} = 'euroisdn';
+			$self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $ZAPBRI_NET : $ZAPBRI_CPE ;
+		} elsif($chan_fqn =~ m(ztgsm.*/)) {				# Junghanns's GSM cards. 
+			$self->{FRAMING} = 'ccs';
+			$self->{SIGNALLING} = 'gsm';
+		}
+	}
+	if($self->is_pri()) {
+		$self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}];
+		$self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ];
+		if($self->{PROTO} eq 'E1') {
+			$self->{CODING} = 'hdb3';
+			$self->{FRAMING} = 'ccs';
+			$self->{SWITCHTYPE} = 'euroisdn';
+			$self->{CRC4} = 'crc4';
+		} elsif($self->{PROTO} eq 'T1') {
+			$self->{CODING} = 'b8zs';
+			$self->{FRAMING} = 'esf';
+			$self->{SWITCHTYPE} = 'national';
+		} else {
+			die "'$self->{PROTO}' unsupported yet";
+		}
+		$self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $ZAPPRI_NET : $ZAPPRI_CPE ;
+	}
+	return $self;
+}
+
+sub bchans($) {
+	my $self = shift || die;
+
+	return @{$self->{BCHANS}};
+}
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Utils.pm b/xpp/perl_modules/Zaptel/Utils.pm
new file mode 100644
index 0000000..8d13ad7
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Utils.pm
@@ -0,0 +1,52 @@
+package Zaptel::Utils;
+
+# Accessors (miniperl does not have Class:Accessor)
+our $AUTOLOAD;
+sub AUTOLOAD {
+	my $self = shift;
+	my $name = $AUTOLOAD;
+	$name =~ s/.*://;   # strip fully-qualified portion
+	return if $name =~ /^[A-Z_]+$/;	# ignore special methods (DESTROY)
+	my $key = uc($name);
+	my $val = shift;
+	if (defined $val) {
+		#print STDERR "set: $key = $val\n";
+		return $self->{$key} = $val;
+	} else {
+		if(!exists $self->{$key}) {
+			#$self->xpp_dump;
+			#die "Trying to get uninitialized '$key'";
+		}
+		my $val = $self->{$key};
+		#print STDERR "get: $key ($val)\n";
+		return $val;
+	}
+}
+
+sub xpp_dump($) {
+	my $self = shift || die;
+	printf STDERR "Dump a %s\n", ref($self);
+	foreach my $k (sort keys %{$self}) {
+		my $val = $self->{$k};
+		$val = '**UNDEF**' if !defined $val;
+		printf STDERR "    %-20s %s\n", $k, $val;
+	}
+}
+
+# Based on Autoloader
+
+sub import {
+	my $pkg = shift;
+	my $callpkg = caller;
+
+	#print STDERR "import: $pkg, $callpkg\n";
+	#
+	# Export symbols, but not by accident of inheritance.
+	#
+	die "Sombody inherited Zaptel::Utils" if $pkg ne 'Zaptel::Utils';
+	no strict 'refs';
+	*{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD;
+	*{ $callpkg . '::xpp_dump' } = \&xpp_dump;
+}
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Xpp.pm b/xpp/perl_modules/Zaptel/Xpp.pm
new file mode 100644
index 0000000..8b7458f
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Xpp.pm
@@ -0,0 +1,199 @@
+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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Xpp::Xbus;
+
+=head1 NAME
+
+Zaptel::Xpp - Perl interface to the Xorcom Astribank drivers.
+
+=head1 SYNOPSIS
+
+  # 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->name cmp $b->name;
+}
+
+sub by_connector {
+	return $a->connector cmp $b->connector;
+}
+
+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_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 = Zaptel::Xpp::Xbus->new(NAME => $name, NUM => $num, @attr);
+		push(@xbuses, $xbus);
+	}
+	my $sorter;
+	if($optsort eq "SORT_CONNECTOR") {
+		$sorter = \&by_connector;
+	} elsif($optsort eq "SORT_NAME") {
+		$sorter = \&by_name;
+	} elsif($optsort eq "SORT_LABEL") {
+		$sorter = \&by_label;
+	} elsif(ref($optsort) eq 'CODE') {
+		$sorter = $optsort;
+	} else {
+		die "Unknown optional sorter '$optsort'";
+	}
+	@xbuses = sort $sorter @xbuses;
+	return @xbuses;
+}
+
+sub xpd_of_span($) {
+	my $span = shift or die "Missing span parameter";
+	return undef unless defined $span;
+	foreach my $xbus (Zaptel::Xpp::xbuses('SORT_CONNECTOR')) {
+		foreach my $xpd ($xbus->xpds()) {
+			return $xpd if $xpd->fqn eq $span->name;
+		}
+	}
+	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;
+	my $newapi = 0;
+
+	my $file = "$proc_base/sync";
+	return '' 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
+		$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
+
+=over
+
+=item L<Zaptel::Xpp::Xbus>
+
+Xbus (Astribank) object.
+
+=item L<Zaptel::Xpp::Xpd>
+
+XPD (the rough equivalent of a Zaptel span) object.
+
+=item L<Zaptel::Xpp::Line>
+
+Object for a line: an analog port or a time-slot in a adapter. 
+Equivalent of a channel in Zaptel.
+
+=item L<Zaptel>
+
+General documentation in the master package.
+
+=back
+
+=cut
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Xpp/Line.pm b/xpp/perl_modules/Zaptel/Xpp/Line.pm
new file mode 100644
index 0000000..2472c3b
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Xpp/Line.pm
@@ -0,0 +1,95 @@
+package Zaptel::Xpp::Line;
+#
+# Written by Oron Peled <oron@actcom.co.il>
+# Copyright (C) 2008, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Utils;
+
+my $proc_base = "/proc/xpp";
+
+sub new($$$) {
+	my $pack = shift or die "Wasn't called as a class method\n";
+	my $xpd = shift or die;
+	my $index = shift;
+	defined $index or die;
+	my $self = {};
+	bless $self, $pack;
+	$self->{XPD} = $xpd;
+	$self->{INDEX} = $index;
+	return $self;
+}
+
+sub blink($$) {
+	my $self = shift;
+	my $on = shift;
+	my $xpd = $self->xpd;
+	my $result;
+
+	my $file = "$proc_base/" . $xpd->fqn . "/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;
+	if(defined($on)) {		# Now change
+		my $onbitmask = 1 << $self->index;
+		my $offbitmask = $result & ~$onbitmask;
+
+		$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;
+			}
+		}
+	}
+	return $result;
+}
+
+sub create_all($$) {
+	my $pack = shift or die "Wasn't called as a class method\n";
+	my $xpd = shift || die;
+	my $procdir = shift || die;
+	local $/ = "\n";
+	my @lines;
+	for(my $i = 0; $i < $xpd->{CHANNELS}; $i++) {
+		my $line = Zaptel::Xpp::Line->new($xpd, $i);
+		push(@lines, $line);
+	}
+	$xpd->{LINES} = \@lines;
+	my ($infofile) = glob "$procdir/*_info";
+	die "Failed globbing '$procdir/*_info'" unless defined $infofile;
+	my $type = $xpd->type;
+	open(F, "$infofile") || die "Failed opening '$infofile': $!";
+	my $battery_info = 0;
+	while (<F>) {
+		chomp;
+		if($type eq 'FXO') {
+			$battery_info = 1 if /^Battery:/;
+			if($battery_info && s/^\s*on\s*:\s*//) {
+				my @batt = split;
+				foreach my $l (@lines) {
+					die unless @batt;
+					my $state = shift @batt;
+					$l->{BATTERY} = ($state eq '+') ? 1 : 0;
+				}
+				$battery_info = 0;
+				die if @batt;
+			}
+		}
+	}
+	close F;
+}
+
+
+1;
diff --git a/xpp/perl_modules/Zaptel/Xpp/Xbus.pm b/xpp/perl_modules/Zaptel/Xpp/Xbus.pm
new file mode 100644
index 0000000..e840f14
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Xpp/Xbus.pm
@@ -0,0 +1,118 @@
+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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Utils;
+use Zaptel::Xpp::Xpd;
+
+my $proc_base = "/proc/xpp";
+
+sub xpds($) {
+	my $xbus = shift;
+	return @{$xbus->{XPDS}};
+}
+
+sub by_number($) {
+	my $busnumber = shift;
+	die "Missing xbus number parameter" unless defined $busnumber;
+	my @xbuses = Zaptel::Xpp::xbuses();
+
+	my ($xbus) = grep { $_->num == $busnumber } @xbuses;
+	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 $xpdid = shift;
+	die "Missing XPD id parameter" unless defined $xpdid;
+	my @xpds = $xbus->xpds;
+	my ($wanted) = grep { $_->id eq $xpdid } @xpds;
+	return $wanted;
+}
+
+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;
+		# Keys in all caps
+		$k = uc($k);
+		# Some values are in all caps as well
+		if($k =~ /^(STATUS)$/) {
+			$v = uc($v);
+		}
+		$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 = Zaptel::Xpp::Xpd->new($self, $dir);
+		push(@{$self->{XPDS}}, $xpd);
+	}
+	@{$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/perl_modules/Zaptel/Xpp/Xpd.pm b/xpp/perl_modules/Zaptel/Xpp/Xpd.pm
new file mode 100644
index 0000000..5087f1f
--- /dev/null
+++ b/xpp/perl_modules/Zaptel/Xpp/Xpd.pm
@@ -0,0 +1,123 @@
+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.
+#
+# $Id$
+#
+use strict;
+use Zaptel::Utils;
+use Zaptel::Xpp;
+use Zaptel::Xpp::Line;
+
+my $proc_base = "/proc/xpp";
+
+sub blink($$) {
+	my $self = shift;
+	my $on = shift;
+	my $result;
+
+	my $file = "$proc_base/" . $self->fqn . "/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;
+	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;
+			}
+		}
+	}
+	return $result;
+}
+
+sub dahdi_registration($$) {
+	my $self = shift;
+	my $on = shift;
+	my $result;
+
+	my $file = "$proc_base/" . $self->fqn . "/dahdi_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 xpds_by_spanno() {
+	my @xbuses = Zaptel::Xpp::xbuses("SORT_CONNECTOR");
+	my @xpds = map { $_->xpds } @xbuses;
+	@xpds = grep { $_->spanno } @xpds;
+	@xpds = sort { $a->spanno <=> $b->spanno } @xpds;
+	my @spanno = map { $_->spanno } @xpds;
+	my @idx;
+	@idx[@spanno] = @xpds;	# The spanno is the index now
+	return @idx;
+}
+
+sub new($$) {
+	my $pack = shift or die "Wasn't called as a class method\n";
+	my $xbus = shift || die;
+	my $procdir = shift || die;
+	my $self = {};
+	bless $self, $pack;
+	$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 3)"
+	# The driver does not export the number of channels...
+	# Let's find it indirectly
+	while(<F>) {
+		chomp;
+		if(s/^\s*offhook\s*:\s*//) {
+			my @offhook = split;
+			@offhook || die "No channels in '$procdir/summary'";
+			$self->{CHANNELS} = @offhook;
+			last;
+		}
+	}
+	close F;
+	$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;
+	}
+	$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} );
+	Zaptel::Xpp::Line->create_all($self, $procdir);
+	return $self;
+}
+
+1;