From ee0e06c99e2cf44c23984e84b592ff82af68b19b Mon Sep 17 00:00:00 2001 From: Tzafrir Cohen Date: Tue, 2 Mar 2010 18:07:37 +0000 Subject: DAHDI-perl: allow setting base of system files with DAHDI_VIRT_TOP If the user set DAHDI_VIRT_TOP in the environment, consider it as a path under which to look for ProcFS and SysFS files. This allows running the DAHDI-perl tools on filesystem dumps generated by build_tools/dump_sys_state . To reduce the number of dependencies between various modules, the 'xpd' member of a Dahdi::Span is removed. Dahdi::Xpp::xpd_of_span() can be used if needed. git-svn-id: http://svn.asterisk.org/svn/dahdi/tools/trunk@8215 a0bf4364-ded3-4de4-8d8a-66a801d63aff --- xpp/lsdahdi | 2 +- xpp/perl_modules/Dahdi.pm | 20 +++++++++++++++----- xpp/perl_modules/Dahdi/Hardware/PCI.pm | 2 +- xpp/perl_modules/Dahdi/Hardware/USB.pm | 4 ++-- xpp/perl_modules/Dahdi/Span.pm | 15 ++++----------- xpp/perl_modules/Dahdi/Utils.pm | 14 ++++++++++++++ xpp/perl_modules/Dahdi/Xpp.pm | 15 +++++++++++---- xpp/perl_modules/Dahdi/Xpp/Xbus.pm | 8 +++----- 8 files changed, 51 insertions(+), 29 deletions(-) diff --git a/xpp/lsdahdi b/xpp/lsdahdi index 1298c3e..e4d473c 100755 --- a/xpp/lsdahdi +++ b/xpp/lsdahdi @@ -22,7 +22,7 @@ my @xpds = map { $_->xpds } @xbuses; foreach my $span (Dahdi::spans()) { my $spanno = $span->num; - my $xpd = $span->xpd; + my $xpd = Dahdi::Xpp::xpd_of_span($span); my @lines; my $index = 0; diff --git a/xpp/perl_modules/Dahdi.pm b/xpp/perl_modules/Dahdi.pm index fa5955a..e17b939 100644 --- a/xpp/perl_modules/Dahdi.pm +++ b/xpp/perl_modules/Dahdi.pm @@ -32,7 +32,11 @@ hardware and loaded Dahdi devices. } =cut -my $proc_base = "/proc/dahdi"; +our $virt_base; +our $proc_dahdi_base; +our $proc_xpp_base; +our $proc_usb_base; +our $sys_base; =head1 spans() @@ -43,10 +47,9 @@ Returns a list of span objects, ordered by span number. sub spans() { my @spans; - -d $proc_base or return (); - foreach my $zfile (glob "$proc_base/*") { - $zfile =~ s:$proc_base/::; - next unless ($zfile =~ /^\d+$/); + -d $proc_dahdi_base or return (); + foreach my $zfile (glob "$proc_dahdi_base/*") { + next unless ($zfile =~ m{^$proc_dahdi_base/\d+$}); my $span = Dahdi::Span->new($zfile); push(@spans, $span); } @@ -54,6 +57,13 @@ sub spans() { return @spans; } +=head1 ENVIRONMENT + +If C is set in the environment, it will be considered +as a path to a directory that holds a dump (copy) of all the required +files from /proc and /sys . You can generate that directory using the +script C . + =head1 SEE ALSO Span objects: L. diff --git a/xpp/perl_modules/Dahdi/Hardware/PCI.pm b/xpp/perl_modules/Dahdi/Hardware/PCI.pm index f6b3901..a1ef6bb 100644 --- a/xpp/perl_modules/Dahdi/Hardware/PCI.pm +++ b/xpp/perl_modules/Dahdi/Hardware/PCI.pm @@ -170,7 +170,7 @@ sub readfile($) { sub scan_devices($) { my @devices; - while() { + while(<$Dahdi::sys_base/bus/pci/devices/*>) { m,([^/]+)$,,; my $name = $1; my $l = readlink $_ || die; diff --git a/xpp/perl_modules/Dahdi/Hardware/USB.pm b/xpp/perl_modules/Dahdi/Hardware/USB.pm index 8b84243..711f977 100644 --- a/xpp/perl_modules/Dahdi/Hardware/USB.pm +++ b/xpp/perl_modules/Dahdi/Hardware/USB.pm @@ -135,7 +135,7 @@ sub scan_devices_sysfs($) { my $pack = shift || die; my @devices = (); - while () { + while (<$Dahdi::sys_base/bus/usb/devices/*-*>) { next unless -r "$_/idVendor"; # endpoints # Older kernels, e.g. 2.6.9, don't have the attribute @@ -165,7 +165,7 @@ sub scan_devices_sysfs($) { sub scan_devices($) { my $pack = shift || die; - my $usb_device_list = "/proc/bus/usb/devices"; + my $usb_device_list = "$Dahdi::proc_usb_base/devices"; return $pack->scan_devices_sysfs() unless (-r $usb_device_list); my @devices; diff --git a/xpp/perl_modules/Dahdi/Span.pm b/xpp/perl_modules/Dahdi/Span.pm index 943ab2b..9f4ca65 100644 --- a/xpp/perl_modules/Dahdi/Span.pm +++ b/xpp/perl_modules/Dahdi/Span.pm @@ -10,7 +10,6 @@ package Dahdi::Span; use strict; use Dahdi::Utils; use Dahdi::Chans; -use Dahdi::Xpp::Xpd; =head1 NAME @@ -113,8 +112,6 @@ actually set in the module as capital-letter propeties. To look at e.g. =cut -my $proc_base = "/proc/dahdi"; - sub chans($) { my $span = shift; return @{$span->{CHANS}}; @@ -176,17 +173,13 @@ sub init_proto($$) { 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 $proc_file = shift or die "Missing a proc file parameter\n"; + $proc_file =~ m{[^/]*/(\d+)$}; + my $num = $1 or die " Invalid span file name: $proc_file\n"; my $self = { NUM => $num }; bless $self, $pack; $self->{TYPE} = "UNKNOWN"; - my @xpds = Dahdi::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"; + open(F, "$proc_file") or die "Failed to open '$proc_file\n"; my $head = ; chomp $head; $self->{IS_DIGITAL} = 0; diff --git a/xpp/perl_modules/Dahdi/Utils.pm b/xpp/perl_modules/Dahdi/Utils.pm index dcb7441..4ca468b 100644 --- a/xpp/perl_modules/Dahdi/Utils.pm +++ b/xpp/perl_modules/Dahdi/Utils.pm @@ -23,6 +23,20 @@ sub AUTOLOAD { } } +# Initialize ProcFS and SysFS pathes, in case the user set +# DAHDI_VIRT_TOP +BEGIN { + if (exists $ENV{DAHDI_VIRT_TOP}) { + $Dahdi::virt_base = $ENV{DAHDI_VIRT_TOP}; + } else { + $Dahdi::virt_base = ''; + } + $Dahdi::proc_dahdi_base = "$Dahdi::virt_base/proc/dahdi"; + $Dahdi::proc_xpp_base = "$Dahdi::virt_base/proc/xpp"; + $Dahdi::proc_usb_base = "$Dahdi::virt_base/proc/bus/usb"; + $Dahdi::sys_base = "$Dahdi::virt_base/sys"; +} + sub xpp_dump($) { my $self = shift || die; printf STDERR "Dump a %s\n", ref($self); diff --git a/xpp/perl_modules/Dahdi/Xpp.pm b/xpp/perl_modules/Dahdi/Xpp.pm index 7ac574b..d4b315b 100644 --- a/xpp/perl_modules/Dahdi/Xpp.pm +++ b/xpp/perl_modules/Dahdi/Xpp.pm @@ -34,10 +34,16 @@ Dahdi::Xpp - Perl interface to the Xorcom Astribank drivers. # my @xbuses; -my $proc_base = "/proc/xpp"; -our $sysfs_astribanks = "/sys/bus/astribanks/devices"; -our $sysfs_xpds = "/sys/bus/xpds/devices"; -our $sysfs_ab_driver = "/sys/bus/astribanks/drivers/xppdrv"; +our $sysfs_astribanks; +our $sysfs_xpds; +our $sysfs_ab_driver; + +BEGIN { + my $virt_base = $Dahdi::virt_base; + $sysfs_astribanks = "$virt_base/sys/bus/astribanks/devices"; + $sysfs_xpds = "$virt_base/sys/bus/xpds/devices"; + $sysfs_ab_driver = "$virt_base/sys/bus/astribanks/drivers/xppdrv"; +} sub scan($) { my $pack = shift || die; @@ -253,6 +259,7 @@ sub sync_via_proc { my $result; my $newapi = 0; + my $proc_base = $Dahdi::proc_xpp_base; my $file = "$proc_base/sync"; return '' unless -f $file; # First query diff --git a/xpp/perl_modules/Dahdi/Xpp/Xbus.pm b/xpp/perl_modules/Dahdi/Xpp/Xbus.pm index 4bc1844..b68d7cc 100644 --- a/xpp/perl_modules/Dahdi/Xpp/Xbus.pm +++ b/xpp/perl_modules/Dahdi/Xpp/Xbus.pm @@ -12,8 +12,6 @@ use Dahdi::Utils; use Dahdi::Hardware; use Dahdi::Xpp::Xpd; -my $proc_base = "/proc/xpp"; - sub xpds($) { my $xbus = shift; return @{$xbus->{XPDS}}; @@ -54,7 +52,7 @@ sub xbus_attr_path($$) { foreach my $attr (@attr) { my $file = sprintf "$Dahdi::Xpp::sysfs_astribanks/xbus-%02d/$attr", $busnum; unless(-f $file) { - my $procfile = sprintf "/proc/xpp/XBUS-%02d/$attr", $busnum; + my $procfile = sprintf "$Dahdi::proc_xpp_base/XBUS-%02d/$attr", $busnum; warn "$0: warning - OLD DRIVER: missing '$file'. Fall back to '$procfile'\n" unless $file_warned{$attr}++; $file = $procfile; @@ -113,7 +111,7 @@ sub transport_type($$) { sub read_xpdnames_old($) { my $xbus_num = shift || die; - my $pat = sprintf "/proc/xpp/XBUS-%02d/XPD-[0-9][0-9]", $xbus_num; + my $pat = sprintf "$Dahdi::proc_xpp_base/XBUS-%02d/XPD-[0-9][0-9]", $xbus_num; my @xpdnames; #print STDERR "read_xpdnames_old($xbus_num): $pat\n"; @@ -175,7 +173,7 @@ sub new($$) { } foreach my $xpdstr (@xpdnames) { my ($busnum, $unit, $subunit) = split(/:/, $xpdstr); - my $procdir = "/proc/xpp/XBUS-$busnum/XPD-$unit$subunit"; + my $procdir = "$Dahdi::proc_xpp_base/XBUS-$busnum/XPD-$unit$subunit"; my $xpd = Dahdi::Xpp::Xpd->new($self, $unit, $subunit, $procdir, "$xbus_dir/$xpdstr"); push(@xpds, $xpd); } -- cgit v1.2.3