source: branches/3.2/MondoRescue/lib/MondoRescue/File.pm @ 3222

Last change on this file since 3222 was 3222, checked in by Bruno Cornec, 7 years ago
File size: 1.8 KB
Line 
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
10package MondoRescue::File;
11
12use strict 'vars';
13use Data::Dumper;
14use English;
15use File::Find;
16use Cwd;
17use lib qw (lib);
18
19# Inherit from the "Exporter" module which handles exporting functions.
20
21use Exporter;
22
23# Export, by default, all the functions into the namespace of
24# any code which uses this module.
25
26our @ISA = qw(Exporter);
27our @EXPORT = qw(mr_file_read_all_link);
28
29=pod
30
31=head1 NAME
32
33MondoRescue::File, part of the mondorescue.org
34
35=head1 DESCRIPTION
36
37This 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
45This function returns all the links found for a given file passed as parameter
46Example: 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
51sub mr_file_read_all_link {
52
53my $dir = cwd;
54my $link;
55
56find 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}, @_;
87return($link);
88}
Note: See TracBrowser for help on using the repository browser.