Changeset 2839 in MondoRescue for branches/2.2.9/mindi/mindi-get-perl-modules

Timestamp:

Jun 26, 2011, 3:01:13 AM (13 years ago)

Author:

Bruno Cornec

Message:

-Fix mindi-get-perl-modules when perl dirs in @INC are symlinks (case on Ubuntu 11.04)

File:

• branches/2.2.9/mindi/mindi-get-perl-modules (modified) (3 diffs)

branches/2.2.9/mindi/mindi-get-perl-modules

@@ -6 +6 @@
 
 use File::Find;
+use Cwd;
 
 my $file = get_perl_modules(@ARGV) if (defined $ARGV[0]);
@@ -28 +29 @@
 #
 foreach my $d (@INC) {
+    $d = read_all_link($d) if (-l $d);
     push @includes,$d if (-d $d);
 }
@@ -53 +55 @@
 }
 
+# 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