@@ -29,12 +29,17 @@ use File::Copy;
29
29
=head2 copypath($from, $to, %params)
30
30
31
31
Recursively copy all files and directories from $from to $to.
32
+ Does not preserve file metadata (e.g., permissions).
32
33
33
34
Only regular files and subdirectories are copied. Trying to copy other types
34
35
of directory entries raises an exception.
35
36
36
37
Raises 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.
38
43
39
44
If the B<filterfn > parameter is given, it must be a subroutine reference.
40
45
This subroutine will be called for each entry in the source directory with its
@@ -74,6 +79,9 @@ sub copypath
74
79
$filterfn = sub { return 1; };
75
80
}
76
81
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
+
77
85
# Start recursive copy from current directory
78
86
return _copypath_recurse($base_src_dir , $base_dest_dir , " " , $filterfn );
79
87
}
@@ -89,12 +97,8 @@ sub _copypath_recurse
89
97
return 1 unless &$filterfn ($curr_path );
90
98
91
99
# 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 ;
98
102
99
103
# Abort if destination path already exists. Should we allow directories
100
104
# to exist already?
@@ -104,25 +108,47 @@ sub _copypath_recurse
104
108
# same name and we're done.
105
109
if (-f $srcpath )
106
110
{
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 )
108
118
or die " copy $srcpath -> $destpath failed: $! " ;
119
+ close $fh ;
109
120
return 1;
110
121
}
111
122
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 )
117
125
{
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;
122
145
}
123
- closedir ($directory );
124
146
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" ;
126
152
}
127
153
128
154
1;
0 commit comments