diff options
-rw-r--r-- | lib/Path/ResolveSymlinks.pm | 39 | ||||
-rw-r--r-- | t/prs-01.t | 35 |
2 files changed, 74 insertions, 0 deletions
diff --git a/lib/Path/ResolveSymlinks.pm b/lib/Path/ResolveSymlinks.pm new file mode 100644 index 0000000..695122a --- /dev/null +++ b/lib/Path/ResolveSymlinks.pm @@ -0,0 +1,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; diff --git a/t/prs-01.t b/t/prs-01.t new file mode 100644 index 0000000..5aaf93c --- /dev/null +++ b/t/prs-01.t @@ -0,0 +1,35 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Test::More qw(no_plan); +use Path::Class; + +BEGIN { use_ok('Path::ResolveSymlinks') or die } + +my $base=dir('','tmp','prs-test'); + +$base->mkpath; + +END { $base->rmtree } + +$base->subdir('real')->mkpath; +symlink $base->subdir('real'),$base->file('linked'); + +my $TEST_CONTENT=<<'EOF'; +test content +EOF + +{ my $fh=$base->file('real','data-real.txt')->openw; + print $fh $TEST_CONTENT +}; + +symlink $base->file('real','data-real.txt'),$base->file('real','data.txt'); + +symlink 'data-real.txt',$base->file('real','data-rel.txt'); + +is(Path::ResolveSymlinks::resolve_symlinks($base->file('linked','data.txt')), + $base->file('real','data-real.txt'), + 'resolved abs ok'); +is(Path::ResolveSymlinks::resolve_symlinks($base->file('linked','data-rel.txt')), + $base->file('real','data-real.txt'), + 'resolved rel ok'); |