File-Copy-Link-0.140000755001750001750 012355333526 13614 5ustar00robinrobin000000000000File-Copy-Link-0.140/MANIFEST000444001750001750 40712355333526 15063 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.yml META.json File-Copy-Link-0.140/META.json000444001750001750 236212355333526 15375 0ustar00robinrobin000000000000{ "abstract" : "extension for replacing a link by a copy of the linked file", "author" : [ "Robin Barker " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4205", "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.06" }, "File::Spec::Link" : { "file" : "lib/File/Spec/Link.pm", "version" : "0.073" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.140" } File-Copy-Link-0.140/Build.PL000444001750001750 373512355333526 15255 0ustar00robinrobin000000000000use 5.006; use Module::Build(); use Data::Dumper (); use List::Util qw(sum); use ExtUtils::MM (); my $dist_version = 0.14; 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), abstract_from => 'lib/File/Copy/Link.pm', 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 } ); { 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; }; 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}, ABSTRACT_FROM => $args{abstract_from}, PREREQ_PM => \%requires, EXE_FILES => $args{script_files}, PL_FILES => {} }; my $dump = Data::Dumper->Dump( [$make], [qw(args)] ); print OUT < 'File::Copy::Link', 'AUTHOR' => 'Robin Barker ', 'ABSTRACT_FROM' => 'lib/File/Copy/Link.pm', 'PL_FILES' => {}, 'EXE_FILES' => [ 'copylink' ], 'PREREQ_PM' => { 'File::Spec' => 0, 'File::Copy' => 0 }, 'VERSION' => '0.140' }; WriteMakefile( %$args ); File-Copy-Link-0.140/META.yml000444001750001750 137012355333526 15223 0ustar00robinrobin000000000000--- abstract: '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.4205, CPAN::Meta::Converter version 2.140640' 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.06' File::Spec::Link: file: lib/File/Spec/Link.pm version: '0.073' recommends: Cwd: '2.18' requires: File::Copy: '0' File::Spec: '0' perl: '5.006' resources: license: http://dev.perl.org/licenses/ version: '0.140' File-Copy-Link-0.140/README000444001750001750 244012355333526 14631 0ustar00robinrobin000000000000File-Copy-Link version 0.14 =========================== 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.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: README 354 2014-07-03 19:42:34Z robin $ File-Copy-Link-0.140/copylink000444001750001750 150012355333526 15520 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, =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 278 2011-09-24 00:27:05Z robin $ File-Copy-Link-0.140/Changes000444001750001750 332312355333526 15245 0ustar00robinrobin000000000000Revision history for Perl distribution File-Copy-Link. $Id: Changes 354 2014-07-03 19:42:34Z robin $ 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/lib000755001750001750 012355333526 14362 5ustar00robinrobin000000000000File-Copy-Link-0.140/lib/File000755001750001750 012355333526 15241 5ustar00robinrobin000000000000File-Copy-Link-0.140/lib/File/Copy000755001750001750 012355333526 16153 5ustar00robinrobin000000000000File-Copy-Link-0.140/lib/File/Copy/Link.pm000444001750001750 440612355333526 17547 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.06'; 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: Link.pm 342 2014-06-23 18:30:53Z robin $ File-Copy-Link-0.140/lib/File/Spec000755001750001750 012355333526 16133 5ustar00robinrobin000000000000File-Copy-Link-0.140/lib/File/Spec/Link.pm000444001750001750 2163712355333526 17554 0ustar00robinrobin000000000000package 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: Link.pm 342 2014-06-23 18:30:53Z robin $ File-Copy-Link-0.140/examples000755001750001750 012355333526 15432 5ustar00robinrobin000000000000File-Copy-Link-0.140/examples/safecopy000444001750001750 32612355333526 17304 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.140/examples/filespec000444001750001750 150112355333526 17301 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.140/examples/copylink000444001750001750 31612355333526 17322 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.140/t000755001750001750 012355333526 14057 5ustar00robinrobin000000000000File-Copy-Link-0.140/t/pod.t000444001750001750 37212355333526 15145 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.140/t/pod-coverage.t000444001750001750 51012355333526 16730 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 $ File-Copy-Link-0.140/t/chopfile.t000444001750001750 121512355333526 16171 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.140/t/relative.t000444001750001750 172612355333526 16222 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.140/t/copylink.t000444001750001750 305312355333526 16232 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.140/t/linked.t000444001750001750 1056612355333526 15677 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.140/t/safecopylink.t000444001750001750 303312355333526 17067 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 $