lib/Path/ResolveSymlinks.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

package Path::ResolveSymlinks; 
use strict;
use warnings;
use Cwd 'abs_path';
use Path::Class;
use Carp;
 
sub resolve_symlinks {
    my ($name)=@_;
 
    my ($dir,$file);
    if (-d $name) {
        $dir=dir($name);
    }
    elsif (-f $name) {
        $file=file($name);
        $dir=$file->parent;
        $file=$file->basename;
    }
    else {
        croak "$name is neither a file nor a directory";
    }
 
    $dir=dir(abs_path($dir));warn "dir: $dir\n";
    return $dir unless defined $file;
 
    $file=$dir->file($file);warn "file: $file\n";
    return $file unless -l $file;
 
    my $dest=file(readlink $file);warn "dest: $dest\n";
    if ($dest->is_absolute) {
        return resolve_symlinks($dest);
    }
    else {
        return resolve_symlinks($dir->file($dest));
    }
}
 
1;