File-Copy-Link-0.113000755001750001750 011637121153 13605 5ustar00robinrobin000000000000File-Copy-Link-0.113/META.json000444001750001750 242611637121153 15367 0ustar00robinrobin000000000000{ "abstract" : "Perl extension for replacing a link by a copy of the linked file.", "author" : [ "Robin Barker " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.112150", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "File-Copy-Link", "prereqs" : { "build" : { "requires" : { "File::Temp" : 0, "Test::More" : 0 } }, "configure" : { "requires" : { "Module::Build" : "0.38" } }, "runtime" : { "recommends" : { "Cwd" : "2.18" }, "requires" : { "File::Copy" : 0, "File::Spec" : 0, "perl" : "5.006" } } }, "provides" : { "File::Copy::Link" : { "file" : "lib/File/Copy/Link.pm", "version" : "0.04" }, "File::Spec::Link" : { "file" : "lib/File/Spec/Link.pm", "version" : "0.072" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.113" } File-Copy-Link-0.113/Build.PL000444001750001750 321011637121153 15232 0ustar00robinrobin000000000000use 5.006; use Module::Build(); use Data::Dumper (); use List::Util qw(sum); use ExtUtils::MM (); my $dist_version = 0.113; my $mods_version = sum map {MM->parse_version($_)} ; if ($dist_version < $mods_version ) { warn "Declared dist version ($dist_version) is less than\n", "that derived from module versions ($mods_version)\n"; $dist_version = $mods_version; } my %args = ( module_name => 'File::Copy::Link', dist_version => sprintf("%.3f", $dist_version), license => 'perl', requires => { File::Spec => 0, File::Copy => 0, perl => 5.006 }, recommends => { Cwd => 2.18, }, script_files => [ qw(copylink) ], dist_author => 'Robin Barker ', build_requires => { Test::More => 0, File::Temp => 0 }, configure_requires => { 'Module::Build' => 0.38 } ); Module::Build -> new ( %args ) -> create_build_script; my $file = 'Makefile.PL'; if( open OUT, '>', $file ) { my %requires = %{$args{requires}}; my $perl = delete $requires{perl} || 5; my $make = { NAME => $args{module_name}, VERSION => $args{dist_version}, AUTHOR => $args{dist_author}, PREREQ_PM => \%requires, EXE_FILES => $args{script_files}, PL_FILES => {} }; my $dump = Data::Dumper->Dump( [$make], [qw(args)] ); print OUT < {}, 'NAME' => 'File::Copy::Link', 'AUTHOR' => 'Robin Barker ', 'EXE_FILES' => [ 'copylink' ], 'VERSION' => '0.113', 'PREREQ_PM' => { 'File::Copy' => 0, 'File::Spec' => 0 } }; WriteMakefile( %$args ); File-Copy-Link-0.113/MANIFEST000444001750001750 53311637121153 15054 0ustar00robinrobin000000000000Changes 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 copylink examples/copylink examples/filespec examples/safecopy META.json Module meta-data (added by Module::Build) META.yml Module meta-data (added by MakeMaker) File-Copy-Link-0.113/Changes000444001750001750 306011637121153 15234 0ustar00robinrobin000000000000Revision history for Perl distribution File-Copy-Link. $Id: Changes 266 2011-09-23 15:09:10Z robin $ 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.113/README000444001750001750 233711637121153 14627 0ustar00robinrobin000000000000File-Copy-Link version 0.113 ============================ 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.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 Robin Barker This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. $Id: README 266 2011-09-23 15:09:10Z robin $ File-Copy-Link-0.113/META.yml000444001750001750 134611637121153 15217 0ustar00robinrobin000000000000--- abstract: 'Perl extension for replacing a link by a copy of the linked file.' author: - 'Robin Barker ' build_requires: File::Temp: 0 Test::More: 0 configure_requires: Module::Build: 0.38 dynamic_config: 1 generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.112150' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: File-Copy-Link provides: File::Copy::Link: file: lib/File/Copy/Link.pm version: 0.04 File::Spec::Link: file: lib/File/Spec/Link.pm version: 0.072 recommends: Cwd: 2.18 requires: File::Copy: 0 File::Spec: 0 perl: 5.006 resources: license: http://dev.perl.org/licenses/ version: 0.113 File-Copy-Link-0.113/copylink000444001750001750 151311637121153 15515 0ustar00robinrobin000000000000#!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, ERobin.Barker@npl.co.ukE =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: copylink 82 2006-07-26 08:55:37Z rmb1 $ File-Copy-Link-0.113/lib000755001750001750 011637121153 14353 5ustar00robinrobin000000000000File-Copy-Link-0.113/lib/File000755001750001750 011637121153 15232 5ustar00robinrobin000000000000File-Copy-Link-0.113/lib/File/Spec000755001750001750 011637121153 16124 5ustar00robinrobin000000000000File-Copy-Link-0.113/lib/File/Spec/Link.pm000444001750001750 2163711637121153 17545 0ustar00robinrobin000000000000package File::Spec::Link; use strict; use warnings; use File::Spec (); use base q(File::Spec); our $VERSION = 0.072; # 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, ERobin.Barker@npl.co.ukE =head1 COPYRIGHT AND LICENSE Copyright 2003, 2005, 2006, 2007 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: Link.pm 221 2008-06-12 12:32:23Z rmb1 $ File-Copy-Link-0.113/lib/File/Copy000755001750001750 011637121153 16144 5ustar00robinrobin000000000000File-Copy-Link-0.113/lib/File/Copy/Link.pm000444001750001750 431611637121153 17540 0ustar00robinrobin000000000000package 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.04'; 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"; return File::Copy::copy $fh, $_ or croak "copy($fh $_) failed: $!\n"; } 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"; return File::Copy::copy $orig, $_ or croak "copy($orig $_) failed: $!\n"; } 1; __END__ # Below is stub documentation for your module. You'd better edit it! =head1 NAME File::Copy::Link - Perl 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, ERobin.Barker@npl.co.ukE =head1 COPYRIGHT AND LICENSE Copyright 2003, 2006, 2007 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: Link.pm 175 2007-12-30 16:28:03Z rmb1 $ File-Copy-Link-0.113/examples000755001750001750 011637121153 15423 5ustar00robinrobin000000000000File-Copy-Link-0.113/examples/filespec000444001750001750 150111637121153 17272 0ustar00robinrobin000000000000#!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: filespec 219 2008-06-12 12:31:18Z rmb1 $ File-Copy-Link-0.113/examples/copylink000444001750001750 31611637121153 17313 0ustar00robinrobin000000000000#!perl use strict; use warnings; use File::Copy::Link qw(copylink); my $VERSION = $File::Copy::Link::VERSION; for my $file (@ARGV) { copylink $file; } # $Id: copylink 218 2008-06-12 11:09:11Z rmb1 $ File-Copy-Link-0.113/examples/safecopy000444001750001750 32611637121153 17275 0ustar00robinrobin000000000000#!perl use strict; use warnings; use File::Copy::Link qw(safecopylink); my $VERSION = $File::Copy::Link::VERSION; for my $file (@ARGV) { safecopylink $file; } # $Id: safecopy 219 2008-06-12 12:31:18Z rmb1 $ File-Copy-Link-0.113/t000755001750001750 011637121153 14050 5ustar00robinrobin000000000000File-Copy-Link-0.113/t/linked.t000444001750001750 1056611637121153 15670 0ustar00robinrobin000000000000#!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{ if( !eval{ symlink q{}, q{}; 1 } ) { plan skip_all => q{'symlink' not implemented}; } 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: linked.t 224 2008-06-12 14:22:17Z rmb1 $ File-Copy-Link-0.113/t/copylink.t000444001750001750 305311637121153 16223 0ustar00robinrobin000000000000#!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{ if( !eval{ (symlink q{}, q{}), 1 } ) { plan skip_all => q{'symlink' not implemented}; } 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: copylink.t 187 2007-12-31 00:29:35Z rmb1 $ File-Copy-Link-0.113/t/pod.t000444001750001750 37211637121153 15136 0ustar00robinrobin000000000000#!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: pod.t 82 2006-07-26 08:55:37Z rmb1 $ File-Copy-Link-0.113/t/chopfile.t000444001750001750 121511637121153 16162 0ustar00robinrobin000000000000#!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: chopfile.t 82 2006-07-26 08:55:37Z rmb1 $ File-Copy-Link-0.113/t/safecopylink.t000444001750001750 303311637121153 17060 0ustar00robinrobin000000000000#!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{ if( !eval{ (symlink q{}, q{}), 1 } ) { plan skip_all => q{'symlink' not implemented}; } 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: safecopylink.t 187 2007-12-31 00:29:35Z rmb1 $ File-Copy-Link-0.113/t/relative.t000444001750001750 172611637121153 16213 0ustar00robinrobin000000000000#!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: relative.t 82 2006-07-26 08:55:37Z rmb1 $ File-Copy-Link-0.113/t/pod-coverage.t000444001750001750 51011637121153 16721 0ustar00robinrobin000000000000#!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: pod-coverage.t 82 2006-07-26 08:55:37Z rmb1 $