Changeset 3223 in MondoRescue for branches/3.2/mindi/mindi-get-perl-modules

Timestamp:

Dec 30, 2013, 10:46:26 AM (10 years ago)

Author:

Bruno Cornec

Message:

• the read_all_link subfunction is now in MondoRescue::File ready to be used by other perl script and removed from mindi itself in a near future

File:

• branches/3.2/mindi/mindi-get-perl-modules (modified) (6 diffs)

branches/3.2/mindi/mindi-get-perl-modules

@@ -11 +11 @@
 use File::Find;
 use Cwd;
+use MondoRescue::File;
 
 
@@ -57 +58 @@
 
 
-my $file = get_perl_modules(@ARGV) if (defined $ARGV[0]);
+my $file = mr_get_perl_modules(@ARGV) if (defined $ARGV[0]);
 
 foreach my $f (sort keys %$file) {
@@ -63 +64 @@
 }
 
-sub get_perl_modules {
+sub mr_get_perl_modules {
 
 my %files;
@@ -70 +71 @@
 #print join "\n", @INC;
 
-my $require = process_file(@_);
+my $require = mr_process_file(@_);
 
 my @includes;
@@ -78 +79 @@
 #
 foreach my $d (@INC) {
-    $d = read_all_link($d) if (-l $d);
+    $d = mr_read_all_link($d) if (-l $d);
     push @includes,$d if (-d $d);
 }
@@ -104 +105 @@
 }
 
-# Cf: http://www.stonehenge.com/merlyn/UnixReview/col27.html
-sub read_all_link {
-
-my $dir = cwd;
-my $link;
-
-find sub {
-    return unless -l;
-    my @right = split /\//, $File::Find::name;
-    my @left = do {
-        @right && ($right[0] eq "") ?
-        shift @right :            # quick way
-        split /\//, $dir;
-    };    # first element always null
-    while (@right) {
-        my $item = shift @right;
-        next if $item eq "." or $item eq "";
-        if ($item eq "..") {
-            pop @left if @left > 1;
-            next;
-        }
-        my $link = readlink (join "/", @left, $item);
-        if (defined $link) {
-            my @parts = split /\//, $link;
-            if (@parts && ($parts[0] eq "")) { # absolute
-                @left = shift @parts;   # quick way
-            }
-        unshift @right, @parts;
-        next;
-        } else {
-            push @left, $item;
-            next;
-        }
-    }
-    #print "$File::Find::name is ", join("/", @left), "\n";
-    $link = join("/", @left);
-}, @_;
-return($link);
-}
-
 # Adapted From /usr/lib/rpm/mandriva/perl.req
 # by Ken Estes Mail.com kestes@staff.mail.com
 
-sub process_file {
+sub mr_process_file {
   
 my %line;