new build_tools/dahdi_sysfs_copy

Short perl script to copy dahdi related sysfs trees
into a designated directory.


Signed-off-by: Oron Peled <oron.peled@xorcom.com>
Acked-by: Tzafrir Cohen <tzafrir.cohen@xorcom.com>

git-svn-id: http://svn.astersk.org/svn/dahdi/tools/trunk@10496 17933a7a-c749-41c5-a318-cba88f637d49

build_tools/dahdi_sysfs_copy

@@ -0,0 +1,142 @@
+#! /usr/bin/perl
+#
+# Written by Oron Peled <oron@actcom.co.il>
+# Copyright (C) 2012, Xorcom
+# This program is free software; you can redistribute and/or
+# modify it under the same terms as Perl itself.
+#
+#dahdi_sysfs_copy: Short perl script to copy dahdi related sysfs trees
+#                  into a designated directory.
+#
+# $Id: $
+#
+use strict;
+use warnings;
+
+use File::Path qw(mkpath);
+use File::Copy;
+use Cwd qw(realpath);
+
+my $destdir = shift || die "Usage: $0 <destdir>\n";
+
+my %symlinks;
+my %walk_ups;
+my %inode_cash;
+
+# Starting points for recursion
+my @toplevels = qw(
+	/sys/bus/dahdi_devices
+	/sys/bus/astribanks
+	/sys/class/dahdi
+	);
+
+# Loop prevention (by inode number lookup)
+sub seen {
+	my $ino = shift || die;
+	my $path = shift || die;
+	if(defined $inode_cash{$ino}) {
+		#print STDERR "DEBUG($ino): $path\n";
+		return 1;
+	}
+	$inode_cash{$ino}++;
+	return 0;
+}
+
+# Walk up a path and copy readable attributes from any
+# directory level.
+sub walk_up {
+	my $path = shift || die;
+	my $curr = $path;
+	# Walk up
+	for (my $curr = $path; $curr; $curr =~ s'/?[^/]+$'') {
+		my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($curr);
+		next if seen($ino, $curr);	# Skip visited directories
+		# Scan directory
+		opendir(my $d, $curr) || die "Failed opendir($curr): $!\n";
+		my @entries = readdir $d;
+		foreach my $entry (@entries) {
+			next if $entry =~ /^[.][.]?$/;
+			my $file = "$curr/$entry";
+			my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($file);
+			# Copy file
+			if (-f _ && ($mode & 0004)) {	# The '-r _' is buggy
+				copy($file, "$destdir$file") ||
+					die "Failed to copy '$file': $!\n";
+			}
+		}
+		closedir $d;
+	}
+}
+
+# Handle a given path (directory,symlink,regular-file)
+sub handle_path {
+	my $path = shift || die;
+	my ($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($path);
+	# Save attributes before recursion starts
+	my $isdir = -d _;
+	my $islink = -l _;
+	my $isreadable = $mode & 00004;	# The '-r _' was buggy
+	return if seen($ino, $path);	# Loop prevention
+	my $dest = "$destdir/$path";
+	if ($isdir) {
+		mkpath("$dest");
+		scan_directory($path);
+	} elsif ($islink) {
+		# We follow links (the seen() protect us from loops)
+		my $target = readlink($path) ||
+			die "Failed readlink($path): $!\n";
+		my $follow = $target;
+		if ($target !~ m{^/}) {	# fix relative symlinks
+			my $dir = $path;
+			$dir =~ s,/[^/]*$,,;
+			$follow = realpath("$dir/$target");
+		}
+		# Save symlink details, so we create them after all
+		# destination tree (subdirectories, files) is ready
+		die "Duplicate entry '$dest'\n" if exists $symlinks{$dest};
+		$symlinks{$dest} = "$target";
+		# Now follow symlink
+		handle_path($follow);
+		$walk_ups{$follow}++;
+	} elsif ($isreadable) {
+		copy($path, "$dest") ||
+			die "Failed to copy '$path': $!\n";
+	}
+}
+
+# Scan a given directory (calling handle_path for recursion)
+sub scan_directory {
+	my $dir = shift || die;
+	my $entry;
+	opendir(my $d, $dir) || die "Failed opendir($dir): $!\n";
+	my @dirs = readdir $d;
+	foreach my $entry (@dirs) {
+		next if $entry =~ /^[.][.]?$/;
+		handle_path("$dir/$entry");
+	}
+	closedir $d;
+}
+
+# Filter out non-existing toplevels
+my @scan = grep { lstat($_) } @toplevels;
+
+# Recurse all trees, creating subdirectories and copying files
+foreach my $path (@scan) {
+	handle_path($path);
+}
+
+# Now, that all sub-directories were created, we can
+# create the wanted symlinks
+for my $dest (keys %symlinks) {
+	my $link = $symlinks{$dest};
+	die "Missing link for '$dest'\n" unless defined $link;
+	unlink $dest if -l $dest;
+	symlink($link,$dest) ||
+		die "Failed symlink($link,$dest): $!\n";
+}
+
+# Walk up directories that were symlink destinations
+# and fill their attributes
+foreach my $dir (keys %walk_ups) {
+	walk_up($dir);
+}