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 | }
|
---|