From b3b4d8e68ae83f432f43f035c7eb481ef93e1583 Mon Sep 17 00:00:00 2001 From: Andrew Dunstan Date: Sun, 24 Oct 2021 10:28:19 -0400 Subject: Move Perl test modules to a better namespace The five modules in our TAP test framework all had names in the top level namespace. This is unwise because, even though we're not exporting them to CPAN, the names can leak, for example if they are exported by the RPM build process. We therefore move the modules to the PostgreSQL::Test namespace. In the process PostgresNode is renamed to Cluster, and TestLib is renamed to Utils. PostgresVersion becomes simply PostgreSQL::Version, to avoid possible confusion about what it's the version of. Discussion: https://postgr.es/m/aede93a4-7d92-ef26-398f-5094944c2504@dunslane.net Reviewed by Erik Rijkers and Michael Paquier --- src/test/perl/RecursiveCopy.pm | 157 ----------------------------------------- 1 file changed, 157 deletions(-) delete mode 100644 src/test/perl/RecursiveCopy.pm (limited to 'src/test/perl/RecursiveCopy.pm') diff --git a/src/test/perl/RecursiveCopy.pm b/src/test/perl/RecursiveCopy.pm deleted file mode 100644 index 8a9cc722b55..00000000000 --- a/src/test/perl/RecursiveCopy.pm +++ /dev/null @@ -1,157 +0,0 @@ - -# Copyright (c) 2021, PostgreSQL Global Development Group - -=pod - -=head1 NAME - -RecursiveCopy - simple recursive copy implementation - -=head1 SYNOPSIS - -use RecursiveCopy; - -RecursiveCopy::copypath($from, $to, filterfn => sub { return 1; }); -RecursiveCopy::copypath($from, $to); - -=cut - -package RecursiveCopy; - -use strict; -use warnings; - -use Carp; -use File::Basename; -use File::Copy; - -=pod - -=head1 DESCRIPTION - -=head2 copypath($from, $to, %params) - -Recursively copy all files and directories from $from to $to. -Does not preserve file metadata (e.g., permissions). - -Only regular files and subdirectories are copied. Trying to copy other types -of directory entries raises an exception. - -Raises an exception if a file would be overwritten, the source directory can't -be read, or any I/O operation fails. However, we silently ignore ENOENT on -open, because when copying from a live database it's possible for a file/dir -to be deleted after we see its directory entry but before we can open it. - -Always returns true. - -If the B parameter is given, it must be a subroutine reference. -This subroutine will be called for each entry in the source directory with its -relative path as only parameter; if the subroutine returns true the entry is -copied, otherwise the file is skipped. - -On failure the target directory may be in some incomplete state; no cleanup is -attempted. - -=head1 EXAMPLES - - RecursiveCopy::copypath('/some/path', '/empty/dir', - filterfn => sub { - # omit log/ and contents - my $src = shift; - return $src ne 'log'; - } - ); - -=cut - -sub copypath -{ - my ($base_src_dir, $base_dest_dir, %params) = @_; - my $filterfn; - - if (defined $params{filterfn}) - { - croak "if specified, filterfn must be a subroutine reference" - unless defined(ref $params{filterfn}) - and (ref $params{filterfn} eq 'CODE'); - - $filterfn = $params{filterfn}; - } - else - { - $filterfn = sub { return 1; }; - } - - # Complain if original path is bogus, because _copypath_recurse won't. - croak "\"$base_src_dir\" does not exist" if !-e $base_src_dir; - - # Start recursive copy from current directory - return _copypath_recurse($base_src_dir, $base_dest_dir, "", $filterfn); -} - -# Recursive private guts of copypath -sub _copypath_recurse -{ - my ($base_src_dir, $base_dest_dir, $curr_path, $filterfn) = @_; - my $srcpath = "$base_src_dir/$curr_path"; - my $destpath = "$base_dest_dir/$curr_path"; - - # invoke the filter and skip all further operation if it returns false - return 1 unless &$filterfn($curr_path); - - # Check for symlink -- needed only on source dir - # (note: this will fall through quietly if file is already gone) - croak "Cannot operate on symlink \"$srcpath\"" if -l $srcpath; - - # Abort if destination path already exists. Should we allow directories - # to exist already? - croak "Destination path \"$destpath\" already exists" if -e $destpath; - - # If this source path is a file, simply copy it to destination with the - # same name and we're done. - if (-f $srcpath) - { - my $fh; - unless (open($fh, '<', $srcpath)) - { - return 1 if ($!{ENOENT}); - die "open($srcpath) failed: $!"; - } - copy($fh, $destpath) - or die "copy $srcpath -> $destpath failed: $!"; - close $fh; - return 1; - } - - # If it's a directory, create it on dest and recurse into it. - if (-d $srcpath) - { - my $directory; - unless (opendir($directory, $srcpath)) - { - return 1 if ($!{ENOENT}); - die "opendir($srcpath) failed: $!"; - } - - mkdir($destpath) or die "mkdir($destpath) failed: $!"; - - while (my $entry = readdir($directory)) - { - next if ($entry eq '.' or $entry eq '..'); - _copypath_recurse($base_src_dir, $base_dest_dir, - $curr_path eq '' ? $entry : "$curr_path/$entry", $filterfn) - or die "copypath $srcpath/$entry -> $destpath/$entry failed"; - } - - closedir($directory); - return 1; - } - - # If it disappeared from sight, that's OK. - return 1 if !-e $srcpath; - - # Else it's some weird file type; complain. - croak "Source path \"$srcpath\" is not a regular file or directory"; -} - -1; -- cgit v1.2.3