File-Copy-Link-0.140_1/000777 000000 000000 00000000000 14732250537 012602 5ustar00000000 000000 File-Copy-Link-0.140_1/Build.PL000666 000000 000000 00000001445 14732120254 014072 0ustar00000000 000000 use 5.006; use Module::Build(); my $build = Module::Build -> new ( module_name => 'File::Copy::Link', license => 'perl', requires => { File::Spec => 0, File::Copy => 0, perl => 5.006 }, recommends => { Cwd => 2.18, }, script_files => [ qw(copylink) ], dist_author => 'Robin Barker ', test_requires => { Test::More => 0, File::Temp => 0 }, configure_requires => { 'Module::Build' => 0.40 }, create_makefile_pl => 'traditional', ); { local $SIG{__WARN__} = sub { return if $_[0] =~ m{ \A WARNING\:\ the\ following\ files\ are\ missing\ in\ your\ kit\: (\s+ (Makefile\.PL | META\.\S+) )+ \s+ Please\ inform\ the\ author\. \s+ \z }msx; warn $_[0]; return; }; $build -> create_build_script; } # $Id$ File-Copy-Link-0.140_1/Changes000666 000000 000000 00000003375 14732120254 014075 0ustar00000000 000000 Revision history for Perl distribution File-Copy-Link. $Id$ 0.15 2014-xx-xx XXX 0.14 2014-07-04 Changed AUTHOR email - no longer @npl.co.uk Fixed C precendence issue with C in File::Copy::Link, as reported on CPAN RT #87227 0.113 2011-09-23 Fixed a typo in Cwd->VERSION() call in t/linked.t Added META.json, updated META.yml, changed author email. 0.112 2008-06-12 Add examples/ and other changes to meet kwalitee metrics. Fixed a typo in error message when linked() fails, with test. 0.111 2007-12-30 0.110 2007-12-28 Handle old Cwd, where abs_path only accepts directories 0.100 2006-07-20 Meet (some) Perl Best Practices, as indicated by perlcritic. 0.800 2006-01-12 Add t/pod{,-coverage}.t and added POD to pass tests! 0.061 2005-02-25 Reimplemented linked, chopfile, resolve, resolve_all using a File::Spec::Link object to store the path. This avoids readlink('dir/') which may be causing test failures; ultimately trying to avoid cpan-testers failures. Rewrote README to update to 0.06 (can build using M::B) and then marking 0.061 as tester fodder. 0.06 2005-02-01 Added skip to tests for 'symlink' not implemented. Added resolve_path and resolve_all Build using Module::Build or make (ExtUtils::MakeMaker) 0.05 2003-08-10 Added full_resolve, following email from Jasper Cramwinckel 0.04 2003-05-09 Calculates dist VERSION using both File/*/Link.pm Renamed copylink as safecopylink and reimplemented copylink using open-and-delete. 0.02 2003-05-06 Added File::Spec::Link->resolve Added tests (and renamed 1.t and copylink.t) Added documentation 0.01 Tue Apr 29 16:42:12 2003 - original version; created by h2xs 1.22 with options -XAn File::Copy::Link File-Copy-Link-0.140_1/copylink000666 000000 000000 00000001504 14732120254 014345 0ustar00000000 000000 #!perl use strict; use warnings; use File::Copy::Link qw(copylink); warn "$0: no links\n" unless @ARGV; copylink for @ARGV; __END__ =head1 NAME copylink - replace a link with a copy of the linked file =head1 SYNOPSIS copylink [link ...] =head1 DESCRIPTION Each of the links on the command line is replaced by a copy of the file that the link points too, so the copy can be edited without changing the original. The command is intended for modifying perl source files created by C<./Configure -Dmksymlinks>. =head1 SEE ALSO File::Copy::Link(3) =head1 AUTHOR Robin Barker, =head1 COPYRIGHT AND LICENSE Copyright 2003 by Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut $Id$ File-Copy-Link-0.140_1/examples/000777 000000 000000 00000000000 14732250534 014415 5ustar00000000 000000 File-Copy-Link-0.140_1/lib/000777 000000 000000 00000000000 14732250534 013345 5ustar00000000 000000 File-Copy-Link-0.140_1/Makefile.PL000666 000000 000000 00000000715 14732250427 014555 0ustar00000000 000000 # Note: this file was auto-generated by Module::Build::Compat version 0.4234 require 5.006; use ExtUtils::MakeMaker; WriteMakefile ( 'VERSION_FROM' => 'lib/File/Copy/Link.pm', 'NAME' => 'File::Copy::Link', 'PREREQ_PM' => { 'File::Copy' => 0, 'File::Spec' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [ 'copylink' ], 'PL_FILES' => {} ) ; File-Copy-Link-0.140_1/MANIFEST000666 000000 000000 00000000501 14732250331 013717 0ustar00000000 000000 Changes lib/File/Copy/Link.pm lib/File/Spec/Link.pm Build.PL Makefile.PL MANIFEST README t/chopfile.t t/copylink.t t/linked.t t/pod.t t/pod-coverage.t t/relative.t t/safecopylink.t t/can_symlink.pl t/File-Copy-Link.t copylink examples/copylink examples/filespec examples/safecopy META.yml META.json File-Copy-Link-0.140_1/META.json000666 000000 000000 00000001634 14732250537 014227 0ustar00000000 000000 { "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "File-Copy-Link", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Copy" : "0", "File::Spec" : "0" } } }, "release_status" : "unstable", "version" : "0.140_1", "x_serialization_backend" : "JSON::PP version 4.16" } File-Copy-Link-0.140_1/META.yml000666 000000 000000 00000001022 14732250535 014044 0ustar00000000 000000 --- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: File-Copy-Link no_index: directory: - t - inc requires: File::Copy: '0' File::Spec: '0' version: 0.140_1 x_serialization_backend: 'CPAN::Meta::YAML version 0.018' File-Copy-Link-0.140_1/README000666 000000 000000 00000002500 14732120254 013447 0ustar00000000 000000 File-Copy-Link version 0.15 =========================== The distribution File-Copy-Link includes the modules File::Spec::Link and File::Copy::Link and the script copylink. They include routines to read and copy links. version 0.15 XXX Version 0.14 fixed a precendence issue in File::Copy::Link. Version 0.113 fixed a typo in tests and changes to build files. Version 0.112 includes compliance with kwalitee metrics. Version 0.111 removes some debugging code. Version 0.110 includes changes for old Cwd. Version 0.100 includes changes to meet (some) Perl Best Practices. INSTALLATION To install this module you need some variety of make command or the Module::Build perl module. With make, type the following: perl Makefile.PL make make test make install With Module::Build, type the following: perl Build.PL perl Build perl Build test perl Build install DEPENDENCIES This module requires these other modules and libraries: File::Spec File::Copy Both of which are part of the core perl distribution, since at least perl5.005_03 in 1999. COPYRIGHT AND LICENCE Copyright (C) 2003, 2005, 2006, 2007, 2008, 2011, 2014 Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. $Id$ File-Copy-Link-0.140_1/t/000777 000000 000000 00000000000 14732250534 013042 5ustar00000000 000000 File-Copy-Link-0.140_1/t/can_symlink.pl000666 000000 000000 00000001277 14732242433 015714 0ustar00000000 000000 my $symlink_message; sub skip_symlink_message { return $symlink_message; } sub has_symlink { return 1 if eval{ symlink(q{}, q{}), 1; }; $symlink_message = q{symlink() not implemented}; return; } sub can_symlink { return unless has_symlink(); return 1 unless is_windows(); return 1 if $Win32::IsSymlinkCreationAllowed; $symlink_message = q{symlink creation not allowed}; return; } sub is_windows { # from File::Rename t/testlib.pl unless ( $] < 5.014 ) { if ( eval { require Perl::OSType; } ) { return Perl::OSType::is_os_type('Windows'); } diag $@; } return ( $^O eq q{MSWin32} ); } 1; File-Copy-Link-0.140_1/t/chopfile.t000666 000000 000000 00000001176 14732120254 015020 0ustar00000000 000000 #!perl # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl chopfile.t' use strict; use warnings; ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 3; BEGIN { use_ok('File::Spec::Link') }; ######################### like( File::Spec::Link->chopfile( File::Spec->catfile(qw(dir foo.ext))), qr(^dir\W?\z), "chopfile(dir/foo.ext)"); my $curr = File::Spec->curdir; like( File::Spec::Link->chopfile('file.ext'), qr(^$curr\W?\z), "chopfile(foo.ext)"); # $Id$ File-Copy-Link-0.140_1/t/copylink.t000666 000000 000000 00000003120 14732243610 015050 0ustar00000000 000000 #!perl # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl copylink.t' use strict; use warnings; ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More; BEGIN{ require 't/can_symlink.pl'; if (!can_symlink()) { plan skip_all => skip_symlink_message(); } plan tests => 6; use_ok('File::Copy::Link', qw(copylink) ); } ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. use File::Compare; use File::Temp qw(tempdir); use File::Spec; my $dir = tempdir; my $file = File::Spec->catfile($dir,'file.txt'); my $link = File::Spec->catfile($dir,'link.lnk'); open my $fh, q{>}, $file or die; print {$fh} "text\n" or die; close $fh or die; die $! if not(symlink 'file.txt', $link); die if not(-l $link); die if compare($file,$link); open $fh, q{>>}, $file or die; print {$fh} "more\n" or die; close $fh or die; not compare($file,$link) or die; ok( copylink($link), q{copylink}); ok( !(-l $link), q{not a link}); ok( !compare($file,$link), q{compare file and copy}); open $fh, q{>>}, $file or die; print {$fh} qq{more\n} or die; close $fh or die; compare($file,$link) or die; unlink $file or die; ok( -e $link, q{copy not deleted}); unlink $link or die; ok( !(-e $link), q{copy deleted}); # $Id$ File-Copy-Link-0.140_1/t/File-Copy-Link.t000666 000000 000000 00000001556 14732247172 015724 0ustar00000000 000000 # Before 'make install' is performed this script should be runnable with # 'make test'. After 'make install' it should work as 'perl File-Copy-Link.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use strict; use warnings; use Test::More tests => 5; BEGIN { use_ok('File::Copy::Link') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $dist_ver = File::Copy::Link->VERSION; ok(defined $dist_ver, 'has dist version'); $dist_ver = eval $dist_ver; for my $pack(qw(File::Spec::Link)) { require_ok($pack); my $pack_ver = $pack->VERSION; ok(defined $pack_ver, "package $pack has version"); cmp_ok( $pack_ver, "<=", $dist_ver, "package version <= dist version"); } File-Copy-Link-0.140_1/t/linked.t000666 000000 000000 00000010737 14732243717 014512 0ustar00000000 000000 #!perl # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl linked.t' use strict; use warnings; ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More; BEGIN { require 't/can_symlink.pl'; if (!can_symlink()) { plan skip_all => skip_symlink_message(); } plan tests => 20; use_ok('File::Spec::Link'); } ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. use Cwd (); use File::Temp qw(tempdir); chdir tempdir() or die; my $dir = 'test'; mkdir $dir or die; my $file = File::Spec->catfile($dir,'file.txt'); my $link = File::Spec->catfile($dir,'link.lnk'); my $loopx = File::Spec->catfile($dir,'x.lnk'); my $loopy = File::Spec->catfile($dir,'y.lnk'); open my $fh, q{>}, $file or die $!; print {$fh} "text\n" or die; close $fh or die; die unless symlink 'file.txt', $link and symlink 'y.lnk', $loopx and symlink 'x.lnk', $loopy; is( File::Spec->canonpath(File::Spec::Link->linked($link)), File::Spec->canonpath($file), 'linked - to file'); is( File::Spec->canonpath(File::Spec::Link->linked($loopx)), File::Spec->canonpath($loopy), 'linked - to link'); is( File::Spec->canonpath(File::Spec::Link->resolve($link)), File::Spec->canonpath($file), 'resolve - file'); ok( !defined(File::Spec::Link->resolve($loopx)), 'resolve - loop'); my $subdir = File::Spec->catdir($dir,'testdir'); my $linked = File::Spec->catdir($dir,'linkdir'); my $target = File::Spec->catfile($subdir,'file.txt'); my $unresolved = File::Spec->catfile($linked,'file.txt'); mkdir $subdir or die; open $fh, q{>}, $target or die "$target - $!\n"; print {$fh} "test\ntest\n" or die; close $fh or die; symlink 'testdir', $linked or die; is( File::Spec->canonpath(File::Spec::Link->linked($linked)), File::Spec->canonpath($subdir), 'linked - directory'); is( File::Spec->canonpath(File::Spec::Link->resolve($linked)), File::Spec->canonpath($subdir), 'resolve - directory'); SKIP: { skip q{Can't determine directory separator}, 2 unless File::Spec->catdir('abc','xyz') =~ /\A abc (\W+) xyz \z/msx; my $sep = $1; is( File::Spec->canonpath(File::Spec::Link->linked($linked.$sep)), File::Spec->canonpath($subdir), "linked - directory with $sep"); is( File::Spec->canonpath(File::Spec::Link->resolve($linked.$sep)), File::Spec->canonpath($subdir), "resolve - directory with $sep"); } is( File::Spec->canonpath(File::Spec::Link->resolve($unresolved)), File::Spec->canonpath($unresolved), 'resolve - embedded link'); is( File::Spec->canonpath(File::Spec::Link->resolve_all($linked)), File::Spec->canonpath($subdir), 'resolve_all - directory'); is( File::Spec->canonpath(File::Spec::Link->resolve_all($unresolved)), File::Spec->canonpath($target), 'resolve_all - file'); is( File::Spec->canonpath(File::Spec::Link->resolve_all( File::Spec->catfile($dir,File::Spec->updir,$unresolved))), File::Spec->canonpath($target), 'resolve_all - file'); my $hasCwd = eval { require Cwd }; SKIP: { skip 'No Cwd!', 1 unless $hasCwd; is( File::Spec->canonpath(File::Spec::Link->resolve_all( File::Spec->rel2abs($unresolved))), File::Spec->catfile(Cwd::abs_path($subdir),'file.txt'), 'resolve_all - file absolute'); } is( File::Spec->canonpath(File::Spec::Link->full_resolve($linked)), File::Spec->canonpath($subdir), 'full_resolve - directory'); is( File::Spec->canonpath(File::Spec::Link->full_resolve($unresolved)), File::Spec->canonpath($target), 'full_resolve - file'); if( $hasCwd ) { is( File::Spec->canonpath(File::Spec::Link->resolve_path($linked)), File::Spec->canonpath($subdir), 'resolve_path - directory'); } else { ok( !File::Spec::Link->resolve_path($linked), 'resolve_path - directory'); } SKIP: { my $got = File::Spec::Link->resolve_path($unresolved); skip 'Old Cwd', 1 unless $hasCwd and (eval{Cwd->VERSION(2.18)} or $got); is( File::Spec->canonpath($got), File::Spec->canonpath($target), 'resolve_path - file'); } ok( !eval { File::Spec::Link->linked($file); 1 }, 'linked failed on file' ); like($@, qr/\bnot\s+a\s+link\b/, q{not 'nota link' in error message}); # $Id$ File-Copy-Link-0.140_1/t/pod-coverage.t000666 000000 000000 00000000450 14732120254 015574 0ustar00000000 000000 #!perl use strict; use warnings; use Test::More; eval{ require Test::Pod::Coverage; VERSION Test::Pod::Coverage 1.00; import Test::Pod::Coverage; }; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); # $Id$ File-Copy-Link-0.140_1/t/pod.t000666 000000 000000 00000000336 14732120254 014006 0ustar00000000 000000 #!perl use strict; use warnings; use Test::More; eval{ require Test::Pod; VERSION Test::Pod 1.00; import Test::Pod; }; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); # $Id$ File-Copy-Link-0.140_1/t/relative.t000666 000000 000000 00000001716 14732120254 015042 0ustar00000000 000000 #!perl # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl relative.t' use strict; use warnings; ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 3; BEGIN { use_ok('File::Spec::Link') }; ######################### is( File::Spec->canonpath( File::Spec::Link->relative_to_file( File::Spec->catfile(qw(dir foo.ext)), File::Spec->catfile(qw(dir1 dir2 bar.xyz)))), File::Spec->canonpath( File::Spec->catfile(qw(dir1 dir2 dir foo.ext))), "relative_to_file(dir/foo.ext,dir1/dir2/bar.xyz)"); my $path = File::Spec->catfile(File::Spec->rootdir,qw(dir foo.ext)); is( File::Spec->canonpath( File::Spec::Link->relative_to_file($path, File::Spec->catfile(qw(dir1 dir2 bar.xyz)))), File::Spec->canonpath($path), "relative_to_file(/dir/foo.ext,dir1/dir2/bar.xyz)"); # $Id$ File-Copy-Link-0.140_1/t/safecopylink.t000666 000000 000000 00000003067 14732243457 015732 0ustar00000000 000000 #!perl # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl safecopylink.t' use strict; use warnings; ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More; BEGIN{ require 't/can_symlink.pl'; if (!can_symlink()) { plan skip_all => skip_symlink_message(); } plan tests => 6; use_ok('File::Copy::Link', qw(safecopylink) ); } ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. use File::Compare; use File::Temp qw(tempdir); use File::Spec; my $dir = tempdir(); my $file = File::Spec->catfile($dir,'file.txt'); my $link = File::Spec->catfile($dir,'link.lnk'); open my $fh, ">", $file or die; print $fh "text\n" or die; close $fh or die; die unless symlink('file.txt',$link) && -l $link && !compare($file,$link); open $fh, ">>", $file or die; print $fh "more\n" or die; close $fh or die; not compare($file,$link) or die; ok( safecopylink($link), "safecopylink"); ok( !(-l $link), "not a link"); ok( !compare($file,$link), "compare file and copy"); open $fh, ">>", $file or die; print $fh "more\n" or die; close $fh or die; compare($file,$link) or die; unlink $file or die; ok( -e $link, "copy not deleted"); unlink $link or die; ok( !(-e $link), "copy deleted"); # $Id$ File-Copy-Link-0.140_1/lib/File/000777 000000 000000 00000000000 14732250534 014224 5ustar00000000 000000 File-Copy-Link-0.140_1/lib/File/Copy/000777 000000 000000 00000000000 14732250534 015136 5ustar00000000 000000 File-Copy-Link-0.140_1/lib/File/Spec/000777 000000 000000 00000000000 14732250534 015116 5ustar00000000 000000 File-Copy-Link-0.140_1/lib/File/Spec/Link.pm000666 000000 000000 00000022400 14732120254 016342 0ustar00000000 000000 package File::Spec::Link; use strict; use warnings; use File::Spec (); use base q(File::Spec); our $VERSION = 0.073; # over-ridden class method - just a debugging wrapper # sub canonpath { my($spec, $path) = @_; return $spec->SUPER::canonpath($path) if $path; require Carp; Carp::cluck( "canonpath: ", defined $path ? "empty path" : "path undefined" ); return $path; } sub catdir { my $spec = shift; return @_ ? $spec->SUPER::catdir(@_) : $spec->curdir } # new class methods - implemented via objects # sub linked { my $self = shift -> new(@_); return unless $self -> follow; return $self -> path; } sub resolve { my $self = shift -> new(@_); return unless $self -> resolved; return $self -> path; } sub resolve_all { my $self = shift -> new(@_); return unless $self -> resolvedir; return $self -> path; } sub relative_to_file { my($spec, $path) = splice @_, 0, 2; my $self = $spec -> new(@_); return unless $self -> relative($path); return $self -> path; } sub chopfile { my $self = shift -> new(@_); return $self -> path if length($self -> chop); return } # other new class methods - implemented via Cwd # sub full_resolve { my($spec, $file) = @_; my $path = $spec->resolve_path($file); return defined $path ? $path : $spec->resolve_all($file); } sub resolve_path { my($spec, $file) = @_; my $path = do { local $SIG{__WARN__} = sub { if ($_[0] =~ /^opendir\b/ and $_[0] =~ /\bNot\s+a\s+directory\b/ and $Cwd::VERSION < 2.18 and not -d $file) { warn <file_name_is_absolute($file) ? $path : $spec->abs2rel($path); } # old class method - not needed # sub splitlast { my $self = shift -> new(@_); my $last_path = $self -> chop; return ($self -> path, $last_path); } # object methods: # constructor methods new # access methods path, canonical, vol, dir # updating methods add, pop, push, split, chop # relative, follow, resolved, resolvedir sub new { my $self = bless { }, shift; $self -> split(shift) if @_; return $self; } sub path { my $self = shift; return $self -> catpath( $self->vol, $self->dir, q{} ); } sub canonical { my $self = shift; return $self -> canonpath( $self -> path ); } sub vol { my $vol = shift->{vol}; return defined $vol ? $vol : q{} } sub dir { my $self = shift; return $self -> catdir( $self -> dirs ); } sub dirs { my $dirs = shift->{dirs}; return $dirs ? @{$dirs} : () } sub add { my($self, $file) = @_; if( $file eq $self -> curdir ) { } elsif( $file eq $self -> updir ) { $self -> pop } else { $self -> push($file); } return; } sub pop { my $self = shift; my @dirs = $self -> dirs; if( not @dirs or $dirs[-1] eq $self -> updir ) { push @{$self->{dirs}}, $self -> updir; } elsif( length $dirs[-1] and $dirs[-1] ne $self -> curdir) { CORE::pop @{$self->{dirs}} } else { require Carp; Carp::cluck( "Can't go up from ", length $dirs[-1] ? $dirs[-1]: "empty dir" ); } return; } sub push { my $self = shift; my $file = shift; CORE::push @{$self->{dirs}}, $file if length $file; return; } sub split { my($self, $path) = @_; my($vol, $dir, $file) = $self->splitpath($path, 1); $self->{vol} = $vol; $self->{dirs} = [ $self->splitdir($dir) ]; $self->push($file); return; } sub chop { my $self = shift; my $dirs = $self->{dirs}; my $file = ''; while( @$dirs ) { last if @$dirs == 1 and not length $dirs->[0]; # path = '/' last if length($file = CORE::pop @$dirs); } return $file; } sub follow { my $self = shift; my $path = $self -> path; my $link = readlink $self->path; return $self->relative($link) if defined $link; require Carp; Carp::confess( "Can't readlink ", $self->path, " : ", (-l $self->path ? "but it is" : "not"), " a link" ); } sub relative { my($self, $path) = @_; unless( $self->file_name_is_absolute($path) ) { return unless length($self->chop); $path = $self->catdir($self->path, $path); } # what we want to do here is just set $self->{path} # to be read by $self->path; but would need to # unset $self->{path} whenever it becomes invalid $self->split($path); return 1; } sub resolved { my $self = shift; my $seen = @_ ? shift : {}; while( -l $self->path ) { return if $seen->{$self->canonical}++; return unless $self->follow; } return 1; } sub resolvedir { my $self = shift; my $seen = @_ ? shift : {}; my @path; while( 1 ) { return unless $self->resolved($seen); my $last = $self->chop; last unless length $last; unshift @path, $last; } $self->add($_) for @path; return 1; } 1; __END__ # Below is stub documentation for your module. You'd better edit it! =head1 NAME File::Spec::Link - Perl extension for reading and resolving symbolic links =head1 SYNOPSIS use File::Spec::Link; my $file = File::Spec::Link->linked($link); my $file = File::Spec::Link->resolve($link); my $dirname = File::Spec::Link->chopfile($file); my $newname = File::Spec::Link->relative_to_file($path, $link); my $realname = File::Spec::Link->full_resolve($file); my $realname = File::Spec::Link->resolve_path($file); my $realname = File::Spec::Link->resolve_all($file); =head1 DESCRIPTION C is an extension to C, adding methods for resolving symbolic links; it was created to implement C. =over =item C<< linked($link) >> Returns the filename linked to by C<$link>: by Cing C<$link>, and resolving that path relative to the directory of C<$link>. =item C<< resolve($link) >> Returns the non-link ultimately linked to by C<$link>, by repeatedly calling C. Returns C if the link can not be resolved. =item C<< chopfile($file) >> Returns the directory of C<$file>, by splitting the path of C<$file> and returning (the volumne and) directory parts. =item C<< relative_to_file($path, $file) >> Returns the path of C<$path> relative to the directory of file C<$file>. If C<$path> is absolute, just returns C<$path>. =item C<< resolve_all($file) >> Returns the filename of C<$file> with all links in the path resolved, wihout using C. =item C<< full_resolve($file) >> Returns the filename of C<$file> with all links in the path resolved. This sub tries to use C via C<< ->resolve_path >>. =item C<< resolve_path($file) >> Returns the filename of C<$file> with all links in the path resolved. This sub uses C and is independent of the rest of C. =back =head2 Object methods =over 4 =item C<< new([$path]) >> create new path object: stores path as a list =item C<< path >> returns path as a string, using catpath =item C<< canonical >> returns canonical path, using canonpath =item C<< vol >> returns volume element of path, see File::Spec->splitpath =item C<< dir >> returns directory element of path, as a string, see File::Spec->splitpath =item C<< dirs >> return list of directory components in path, see File::Spec->splitdir =item C<< pop >> remove last component of the path =item C<< push($file) >> add a file component to the path, ignoring empty strings =item C<< add($file) >> add a component to the path: treating C as C, and ignoring C and empty strings =item C<< split($path) >> populate a path object, using splitpath =item C<< chop >> remove and return a file component from path, an empty string returns means this was root dir. =item C<< relative($path) >> replace the path object with the supplied path, where the new path is relative to the path object =item C<< follow >> follow the link, where the path object is a link =item C<< resolved >> resolve the path object, by repeatedly following links =item C<< resolvedir >> resolve the links at all component levels within the path object =back =head2 Other class methods =over 4 =item C<< canonpath($path) >> Wrapper round File::Spec::canonpath, fatal if empty input =item C<< catdir(@dirs) >> Wrapper round File::Spec::catdir, returns C from empty list =item C<< splitlast($path) >> Get component from C<$path> (using C) and returns remaining path and compenent, as strings. [Not used] =back =head2 EXPORT None - all subs are methods for C. =head1 SEE ALSO File::Spec(3) File::Copy::Link(3) =head1 AUTHOR Robin Barker, =head1 COPYRIGHT AND LICENSE Copyright 2003, 2005, 2006, 2007, 2011, 2014 by Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut $Id$ File-Copy-Link-0.140_1/lib/File/Copy/Link.pm000666 000000 000000 00000004501 14732244027 016371 0ustar00000000 000000 package File::Copy::Link; use strict; use warnings; use Carp; use File::Copy (); require Exporter; use base qw(Exporter); our @EXPORT_OK = qw(copylink safecopylink); our $VERSION = '0.140_1'; sub copylink { local $_ = @_ ? shift : $_; # default to $_ croak "$_ not a link\n" unless -l; open my $fh, '<', $_ or croak "Can't open link $_: $!\n"; unlink or croak "Can't unlink link $_: $!\n"; my $ok = File::Copy::copy $fh, $_; croak "copy($fh $_) failed: $!\n" unless $ok; return $ok; } sub safecopylink { local $_ = @_ ? shift : $_; # default to $_ croak "$_ not a link\n" unless -l; require File::Spec::Link; my $orig = File::Spec::Link->linked($_); croak "$_ link problem\n" unless defined $orig; unlink or croak "Can't unlink link $_: $!\n"; my $ok = File::Copy::copy $orig, $_; croak "copy($orig $_) failed: $!\n" unless $ok; return $ok; } 1; __END__ # Below is stub documentation for your module. You'd better edit it! =head1 NAME File::Copy::Link - extension for replacing a link by a copy of the linked file =head1 SYNOPSIS use File::Copy::Link; copylink 'file.lnk'; use File::Copy::Link qw(safecopylink); safecopylink 'file.lnk'; =head1 DESCRIPTION =over 4 =item C reads the filename linked to by the argument and replaced the link with a copy of the file. It opens a filehandle to read from the link, deletes the link, and then copies the filehandle back to the link. =item C does the same as C but without the open-and-delete manouvre. Instead, it uses C to find the target of the link and copies from there. =back This module is mostly a wrapper round C and C, the functionality is available in a command line script F. =head2 EXPORT Nothing by default, can export C, `C. =head1 SEE ALSO copylink(1) File::Copy(3) File::Spec::Link(3) =head1 AUTHOR Robin Barker, =head1 COPYRIGHT AND LICENSE Copyright 2003, 2006, 2007, 2011, 2014 by Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut $Id$ File-Copy-Link-0.140_1/examples/copylink000666 000000 000000 00000000261 14732120254 016162 0ustar00000000 000000 #!perl use strict; use warnings; use File::Copy::Link qw(copylink); my $VERSION = $File::Copy::Link::VERSION; for my $file (@ARGV) { copylink $file; } # $Id$ File-Copy-Link-0.140_1/examples/filespec000666 000000 000000 00000001465 14732120254 016133 0ustar00000000 000000 #!perl use strict; use warnings; use File::Spec::Link (); my $VERSION = $File::Spec::Link::VERSION; for my $link (@ARGV) { local $\ = "\n"; print "$link linked to ", File::Spec::Link->linked($link); print "$link resolves to ", File::Spec::Link->resolve($link); print "$link directory ", File::Spec::Link->chopfile($link); print "$link relative to . ", File::Spec::Link->relative_to_file(File::Spec->curdir, $link); # use Cwd::abs_path() print "$link path resolved: ", File::Spec::Link->resolve_path($link); # tries to use Cwd::abs_path() print "$link fully resolved: ", File::Spec::Link->full_resolve($link); # without using Cwd print "$link all resolved: ", File::Spec::Link->resolve_all($link); } # $Id$ File-Copy-Link-0.140_1/examples/safecopy000666 000000 000000 00000000271 14732120254 016144 0ustar00000000 000000 #!perl use strict; use warnings; use File::Copy::Link qw(safecopylink); my $VERSION = $File::Copy::Link::VERSION; for my $file (@ARGV) { safecopylink $file; } # $Id$