I am running the current version of ActivePerl on Windows Vista, and I was wondering if you could show me the best and simplest way to copy a folder and it's contents to another location. Contents would include various files, and most likely some more nested folders.
I imagine there must be a module out there somewhere that I don't know about that does this - but if there is a simple homebrew type of solution I'd like to see that also.
Take a look at File::Copy::Recursive.
If you are simply copying and not doing any processing on the files, there is no reason not to use xcopy.
Now, I wrote the script below in light of Telemachus's comments to provide you with a starting point. I personally would stick with xcopy for copying and File::Find if file contents need to be processed. Besides, I am sure there are about 37 bugs in the code below. But, if you want to play around, it might be instructive:
#!/usr/bin/perl
use strict;
use warnings;
use File::Spec::Functions qw( catfile );
die "mydeepcp src-dir target-dir\n" unless #ARGV == 2;
my ($src, $target) = #ARGV;
mydeepcp( $src => $target );
sub mydeepcp {
my ($src, $target) = #_;
opendir my $dir_h, $src
or die "Cannot open directory: '$src': $!";
while ( my $file = readdir $dir_h ) {
next if $file =~ m{^\.\.?$};
my $src_path = catfile $src => $file;
my $target_path = catfile $target => $file;
if ( -d $src_path ) {
# FIXME: insert code somewhere to create destination dir
mydeepcp($src_path => $target_path);
}
elsif ( -f _ ) {
if ( my $err = docp($src_path => $target_path) ) {
warn sprintf(
"Error copying '%s' from '%s' to '%s': %s\n",
$file, $src, $target, $err
);
}
}
else {
warn "Skipping '$src_path'\n";
}
}
closedir $dir_h;
return;
}
sub docp {
my ($src, $target) = #_;
warn "'$src' => '$target'\n";
return;
}
__END__
Output:
C:\Temp> ghj c:\windows f:\qwert
...
'C:\windows\$hf_mig$\KB899591\update\spcustom.dll' => 'F:\qwert\$hf_mig$\KB899591\update\spcustom.dll'
'C:\windows\$hf_mig$\KB899591\update\update.exe' => 'F:\qwert\$hf_mig$\KB899591\update\update.exe'
'C:\windows\$hf_mig$\KB899591\update\update.ver' => 'F:\qwert\$hf_mig$\KB899591\update\update.ver'
Related
I want the last modified time for each file in the directory. To make sure my loop is working I print $_ and I see the file names of the directory:
for ( #Files ) {
opendir( D, $path . '\/' . $_ ) or die "$!";
my #textfiles = grep { ! /^\.{1,2}$/ } readdir( D );
for ( #textfiles ) {
# print "$_\n"; <----the file names.
my $epoch_timestamp = ( stat( $_ ) )[9];
print "$epoch_timestamp\n";
}
I get this error
Use of uninitialized value $epoch_timestamp in concatenation (.) or string
What am I doing wrong?
readdir returns only the names of the files. If your current working directory is different then you must build the full path as you did with the parameter to opendir. The easiest way is to use map in the list for the for loop
I'm concerned about your statement
opendir( D, $path . '\/' . $_ ) or die "$!";
which will put, literally, \/ between $path and $_. I think you need just /, but it is simplest to interpolate the variables with
opendir( D, "$path/$_" ) or die "$!";
But $_ comes from the array #Files. If these are indeed file names then your opendir will fail. They need to be directory names
In my solution I've built the variable $dir as
my $dir = "$path/$_"
so that it can be used in the call to opendir as well as to build the full path to the files in the following for loop
Note that I have also used a lexical directory handle my $dh, which are far superior to global handles D
for ( #Files ) {
my $dir = "$path/$_";
opendir my $dh, $dir or die $!;
my #textfiles = grep { ! /^\.{1,2}$/ } readdir $dh;
for ( map { "$dir/$_" } #textfiles ) {
# print "$_\n"; <----the file names.
my $epoch_timestamp = ( stat( $_ ) )[9];
print "$epoch_timestamp\n";
}
Or alternatively to above perfect answers, you could use some modules and make your life more easy. :) Like: Path::Tiny[1]
use 5.014;
use warnings;
use Path::Tiny;
my $path = path('/etc');
my #Files = qw(defaults cups ssl);
for my $dir (#Files) {
my #textfiles = $path->child($dir)->children;
for my $file (#textfiles) {
say "$file: ", $file->stat->mtime;
}
}
Of course, the above the nested loop could be written as
for my $dir (#Files) {
my #textfiles = $path->child($dir)->children;
say "$_: ", $_->stat->mtime for (#textfiles);
}
and also storing the list of files into #textfiles isn't necessary, so it could be reduced to:
for my $dir (#Files) {
say "$_: ", $_->stat->mtime for ( $path->child($dir)->children );
}
Path::Tiny conveniently throws a clean exception message on error.
readdir only returns the name of the file in the directory. You need to provide a qualified path to the file to stat.
my $dir_qfn = ...;
opendir(my $dh, $dir_qfn)
or do {
warn("Can't read dir \"$dir_qfn\": $!\n");
next;
};
while (defined( my $fn = readdir($dh) )) {
next if $fn =~ /^\.\.?\z/;
my $qfn = "$dir_qfn/$fn";
my $mtime = ( stat($qfn) )[9];
defined($mtime)
or do {
warn("Can't stat file \"$file_qfn\": $!\n");
next;
};
...
}
Using glob instead
my $dir = ...;
my %ts =
map { $_ => (stat $_)[9] }
grep { !m{/\.\.?\z} } #/
glob "\Q$dir\E/{*,.*}";
say "ts{$_} => $_" for sort keys %ts;
I use a hash name => timestamp to collect both in a data structure. The pattern $dir/{*,.*} is there to catch dot files as well, or it would be just $dir/*.
The grep filters out . and .. filenames, found in path by m{..} match. Its pattern needs \Q..\E to prevent an injection bug with particular directory names. It also escapes spaces so File::Glob with its :bsd_globoption isn't needed. Thanks to ikegami for comments.
If you'd rather process files one at a time, retrieve the list with glob and then iterate through it.
I've currently got this to grab all files under Assets/Editor
#files = bsd_glob( "Assets/Editor/postprocessbuildplayer_*", GLOB_NOCASE );
But I would like to access all files starting with postprocessbuildplayer_ starting from Assets as my root folder.
Example:
Assets/Temp/Editor/PostprocessBuildPlayer_DWARF
Assets/Directory_1/Editor/PostprocessBuildPlayer_1
Assets/Editor/PostprocessBuildPlayer_Default
The entire script should anyone know a better way:
#!/usr/bin/perl
# Post Process Build Player -- Master
# Searches for other PostprocessBuildPlayer scripts and executes them. Make sure the other script
# have a name suffix with an underscore "_" like "PostprocessBuildPlayer_AnotherBuild" or whatever.
#
# Based on script by Rob Terrell, rob#stinkbot.com
use File::Glob ':glob';
# Grab all the PostprocessBuildPlayer files
#files = bsd_glob( "Assets/Editor/postprocessbuildplayer_*", GLOB_NOCASE );
foreach $file( #files )
{
if( !( $file =~ m/\./ ) )
{
system( "chmod", "755", $file );
print "PostProcessBuildPlayer: calling " . $file . "\n";
system( $file, $ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3], $ARGV[4], $ARGV[5], $ARGV[6] );
if ( $? == -1 )
{
print "command failed: $!\n";
}
else
{
printf "command exited with value %d", $? >> 8;
}
}
}
Use File::Find to recurse a directory tree
use strict;
use warnings;
use File::Find;
my #files;
find(sub {
push #files, File::Find::name if /^PostprocessBuildPlayer/;
}, 'Assets/');
I want to rename directories recursively using File::Find::Rule, eg. remove extra spaces in each found but as I understand the module doesn't do finddepth and renames only one. Is there a way to do that. Thanks.
use autodie;
use strict ;
use warnings;
use File::Find::Rule;
my $dir = 'D:/Test';
my #fd = File::Find::Rule->directory
->in( $dir );
for my $fd ( #fd ) {
my $new = $fd;
$new =~ s/\s\s+/ /g;
print "$new\n";
rename $fd, $new;
}
You want to process the deeper results first, so process the list in reverse. You can only rename the leaf part of the path; you'll get to the more shallow parts later.
use Path::Class qw( dir );
for ( reverse #fd ) {
my $dir = dir($_);
my $parent = $dir->parent;
my $old_leaf = my $new_leaf = $dir->dir_list(-1);
$new_leaf =~ s/\s+/ /g;
if ($new_leaf ne $old_leaf) {
my $old_file = $parent->dir($old_leaf);
my $new_file = $parent->dir($new_leaf);
# Prevent accidental deletion of files.
if (-e $new_file) {
warn("$new_file already exists\n");
next;
}
rename($old_file, $new_file);
}
}
Answer to original question:
I don't see how FFR comes into play.
rename 'Test1/Test2/Test3', 'Test1/Test2/Dir3';
rename 'Test1/Test2', 'Test1/Dir2';
rename 'Test1', 'Dir1';
For arbitrary paths,
use Path::Class qw( dir );
my #parts1 = dir('Test1/Test2/Test3')->dir_list();
my #parts2 = dir('Dir1/Dir2/Dir3' )->dir_list();
die if #parts1 != #parts2;
for (reverse 0..$#parts1) {
my $path1 = dir(#parts1[ 0..$_ ]);
my $path2 = dir(#parts2[ 0..$_ ]);
rename($path1, $path2);
}
Or maybe you want to rename all Test1 to Dir1, Test2 to Dir2, and Test3 to Dir3, process the list in reverse order.
my %map = (
'Test1' => 'Dir1',
'Test2' => 'Dir2',
'Test3' => 'Dir3',
);
my $pat = join '|', map quotemeta, keys %map;
for ( reverse #fd ) {
my $o = $_;
my $n = $_;
$n =~ s{/\K($pat)\z}{$map{$1}};
if ($n ne $o) {
if (-e $n) {
warn("$n already exists\n");
next;
}
rename($o, $n);
}
}
I have a module for doing actions recursively in a directory tree. It didn't have the ability to act on the directories themselves though, so it took a little updating. I have uploaded version 0.03 of my File::chdir::WalkDir, but until it shows up, it can be installed from its GitHub repo, and now available using your fav CPAN utility. This script would then remove spaces from directory names inside the base directory 'Test' relative to the working directory:
#!/usr/bin/env perl
use strict;
use warnings;
use File::chdir::WalkDir 0.030;
use File::Copy;
my $job = sub {
my ($name, $in_dir) = #_;
#ONLY act on directories
return 0 unless (-d $name);
my $new_name = $name;
if ($new_name =~ s/\s+/ /g) {
move($name, $new_name);
}
};
walkdir( 'Test', $job, {'act_on_directories' => 1} );
What is an easy way to test if a folder is empty in perl? -s, and -z are not working.
Example:
#Ensure Apps directory exists on the test PC.
if ( ! -s $gAppsDir )
{
die "\n$gAppsDir is not accessible or does not exist.\n";
}
#Ensure Apps directory exists on the test PC.
if ( ! -z $gAppsDir )
{
die "\n$gAppsDir is not accessible or does not exist.\n";
}
These above, do not work properly to tell me that the folder is empty. Thanks!
Thanks all! I ended up using:
sub is_folder_empty { my $dirname = shift; opendir(my $dh, $dirname) or die "Not a directory";
return scalar(grep { $_ ne "." && $_ ne ".." } readdir($dh)) == 0; }
A little verbose for clarity, but:
sub is_folder_empty {
my $dirname = shift;
opendir(my $dh, $dirname) or die "Not a directory";
return scalar(grep { $_ ne "." && $_ ne ".." } readdir($dh)) == 0;
}
Then you can do:
if (is_folder_empty($your_dir)) {
....
}
Using grep { ! /^[.][.]?\z/ } readdir $dir_h can be problematic for performance in case the check is done many times and some directories may have many files.
It would be better to short-circuit the moment a directory entry other than . or .. is found.
On Windows XP with ActiveState perl 5.10.1, the following sub seems to be twice as fast as the grep approach on my $HOME with 100 entries:
sub is_dir_empty {
my ($dir) = #_;
opendir my $h, $dir
or die "Cannot open directory: '$dir': $!";
while ( defined (my $entry = readdir $h) ) {
return unless $entry =~ /^[.][.]?\z/;
}
return 1;
}
Or without any grepping or regular expressions - which rules out any chance of weird file names accidentally getting though. Plus slightly faster is my testing.
#!/usr/bin/perl
use strict;
use warnings;
sub is_dir_empty {
return -1 if not -e $_[0]; # does not exist
return -2 if not -d $_[0]; # in not a directory
opendir my $dir, $_[0] or # likely a permissions issue
die "Can't opendir '".$_[0]."', because: $!\n";
readdir $dir;
readdir $dir;
return 0 if( readdir $dir ); # 3rd times a charm
return 1;
}
my #folders = qw( ./ ./empty ./hasonefile ./hastwofiles ./doesnotexist ./afile );
for my $folder ( #folders ) {
print "Folder '$folder' ";
my $rc = is_dir_empty( $folder );
if( $rc == -1 ) {
print "does not exist\n";
} elsif( $rc == -2 ) {
print "is not a directory\n";
} elsif( !$rc ) {
print "is not empty\n";
} else {
print "is empty\n";
}
}
Pretty simple. If you get three valid responses from a call to readdir, then you know there must be a file in there. Regardless of what name the file may have - or the order in which the files are being processed. Would have preferred something called 'is_dir_used' as I personally don't like the double-negative function name and return value.
There is also File::List from cpan. It's overkill here, but can be handy for slightly more complex requests like test if a directory is empty with the meaning it contains only empty directories (ie: not files).
Here is a more consise algorithm using Perl v5.12 (from circa 2010).
At most, three reads of the directory are made.
It does NOT read the whole directory.
It handles non-Unix filesystems that do not have '..'; See 'find' '-noleaf'
Desc: return true if empty, false if not empty; die if opendir() error
sub is_dir_empty {
use 5.012; # so readdir assigns to $_ in a lone while test
local($_); # prevent side effects
my $dir = shift // die "arg missing";
opendir my $dh, $dir or die "opendir(..,$dir): $!";
while ( readdir $dh ) {
return 0 if ! /^ [.][.]? $/x;
}
return 1;
} # is_dir_empty()
Credit to DevShed
if (scalar <directory/*>) {print qq|File Exists\n|}
Edit
To include hidden files:
#arr = <directory/* directory/.*>;
#arr = grep {!/^directory/[.]{1,2}$/} #arr;
if (#arr) { print qq|File or Directory Exists\n| }
Please read the comments as there have been good points made. Despite the negative points this answer has received, it is still correct.
opendir(DIR,"DIR PATH") or die "Unable to open directory \"DIR PATH\" \n";
my #drList = readdir(DIR);
close(DIR);
if( grep(/\w/,#drList) ){ print "Not Empty\n" }
else { print "Empty\n" }
sub is_folder_empty {
my $dirname = shift;
my #files = File::Find::Rule->file()->name('*')->maxdepth(1)->in("$dirname");
return $#files < 0;
}
How do I get Perl to read the contents of a given directory into an array?
Backticks can do it, but is there some method using 'scandir' or a similar term?
opendir(D, "/path/to/directory") || die "Can't open directory: $!\n";
while (my $f = readdir(D)) {
print "\$f = $f\n";
}
closedir(D);
EDIT: Oh, sorry, missed the "into an array" part:
my $d = shift;
opendir(D, "$d") || die "Can't open directory $d: $!\n";
my #list = readdir(D);
closedir(D);
foreach my $f (#list) {
print "\$f = $f\n";
}
EDIT2: Most of the other answers are valid, but I wanted to comment on this answer specifically, in which this solution is offered:
opendir(DIR, $somedir) || die "Can't open directory $somedir: $!";
#dots = grep { (!/^\./) && -f "$somedir/$_" } readdir(DIR);
closedir DIR;
First, to document what it's doing since the poster didn't: it's passing the returned list from readdir() through a grep() that only returns those values that are files (as opposed to directories, devices, named pipes, etc.) and that do not begin with a dot (which makes the list name #dots misleading, but that's due to the change he made when copying it over from the readdir() documentation). Since it limits the contents of the directory it returns, I don't think it's technically a correct answer to this question, but it illustrates a common idiom used to filter filenames in Perl, and I thought it would be valuable to document. Another example seen a lot is:
#list = grep !/^\.\.?$/, readdir(D);
This snippet reads all contents from the directory handle D except '.' and '..', since those are very rarely desired to be used in the listing.
A quick and dirty solution is to use glob
#files = glob ('/path/to/dir/*');
This will do it, in one line (note the '*' wildcard at the end)
#files = </path/to/directory/*>;
# To demonstrate:
print join(", ", #files);
IO::Dir is nice and provides a tied hash interface as well.
From the perldoc:
use IO::Dir;
$d = IO::Dir->new(".");
if (defined $d) {
while (defined($_ = $d->read)) { something($_); }
$d->rewind;
while (defined($_ = $d->read)) { something_else($_); }
undef $d;
}
tie %dir, 'IO::Dir', ".";
foreach (keys %dir) {
print $_, " " , $dir{$_}->size,"\n";
}
So you could do something like:
tie %dir, 'IO::Dir', $directory_name;
my #dirs = keys %dir;
You could use DirHandle:
use DirHandle;
$d = new DirHandle ".";
if (defined $d)
{
while (defined($_ = $d->read)) { something($_); }
$d->rewind;
while (defined($_ = $d->read)) { something_else($_); }
undef $d;
}
DirHandle provides an alternative, cleaner interface to the opendir(), closedir(), readdir(), and rewinddir() functions.
Similar to the above, but I think the best version is (slightly modified) from "perldoc -f readdir":
opendir(DIR, $somedir) || die "can't opendir $somedir: $!";
#dots = grep { (!/^\./) && -f "$somedir/$_" } readdir(DIR);
closedir DIR;
You can also use the children method from the popular Path::Tiny module:
use Path::Tiny;
my #files = path("/path/to/dir")->children;
This creates an array of Path::Tiny objects, which are often more useful than just filenames if you want to do things to the files, but if you want just the names:
my #files = map { $_->stringify } path("/path/to/dir")->children;
Here's an example of recursing through a directory structure and copying files from a backup script I wrote.
sub copy_directory {
my ($source, $dest) = #_;
my $start = time;
# get the contents of the directory.
opendir(D, $source);
my #f = readdir(D);
closedir(D);
# recurse through the directory structure and copy files.
foreach my $file (#f) {
# Setup the full path to the source and dest files.
my $filename = $source . "\\" . $file;
my $destfile = $dest . "\\" . $file;
# get the file info for the 2 files.
my $sourceInfo = stat( $filename );
my $destInfo = stat( $destfile );
# make sure the destinatin directory exists.
mkdir( $dest, 0777 );
if ($file eq '.' || $file eq '..') {
} elsif (-d $filename) { # if it's a directory then recurse into it.
#print "entering $filename\n";
copy_directory($filename, $destfile);
} else {
# Only backup the file if it has been created/modified since the last backup
if( (not -e $destfile) || ($sourceInfo->mtime > $destInfo->mtime ) ) {
#print $filename . " -> " . $destfile . "\n";
copy( $filename, $destfile ) or print "Error copying $filename: $!\n";
}
}
}
print "$source copied in " . (time - $start) . " seconds.\n";
}
from: http://perlmeme.org/faqs/file_io/directory_listing.html
#!/usr/bin/perl
use strict;
use warnings;
my $directory = '/tmp';
opendir (DIR, $directory) or die $!;
while (my $file = readdir(DIR)) {
next if ($file =~ m/^\./);
print "$file\n";
}
The following example (based on a code sample from perldoc -f readdir) gets all the files (not directories) beginning with a period from the open directory. The filenames are found in the array #dots.
#!/usr/bin/perl
use strict;
use warnings;
my $dir = '/tmp';
opendir(DIR, $dir) or die $!;
my #dots
= grep {
/^\./ # Begins with a period
&& -f "$dir/$_" # and is a file
} readdir(DIR);
# Loop through the array printing out the filenames
foreach my $file (#dots) {
print "$file\n";
}
closedir(DIR);
exit 0;
closedir(DIR);
exit 0;