[3222] | 1 | #!/usr/bin/perl -w
|
---|
| 2 | #
|
---|
| 3 | # File subroutines brought by the MondoRescue project
|
---|
| 4 | #
|
---|
| 5 | # $Id$
|
---|
| 6 | #
|
---|
| 7 | # Copyright B. Cornec 2008-2014
|
---|
| 8 | # Provided under the GPL v2
|
---|
| 9 |
|
---|
| 10 | package MondoRescue::File;
|
---|
| 11 |
|
---|
| 12 | use strict 'vars';
|
---|
| 13 | use Data::Dumper;
|
---|
| 14 | use English;
|
---|
| 15 | use File::Find;
|
---|
| 16 | use Cwd;
|
---|
| 17 | use lib qw (lib);
|
---|
| 18 |
|
---|
| 19 | # Inherit from the "Exporter" module which handles exporting functions.
|
---|
| 20 |
|
---|
| 21 | use Exporter;
|
---|
| 22 |
|
---|
| 23 | # Export, by default, all the functions into the namespace of
|
---|
| 24 | # any code which uses this module.
|
---|
| 25 |
|
---|
| 26 | our @ISA = qw(Exporter);
|
---|
| 27 | our @EXPORT = qw(mr_file_read_all_link);
|
---|
| 28 |
|
---|
| 29 | =pod
|
---|
| 30 |
|
---|
| 31 | =head1 NAME
|
---|
| 32 |
|
---|
| 33 | MondoRescue::File, part of the mondorescue.org
|
---|
| 34 |
|
---|
| 35 | =head1 DESCRIPTION
|
---|
| 36 |
|
---|
| 37 | This modules provides low level and generic functions for the Mondorescue project
|
---|
| 38 |
|
---|
| 39 | =head1 USAGE
|
---|
| 40 |
|
---|
| 41 | =over 4
|
---|
| 42 |
|
---|
| 43 | =item B<mr_file_read_all_link>
|
---|
| 44 |
|
---|
| 45 | This function returns all the links found for a given file passed as parameter
|
---|
| 46 | Example: mr_file_read_all_link(/lib64) returns (/lib64,/usr/lib64) on a system having a link from /lib64 to /usr/lib64
|
---|
| 47 |
|
---|
| 48 | =cut
|
---|
| 49 |
|
---|
| 50 | # Cf: http://www.stonehenge.com/merlyn/UnixReview/col27.html
|
---|
| 51 | sub mr_file_read_all_link {
|
---|
| 52 |
|
---|
| 53 | my $dir = cwd;
|
---|
| 54 | my $link;
|
---|
| 55 |
|
---|
| 56 | find sub {
|
---|
| 57 | return unless -l;
|
---|
| 58 | my @right = split /\//, $File::Find::name;
|
---|
| 59 | my @left = do {
|
---|
| 60 | @right && ($right[0] eq "") ?
|
---|
| 61 | shift @right : # quick way
|
---|
| 62 | split /\//, $dir;
|
---|
| 63 | }; # first element always null
|
---|
| 64 | while (@right) {
|
---|
| 65 | my $item = shift @right;
|
---|
| 66 | next if $item eq "." or $item eq "";
|
---|
| 67 | if ($item eq "..") {
|
---|
| 68 | pop @left if @left > 1;
|
---|
| 69 | next;
|
---|
| 70 | }
|
---|
| 71 | my $link = readlink(join "/", @left, $item);
|
---|
| 72 | if (defined $link) {
|
---|
| 73 | my @parts = split /\//, $link;
|
---|
| 74 | if (@parts && ($parts[0] eq "")) { # absolute
|
---|
| 75 | @left = shift @parts; # quick way
|
---|
| 76 | }
|
---|
| 77 | unshift @right, @parts;
|
---|
| 78 | next;
|
---|
| 79 | } else {
|
---|
| 80 | push @left, $item;
|
---|
| 81 | next;
|
---|
| 82 | }
|
---|
| 83 | }
|
---|
| 84 | #print "$File::Find::name is ", join("/", @left), "\n";
|
---|
| 85 | $link = join("/", @left);
|
---|
| 86 | }, @_;
|
---|
| 87 | return($link);
|
---|
| 88 | }
|
---|