File-Copy-Link-0.200000755000000000000 014734465522 14540 5ustar00unknownunknown000000000000File-Copy-Link-0.200/Build.PL000444000000000000 210214733757177 16175 0ustar00unknownunknown000000000000use 5.006; use Module::Build(); if ( $ENV{PERL_USE_UNSAFE_INC} ) { warn <<'UNSAFE'; PERL_USE_UNSAFE_INC not needed for Build and test UNSAFE warn << 'DEV' if -d q(.git); Set PERL_USE_UNSAFE_INC=0 for development DEV } 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(bin/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.200/CONTRIBUTING000444000000000000 16614732634375 16514 0ustar00unknownunknown000000000000CONTRIBUTING To report a bug or request a feature use https://rt.cpan.org/Dist/Display.html?Name=File-Copy-Link File-Copy-Link-0.200/Changes000444000000000000 365514734465433 16202 0ustar00unknownunknown000000000000Revision history for Perl distribution File-Copy-Link. 0.200 2024-12-30 Detect when Windows has symlink() - but symlink creation is not allowed Remove use of base.pm Add usage/options for copylink script - add test for copylink script 0.140 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.200/MANIFEST000444000000000000 55014734026325 16000 0ustar00unknownunknown000000000000Changes lib/File/Copy/Link.pm lib/File/Spec/Link.pm Build.PL Makefile.PL CONTRIBUTING MANIFEST README t/chopfile.t t/copylink.t t/copylink-script.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 bin/copylink examples/copylink examples/filespec examples/safecopy META.yml META.json File-Copy-Link-0.200/META.json000444000000000000 253714734465522 16325 0ustar00unknownunknown000000000000{ "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.4234", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "File-Copy-Link", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.4" } }, "runtime" : { "recommends" : { "Cwd" : "2.18" }, "requires" : { "File::Copy" : "0", "File::Spec" : "0", "perl" : "5.006" } }, "test" : { "requires" : { "File::Temp" : "0", "Test::More" : "0" } } }, "provides" : { "File::Copy::Link" : { "file" : "lib/File/Copy/Link.pm", "version" : "0.200" }, "File::Spec::Link" : { "file" : "lib/File/Spec/Link.pm", "version" : "0.08" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.200", "x_serialization_backend" : "JSON::PP version 4.16" } File-Copy-Link-0.200/META.yml000444000000000000 152214734465522 16146 0ustar00unknownunknown000000000000--- 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.4' dynamic_config: 1 generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010' 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.200' File::Spec::Link: file: lib/File/Spec/Link.pm version: '0.08' recommends: Cwd: '2.18' requires: File::Copy: '0' File::Spec: '0' perl: '5.006' resources: license: http://dev.perl.org/licenses/ version: '0.200' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' File-Copy-Link-0.200/Makefile.PL000444000000000000 72114734465522 16627 0ustar00unknownunknown000000000000# 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', 'EXE_FILES' => [ 'bin/copylink' ], 'PL_FILES' => {}, 'PREREQ_PM' => { 'File::Copy' => 0, 'File::Spec' => 0 }, 'INSTALLDIRS' => 'site', 'NAME' => 'File::Copy::Link' ) ; File-Copy-Link-0.200/README000444000000000000 230514734207273 15552 0ustar00unknownunknown000000000000File-Copy-Link version 0.200 ============================ 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.200 detect if symlink creation is not allowed (Windows). Version 0.140 fixed a precendence issue in File::Copy::Link. 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-2008, 2011, 2014, 2024 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.200/bin000755000000000000 014734465522 15310 5ustar00unknownunknown000000000000File-Copy-Link-0.200/bin/copylink000444000000000000 243414734031625 17214 0ustar00unknownunknown000000000000#!perl use strict; use warnings; use Getopt::Long qw(GetOptions :config posix_defaults); use Pod::Usage; use File::Copy::Link qw(copylink); main() unless caller; sub main { GetOptions ( 'h|help' => \my $help, 'm|man' => \my $manual, ) or pod2usage(); pod2usage(1) if $help; pod2usage(-verbose=>2) if $manual; pod2usage("$0: no links") 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>. =head2 OPTIONS =over =item B<-h>|B<--help> Show usage and these options =item B<-m>|B<--man> Show manual page =back =head1 SEE ALSO File::Copy::Link(3) =head1 AUTHOR Robin Barker, =head1 COPYRIGHT AND LICENSE Copyright 2003, 2006, 2011, 2024 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.200/examples000755000000000000 014734465522 16356 5ustar00unknownunknown000000000000File-Copy-Link-0.200/examples/copylink000444000000000000 26114732120254 20231 0ustar00unknownunknown000000000000#!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.200/examples/filespec000444000000000000 146514732120254 20222 0ustar00unknownunknown000000000000#!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.200/examples/safecopy000444000000000000 27114732373512 20222 0ustar00unknownunknown000000000000#!perl use strict; use warnings; use File::Copy::Link qw(safecopylink); my $VERSION = $File::Copy::Link::VERSION; for my $file (@ARGV) { safecopylink $file; } # $Id$ File-Copy-Link-0.200/lib000755000000000000 014734465522 15306 5ustar00unknownunknown000000000000File-Copy-Link-0.200/lib/File000755000000000000 014734465522 16165 5ustar00unknownunknown000000000000File-Copy-Link-0.200/lib/File/Copy000755000000000000 014734465522 17077 5ustar00unknownunknown000000000000File-Copy-Link-0.200/lib/File/Copy/Link.pm000444000000000000 445714734465433 20502 0ustar00unknownunknown000000000000package File::Copy::Link; use strict; use warnings; use Carp; use File::Copy (); require Exporter; push our @ISA, qw(Exporter); our @EXPORT_OK = qw(copylink safecopylink); our $VERSION = '0.200'; 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, 2024 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.200/lib/File/Spec000755000000000000 014734465522 17057 5ustar00unknownunknown000000000000File-Copy-Link-0.200/lib/File/Spec/Link.pm000444000000000000 2303514733307141 20461 0ustar00unknownunknown000000000000package File::Spec::Link; use strict; use warnings; require File::Spec; push our @ISA, qw(File::Spec); our $VERSION = 0.080; # 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, 2024 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.200/t000755000000000000 014734465522 15003 5ustar00unknownunknown000000000000File-Copy-Link-0.200/t/File-Copy-Link.t000444000000000000 156314733307141 20003 0ustar00unknownunknown000000000000# 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.200/t/can_symlink.pl000444000000000000 130414733307141 17771 0ustar00unknownunknown000000000000my $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.200/t/chopfile.t000444000000000000 116614733307141 17111 0ustar00unknownunknown000000000000#!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.200/t/copylink-script.t000444000000000000 345514734027421 20456 0ustar00unknownunknown000000000000#!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; require './blib/script/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; my $warn; my $main; { local $SIG{__WARN__} = sub { $warn .= $_[0]; }; local @ARGV = ($link); $main = eval { main(); 1; }; } ok( $main, q{copylink script} ); ok( !$warn, q{copylink script - no warnings} ); 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.200/t/copylink.t000444000000000000 317714733760155 17164 0ustar00unknownunknown000000000000#!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.200/t/linked.t000444000000000000 1152014733757653 16622 0ustar00unknownunknown000000000000#!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.200/t/pod-coverage.t000444000000000000 44614733307141 17653 0ustar00unknownunknown000000000000#!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.200/t/pod.t000444000000000000 33714733307141 16061 0ustar00unknownunknown000000000000#!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.200/t/relative.t000444000000000000 203714733307141 17131 0ustar00unknownunknown000000000000#!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.200/t/safecopylink.t000444000000000000 314114733757603 20016 0ustar00unknownunknown000000000000#!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$