@@ -29,12 +29,17 @@ use File::Copy;
2929=head2 copypath($from, $to, %params)
3030
3131Recursively copy all files and directories from $from to $to.
32+ Does not preserve file metadata (e.g., permissions).
3233
3334Only regular files and subdirectories are copied. Trying to copy other types
3435of directory entries raises an exception.
3536
3637Raises an exception if a file would be overwritten, the source directory can't
37- be read, or any I/O operation fails. Always returns true.
38+ be read, or any I/O operation fails. However, we silently ignore ENOENT on
39+ open, because when copying from a live database it's possible for a file/dir
40+ to be deleted after we see its directory entry but before we can open it.
41+
42+ Always returns true.
3843
3944If the B<filterfn > parameter is given, it must be a subroutine reference.
4045This subroutine will be called for each entry in the source directory with its
@@ -74,6 +79,9 @@ sub copypath
7479 $filterfn = sub { return 1; };
7580 }
7681
82+ # Complain if original path is bogus, because _copypath_recurse won't.
83+ die " \" $base_src_dir \" does not exist" if !-e $base_src_dir ;
84+
7785 # Start recursive copy from current directory
7886 return _copypath_recurse($base_src_dir , $base_dest_dir , " " , $filterfn );
7987}
@@ -89,12 +97,8 @@ sub _copypath_recurse
8997 return 1 unless &$filterfn ($curr_path );
9098
9199 # Check for symlink -- needed only on source dir
92- die " Cannot operate on symlinks" if -l $srcpath ;
93-
94- # Can't handle symlinks or other weird things
95- die " Source path \" $srcpath \" is not a regular file or directory"
96- unless -f $srcpath
97- or -d $srcpath ;
100+ # (note: this will fall through quietly if file is already gone)
101+ die " Cannot operate on symlink \" $srcpath \" " if -l $srcpath ;
98102
99103 # Abort if destination path already exists. Should we allow directories
100104 # to exist already?
@@ -104,25 +108,47 @@ sub _copypath_recurse
104108 # same name and we're done.
105109 if (-f $srcpath )
106110 {
107- copy($srcpath , $destpath )
111+ my $fh ;
112+ unless (open ($fh , ' <' , $srcpath ))
113+ {
114+ return 1 if ($! {ENOENT });
115+ die " open($srcpath ) failed: $! " ;
116+ }
117+ copy($fh , $destpath )
108118 or die " copy $srcpath -> $destpath failed: $! " ;
119+ close $fh ;
109120 return 1;
110121 }
111122
112- # Otherwise this is directory: create it on dest and recurse onto it.
113- mkdir ($destpath ) or die " mkdir($destpath ) failed: $! " ;
114-
115- opendir (my $directory , $srcpath ) or die " could not opendir($srcpath ): $! " ;
116- while (my $entry = readdir ($directory ))
123+ # If it's a directory, create it on dest and recurse into it.
124+ if (-d $srcpath )
117125 {
118- next if ($entry eq ' .' or $entry eq ' ..' );
119- _copypath_recurse($base_src_dir , $base_dest_dir ,
120- $curr_path eq ' ' ? $entry : " $curr_path /$entry " , $filterfn )
121- or die " copypath $srcpath /$entry -> $destpath /$entry failed" ;
126+ my $directory ;
127+ unless (opendir ($directory , $srcpath ))
128+ {
129+ return 1 if ($! {ENOENT });
130+ die " opendir($srcpath ) failed: $! " ;
131+ }
132+
133+ mkdir ($destpath ) or die " mkdir($destpath ) failed: $! " ;
134+
135+ while (my $entry = readdir ($directory ))
136+ {
137+ next if ($entry eq ' .' or $entry eq ' ..' );
138+ _copypath_recurse($base_src_dir , $base_dest_dir ,
139+ $curr_path eq ' ' ? $entry : " $curr_path /$entry " , $filterfn )
140+ or die " copypath $srcpath /$entry -> $destpath /$entry failed" ;
141+ }
142+
143+ closedir ($directory );
144+ return 1;
122145 }
123- closedir ($directory );
124146
125- return 1;
147+ # If it disappeared from sight, that's OK.
148+ return 1 if !-e $srcpath ;
149+
150+ # Else it's some weird file type; complain.
151+ die " Source path \" $srcpath \" is not a regular file or directory" ;
126152}
127153
1281541;
0 commit comments