#!/usr/bin/perl -w
#
# File subroutines brought by the MondoRescue project
#
# $Id$
#
# Copyright B. Cornec 2008-2014
# Provided under the GPL v2

package MondoRescue::File;

use strict 'vars';
use Data::Dumper;
use English;
use File::Find;
use Cwd;
use lib qw (lib);

# Inherit from the "Exporter" module which handles exporting functions.

use Exporter;

# Export, by default, all the functions into the namespace of
# any code which uses this module.

our @ISA = qw(Exporter);
our @EXPORT = qw(mr_file_read_all_link);

=pod

=head1 NAME

MondoRescue::File, part of the mondorescue.org

=head1 DESCRIPTION

This modules provides low level and generic functions for the Mondorescue project

=head1 USAGE

=over 4

=item B<mr_file_read_all_link>

This function returns all the links found for a given file passed as parameter
Example: mr_file_read_all_link(/lib64) returns (/lib64,/usr/lib64) on a system having a link from /lib64 to /usr/lib64

=cut

# Cf: http://www.stonehenge.com/merlyn/UnixReview/col27.html
sub mr_file_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);
}