aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Path/ResolveSymlinks.pm39
-rw-r--r--t/prs-01.t35
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');