Add filter capability to RecursiveCopy::copypath

This allows skipping copying certain files and subdirectories in tests.
This is useful in some circumstances such as copying a data directory;
future tests want this feature.

Also POD-ify the module.

Authors: Craig Ringer, Pallavi Sontakke
Reviewed-By: Álvaro Herrera

diff --git a/src/test/perl/RecursiveCopy.pm b/src/test/perl/RecursiveCopy.pm
index 9362aa89590fdbc23132052c60321feae10090b0..c4da1bbd837b1b3b802cdebac618c7ba3b7a3acc 100644 (file)
--- a/src/test/perl/RecursiveCopy.pm
+++ b/src/test/perl/RecursiveCopy.pm
@@ -1,4 +1,19 @@
-# RecursiveCopy, a simple recursive copy implementation
+
+=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;
@@ -7,16 +22,85 @@ use warnings;
 use File::Basename;
 use File::Copy;
 
+=pod
+
+=head1 DESCRIPTION
+
+=head2 copypath($from, $to, %params)
+
+Recursively copy all files and directories from $from to $to.
+
+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. Always returns true.
+
+If the B<filterfn> 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 pg_log and contents
+       my $src = shift;
+       return $src ne 'pg_log';
+   }
+ );
+
+=cut
+
 sub copypath
 {
-   my $srcpath  = shift;
-   my $destpath = shift;
+   my ($base_src_dir, $base_dest_dir, %params) = @_;
+   my $filterfn;
 
-   die "Cannot operate on symlinks" if -l $srcpath or -l $destpath;
+   if (defined $params{filterfn})
+   {
+       die "if specified, filterfn must be a subroutine reference"
+         unless defined(ref $params{filterfn})
+         and (ref $params{filterfn} eq 'CODE');
 
-   # This source path is a file, simply copy it to destination with the
-   # same name.
-   die "Destination path $destpath exists as file" if -f $destpath;
+       $filterfn = $params{filterfn};
+   }
+   else
+   {
+       $filterfn = sub { return 1; };
+   }
+
+   # 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
+   die "Cannot operate on symlinks" if -l $srcpath;
+
+   # Can't handle symlinks or other weird things
+   die "Source path \"$srcpath\" is not a regular file or directory"
+     unless -f $srcpath or -d $srcpath;
+
+   # Abort if destination path already exists.  Should we allow directories
+   # to exist already?
+   die "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)
    {
        copy($srcpath, $destpath)
@@ -24,18 +108,19 @@ sub copypath
        return 1;
    }
 
-   die "Destination needs to be a directory" unless -d $srcpath;
+   # Otherwise this is directory: create it on dest and recurse onto it.
    mkdir($destpath) or die "mkdir($destpath) failed: $!";
 
-   # Scan existing source directory and recursively copy everything.
    opendir(my $directory, $srcpath) or die "could not opendir($srcpath): $!";
    while (my $entry = readdir($directory))
    {
-       next if ($entry eq '.' || $entry eq '..');
-       RecursiveCopy::copypath("$srcpath/$entry", "$destpath/$entry")
+       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;
 }