Server IP : 85.214.239.14 / Your IP : 52.15.190.187 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/lib/postgresql/9.6/lib/pgxs/src/test/perl/ |
Upload File : |
=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 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<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 ($base_src_dir, $base_dest_dir, %params) = @_; my $filterfn; if (defined $params{filterfn}) { die "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. die "\"$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) die "Cannot operate on symlink \"$srcpath\"" if -l $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) { 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. die "Source path \"$srcpath\" is not a regular file or directory"; } 1;