Tolgar
asked on
How to do a smart copy of the files between directories in Perl?
Hi,
I would like to write a Perl code that will do a kind of smart copy between directories.
Can you please help me to write this code in Perl?
The directory structure is like this:
What I want to do is to copy the files in the bin directories of productA, productB and productC to the bin directory in the e directory.
The same way, I want to copy the files in the lib directories of productA, productB and productC to the lib directory in the e directory.
Before actually copying the files, the code should check if there are any files that conflicts (name conflict) between all the products (This example has 3 products A, B and C but it can be more than three. Also, anything other than bin or lib in e directory means it is a product. Bin adn Lib directories in the e directory are the destination directories). then the code should prompt to the user and ask if he wants to copy. If the user says yes, then it should start copying otherwise it should not do anything. The code should prompt to the user whether there is a conflict or not.
The sudo code is like this:
Example 1 with a conflicting file name:
The code should be able to detect that there is a name conflict in the "lib" directories of productA and productB. and it should tell the user that "/a/b/c/d/e/productB/lib/f
If the user says no then it should not copy anything.
Example 2 wit no conflicting file name:
Even though there is no conflict in the file names between the products, the user will be prompted and if he says yes then it will copy the files otherwise it will not do anything.
Thanks,
I would like to write a Perl code that will do a kind of smart copy between directories.
Can you please help me to write this code in Perl?
The directory structure is like this:
/a/b/c/d/e/productA/bin
/a/b/c/d/e/productA/lib
/a/b/c/d/e/productB/bin
/a/b/c/d/e/productB/lib
/a/b/c/d/e/productC/bin
/a/b/c/d/e/productC/lib
/a/b/c/d/e/bin
/a/b/c/d/e/libWhat I want to do is to copy the files in the bin directories of productA, productB and productC to the bin directory in the e directory.
The same way, I want to copy the files in the lib directories of productA, productB and productC to the lib directory in the e directory.
Before actually copying the files, the code should check if there are any files that conflicts (name conflict) between all the products (This example has 3 products A, B and C but it can be more than three. Also, anything other than bin or lib in e directory means it is a product. Bin adn Lib directories in the e directory are the destination directories). then the code should prompt to the user and ask if he wants to copy. If the user says yes, then it should start copying otherwise it should not do anything. The code should prompt to the user whether there is a conflict or not.
The sudo code is like this:
Ask the input directory from the user (with getoptions)
Loop through all the files in all the child directories of the given directory and push them in to an array.
Loop through all the files in all the child directories of the directories that are in the same level as the input directory and push them to an array. (Let's say if the input is [b]/a/b/c/d/e/productA[/b] then loop through the productb and productC directories. Do not loop through bin and lib in e directory because it is not a product. It is a destination.)
Check if there are any name conflicts between the two arrays.
Tell the user if there are any conflicts and print this information on the screen and ask if he wants to continue. (even if there is no conflict I would like to prompt to the user to say yes or not)
If the user says "no" then do not start copying and exit.
If the user says "yes" then start copying files from the bin directory of the input directory to the bin directory in the "e" directory. And do the same copy for the "lib" directory.
The code should overwrite to the files in the destination directory. Example 1 with a conflicting file name:
/a/b/c/d/e/productA/bin/runtool.pl
/a/b/c/d/e/productA/lib/findFiles.pl
/a/b/c/d/e/productA/lib/findPeople.pl
/a/b/c/d/e/productB/bin/runGui.pl
/a/b/c/d/e/productB/lib/findFiles.pl
/a/b/c/d/e/productB/lib/findApples.pl
/a/b/c/d/e/productC/bin/runSky.pl
/a/b/c/d/e/productC/lib/doThis.pl
/a/b/c/d/e/bin/runtool.pl
/a/b/c/d/e/bin/runGui.pl
/a/b/c/d/e/bin/runSky.pl
/a/b/c/d/e/lib/findFiles.pl
/a/b/c/d/e/lib/findPeople.pl
/a/b/c/d/e/lib/findApples.pl
/a/b/c/d/e/lib/doThis.plThe code should be able to detect that there is a name conflict in the "lib" directories of productA and productB. and it should tell the user that "/a/b/c/d/e/productB/lib/f
If the user says no then it should not copy anything.
Example 2 wit no conflicting file name:
/a/b/c/d/e/productA/bin/runtool.pl
/a/b/c/d/e/productA/lib/findFiles.pl
/a/b/c/d/e/productA/lib/findPeople.pl
/a/b/c/d/e/productB/bin/runGui.pl
/a/b/c/d/e/productB/lib/findDirectories.pl
/a/b/c/d/e/productB/lib/findApples.pl
/a/b/c/d/e/productC/bin/runSky.pl
/a/b/c/d/e/productC/lib/doThis.pl
/a/b/c/d/e/bin/runtool.pl
/a/b/c/d/e/bin/runGui.pl
/a/b/c/d/e/bin/runSky.pl
/a/b/c/d/e/lib/findFiles.pl
/a/b/c/d/e/lib/findPeople.pl
/a/b/c/d/e/lib/findApples.pl
/a/b/c/d/e/lib/doThis.plEven though there is no conflict in the file names between the products, the user will be prompted and if he says yes then it will copy the files otherwise it will not do anything.
Thanks,
wilcoxon
If there is a conflict and the user says "yes" to continue, which file would you expect to end up in /a/b/c/d/e/bin (or lib)? A "random" one of the conflict files or a specific one? If specific, which one (and how can it be determined programmatically since you don't say to ask the user)?
ASKER
Good point. If there is conflict, it should give the user three options.
Choose the file you want to copy:
1 -> Accept the following file:
/a/b/c/d/e/productA/lib/findFiles.pl
2 -> Accept the following file:
/a/b/c/d/e/productB/lib/findFiles.pl
3 -> Quit
Should the script handle sub-directories in bin and lib or is it always a flat directory structure? In other words, will there ever be /a/b/c/d/e/productA/bin/th
ASKER
Again a good point.
In the lib directory there will be sub directories. In the bin directory, it is very unlikely but there may be.
So, if there are any sub-directories the sub-directories should be copied as a directory into the lib or the bin directory. And the name conflict should be checked for the sub-directory names only rather than the files they contain, because if the sub-directory names do not conflict, then the files in different sub directories can have same names.
And, if there is a conflict, then the user should be prompted to choose from the given options.
In the lib directory there will be sub directories. In the bin directory, it is very unlikely but there may be.
So, if there are any sub-directories the sub-directories should be copied as a directory into the lib or the bin directory. And the name conflict should be checked for the sub-directory names only rather than the files they contain, because if the sub-directory names do not conflict, then the files in different sub directories can have same names.
And, if there is a conflict, then the user should be prompted to choose from the given options.
This ended up more complex than I expected but it works...
use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(make_path);
use Term::Prompt;
my $dir = shift or die "Usage: $0 base_dir\n";
chdir $dir or die "could not cd to $dir: $!";
opendir DIR, '.' or die "could not open $dir: $!";
my @dirs = grep { -d $_ and $_ !~ m{^(?:bin|lib|\.+)$}o } readdir DIR;
closedir DIR;
my ($base, %files, %multi);
foreach my $dir (sort @dirs) {
$base = $dir;
File::Find::find({wanted => \&search}, $base);
}
if (%multi) {
foreach my $file (sort keys %multi) {
my $val = prompt('m', { prompt => 'which file?', title => 'conflict',
items => [ 'quit', map { "$_/$file" } @{$files{$file}} ],
cols => 1, display_base => 0 }, '', undef);
exit unless $val;
$files{$file} = [$files{$file}[$val-1]];
}
} else {
my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
items => ['quit', 'no conflicts - continue'], cols => 1,
display_base => 0 }, '', undef);
exit unless $val;
}
foreach my $file (keys %files) {
die "woa!! found conflict for $file after resolutions\n"
unless (@{$files{$file}} == 1);
# print "cp $files{$file}[0]/$file\n";
my $dir = $file;
$dir =~ s{/[^/]+$}{};
make_path($dir) unless (-d $dir);
cp "$files{$file}[0]/$file", $file
or die "could not copy $files{$file}[0]/$file: $!";
}
sub search {
return unless -f $_;
my $name = $File::Find::name;
$name =~ s{^$base/}{};
if (exists $files{$name}) {
$multi{$name}++;
push @{$files{$name}}, $base;
} else {
push @{$files{$name}}, $base;
}
}ASKER
@wilcoxon: I am getting the following error:
Is there any other way of doing it instead of make_path?
NOTE: I don't have control on the Perl we use in here. And I don't have permission to add any modules.
Thanks,
"make_path" is not exported by the File::Path moduleIs there any other way of doing it instead of make_path?
NOTE: I don't have control on the Perl we use in here. And I don't have permission to add any modules.
Thanks,
It sounds like you have the module but it may be an older version. Try changing:
use File::Path qw(make_path) --> use File::Path qw(mkpath)
make_path(...) --> mkpath(...)
Hopefully you have Term::Prompt installed then. If not, do you have IO::Prompt installed (IO::Prompt seems better than Term::Prompt but is not as portable (does not work on Windows at least))?
ASKER
@wilcoxon: I made the change and now I am getting this error:
Can't locate Term/Prompt.pm in @INC (@INC contains: ..... ....) at add2Path.pl line 7.
BEGIN failed--compilation aborted at add2Path.pl line 7.
Can you try doing:
Can you ask the sysadmin to install a module? Both Term::Prompt and IO::Prompt have minimal non-core dependencies (and what they do depend on (except Want in IO::Prompt) are very common modules).
perl -e 'use IO::Prompt'Can you ask the sysadmin to install a module? Both Term::Prompt and IO::Prompt have minimal non-core dependencies (and what they do depend on (except Want in IO::Prompt) are very common modules).
ASKER
I will try perl -e command tomorrow but I am pretty sure that sysadmin will not install any module for me. Even if they agree to do it, it will take months for them to actually do it.
Is there any other way of doing it? Or can we rewrite the same code in a shell script? It may be easier to do prompt in shell but I am not sure if it is easy to do the rest in a shell script.
What do you think?
By the way, this code does not ask any input from the user in the beginning to decide for the source directory (product) to be copied to the destination.
Is that right?
Is there any other way of doing it? Or can we rewrite the same code in a shell script? It may be easier to do prompt in shell but I am not sure if it is easy to do the rest in a shell script.
What do you think?
By the way, this code does not ask any input from the user in the beginning to decide for the source directory (product) to be copied to the destination.
Is that right?
Since it's a single directory source, it seemed easier to specify that on the command line (eg script.pl directory). It could be modified to ask.
ASKER
I see.
So, how can we solve the prompt issue without having the module?
Thanks,
So, how can we solve the prompt issue without having the module?
Thanks,
Let's wait and see if you do have IO::Prompt (eg if you get an error from the perl -e command). If you do, it's pretty simple to change the Term::Prompt syntax. If you don't then it's more complicated (possibly just include the source for Term::Prompt in the code).
ASKER
@wilcoxon: The command you wanted me to run returned the following:
% perl -e 'use IO::Prompt'
Can't locate IO/Prompt.pm in @INC (@INC contains: ........................ some paths in here................................... at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
Apparently, you don't have Term::Prompt or IO::Prompt.
Can you install modules as part of your code (likely into a different directory than where Perl does) or do the sysadmins insist everything be contained in a single file? It's common practice to write modules as part of Perl programs so we may be able to go that route.
Can you install modules as part of your code (likely into a different directory than where Perl does) or do the sysadmins insist everything be contained in a single file? It's common practice to write modules as part of Perl programs so we may be able to go that route.
ASKER
They would prefer it to be in a single file. Can we do like that?
Yes though it's not quite as simple so it may be Friday before I have something.
ASKER
ok. Friday would be great.
Thanks,
Thanks,
ASKER
@wilcoxon: any news?
Sorry. It's just Friday morning here. I'll post something today.
Here you go...
use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath);
## taken from Term::Prompt
use Carp;
use Text::Wrap;
use Term::ReadKey qw (GetTerminalSize
ReadMode);
our $DEBUG = 0;
our $MULTILINE_INDENT = "\t";
my %menu = (
order => 'down',
return_base => 0,
display_base => 1,
accept_multiple_selections => 0,
accept_empty_selection => 0,
title => '',
prompt => '>',
separator => '[^0-9]+',
ignore_whitespace => 0,
ignore_empties => 0
);
sub prompt ($$$$;@);
# End Term::Prompt
my $dir = shift or die "Usage: $0 base_dir\n";
chdir $dir or die "could not cd to $dir: $!";
opendir DIR, '.' or die "could not open $dir: $!";
my @dirs = grep { -d $_ and $_ !~ m{^(?:bin|lib|\.+)$}o } readdir DIR;
closedir DIR;
my ($base, %files, %multi);
foreach my $dir (sort @dirs) {
$base = $dir;
File::Find::find({wanted => \&search}, $base);
}
if (%multi) {
foreach my $file (sort keys %multi) {
my $val = prompt('m', { prompt => 'which file?', title => 'conflict',
items => [ 'quit', map { "$_/$file" } @{$files{$file}} ],
cols => 1, display_base => 0 }, '', undef);
exit unless $val;
$files{$file} = [$files{$file}[$val-1]];
}
} else {
my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
items => ['quit', 'no conflicts - continue'], cols => 1,
display_base => 0 }, '', undef);
exit unless $val;
}
foreach my $file (keys %files) {
die "woa!! found conflict for $file after resolutions\n"
unless (@{$files{$file}} == 1);
# print "cp $files{$file}[0]/$file\n";
my $dir = $file;
$dir =~ s{/[^/]+$}{};
mkpath($dir) unless (-d $dir);
cp "$files{$file}[0]/$file", $file
or die "could not copy $files{$file}[0]/$file: $!";
}
sub search {
return unless -f $_;
my $name = $File::Find::name;
$name =~ s{^$base/}{};
if (exists $files{$name}) {
$multi{$name}++;
push @{$files{$name}}, $base;
} else {
push @{$files{$name}}, $base;
}
}
# BEGIN main part of Term::Prompt
# Preloaded methods go here.
sub prompt ($$$$;@) {
my($mopt, $prompt, $prompt_options, $default, @things) =
('','','',undef,());
my($repl, $match_options, $case, $low, $high, $before, $regexp, $coderef) =
('','','','','','','','');
my $prompt_full = '';
# Figure out just what we are doing here
$mopt = $_[0];
print "mopt is: $mopt\n" if $DEBUG;
# check the size of the match option, it should just have one char.
if (length($mopt) == 1
or $mopt =~ /\-n/i
or $mopt =~ /\+-n/i) {
my $dummy = 'mopt is ok';
} else {
croak "Illegal call of prompt; $mopt is more than one character; stopped";
}
my $type = 0;
my $menu = 0;
my $legal = 0;
my $range = 0;
my $expr = 0;
my $code = 0;
my $yn = 0;
my $uc = 0;
my $passwd = 0;
if ($mopt ne lc($mopt)) {
$uc = 1;
$mopt = lc($mopt);
}
if ($mopt eq 'm') {
($mopt, $prompt, $prompt_options, $default) = @_;
$menu = 1;
} else {
croak "prompt type $mopt not recognized";
}
my $ok = 0;
$mopt = lc($mopt);
while (1) {
if ($menu) {
## We're working on a menu
@menu{sort keys %{$prompt}} = @{$prompt}{sort keys %{$prompt}};
$prompt_full = "$menu{'prompt'} ";
my @menu_items = @{$menu{'items'}};
my $number_menu_items = scalar(@menu_items);
$menu{'low'} = $menu{'display_base'};
$menu{'high'} = $number_menu_items+$menu{'display_base'}-1;
my $digits_in_menu_item = (int(log($menu{'high'})/log(10)) + 1);
my $entry_length = 0;
my $item_length = 0;
for (@menu_items) {
$entry_length = length($_)
if length($_) > $entry_length;
}
$item_length = $entry_length;
$entry_length += ( $digits_in_menu_item ## Max number of digits in a selection
+
3 ## two for ') ', at least one for a column separator
);
my $gw = get_width();
my $num_cols = (defined($menu{'cols'})
? $menu{'cols'}
: int($gw/$entry_length));
$num_cols ||= 1; # Could be zero if longest entry in a
# list is wider than the screen
my $num_rows = (defined($menu{'rows'})
? $menu{'rows'}
: int($number_menu_items/$num_cols)+1) ;
my $data_fmt = "%${digits_in_menu_item}d) %-${item_length}.${item_length}s";
my $column_end_fmt = ("%s ");
my $line_end_fmt = ("%s\n");
my @menu_out = ();
my $row = 0;
my $col = 0;
my $idx = 0;
if ($menu{order} =~ /ACROSS/i) {
ACROSS_LOOP:
for ($row = 0; $row < $num_rows; $row++) {
for ($col = 0; $col < $num_cols; $col++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last ACROSS_LOOP
if $idx eq scalar(@menu_items);
}
}
} else {
DOWN_LOOP:
for ($col = 0; $col < $num_cols; $col++) {
for ($row = 0; $row < $num_rows; $row++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last DOWN_LOOP
if $idx eq scalar(@menu_items);
}
}
}
if (length($menu{'title'})) {
print $menu{'title'},"\n",'-' x length($menu{'title'}),"\n";
}
for ($row = 0;$row < $num_rows;$row++) {
for ($col = 0;$col < $num_cols-1;$col++) {
printf($column_end_fmt,$menu_out[$row][$col])
if defined($menu_out[$row][$col]);
}
if (defined($menu_out[$row][$num_cols-1])) {
printf($line_end_fmt,$menu_out[$row][$num_cols-1])
} else {
print "\n";
}
}
if ($number_menu_items != ($num_rows)*($num_cols)) {
print "\n";
}
unless (defined($prompt_options) && length($prompt_options)) {
$prompt_options = "$menu{'low'} - $menu{'high'}";
if ($menu{'accept_multiple_selections'}) {
$prompt_options .= ', separate multiple entries with spaces';
}
}
}
unless ($before || $uc || ($prompt_options eq '')) {
$prompt_full .= "($prompt_options) ";
}
if (defined($default) and $default ne '') {
$prompt_full .= "[default $default] ";
}
print termwrap($prompt_full);
my $old_divide = undef;
if (defined($/)) {
$old_divide = $/;
}
$/ = "\n";
ReadMode('noecho') if($passwd);
$repl = scalar(readline(*STDIN));
ReadMode('restore') if($passwd);
if (defined($old_divide)) {
$/ = $old_divide;
} else {
undef($/);
}
chomp($repl); # nuke the <CR>
$repl =~ s/^\s*//; # ignore leading white space
$repl =~ s/\s*$//; # ignore trailing white space
$repl = $default if $repl eq '';
print termwrap("Reply: '$repl'\n") if $DEBUG;
# Now here is where things get real interesting
my @menu_repl = ();
if ($menu) {
$ok = menuit(\@menu_repl, $repl, $DEBUG, $uc);
} else {
croak "No subroutine known for prompt type $mopt.";
}
if ($ok) {
if ($menu) {
if ($menu{'accept_multiple_selections'}) {
return (wantarray ? @menu_repl : \@menu_repl);
} else {
return $menu_repl[0];
}
}
} elsif (defined($prompt_options) && length($prompt_options)) {
if ($uc) {
print termwrap("$prompt_options\n");
} else {
if (!$menu) {
print termwrap("Options are: $prompt_options\n");
}
$before = 1;
}
}
}
}
sub rangeit ($$$$ ) {
# this routine makes sure that the reply is within a given range
my($repl, $low, $high, $uc) = @_;
if ( $low <= $repl && $repl <= $high ) {
return 1;
} elsif (!$uc) {
print 'Invalid range value. ';
}
return 0;
}
sub menuit (\@$$$ ) {
my ($ra_repl, $repl, $dbg, $uc) = @_;
print "inside of menuit\n" if $dbg;
my @msgs = ();
## Parse for multiple values. Strip all whitespace if requested or
## just strip leading and trailing whitespace to avoid a being
## interpreted as separating empty choices.
if($menu{'ignore_whitespace'}) {
$repl =~ s/\s+//g;
} else {
$repl =~ s/^(?:\s+)//;
$repl =~ s/(?:\s+)$//;
}
my @repls = split(/$menu{'separator'}/,$repl);
if($menu{ignore_empties}) {
@repls = grep{length($_)} @repls;
}
## Validations
if ( scalar(@repls) > 1
&&
!$menu{'accept_multiple_selections'} ) {
push @msgs, 'Multiple choices not allowed.';
} elsif (!scalar(@repls)
&&
!$menu{'accept_empty_selection'}) {
push @msgs, 'You must make a selection.';
} else {
for (@repls) {
if ( !rangeit($_,$menu{'low'},$menu{'high'},1)) {
push @msgs, "$_ is an invalid choice.";
}
}
}
## Print errors or return values
if (scalar(@msgs)) {
print "\n",join("\n",@msgs),"\n\n";
return 0;
} else {
@{$ra_repl} = map {$_ - $menu{'display_base'} + $menu{'return_base'}} @repls;
return 1;
}
}
sub termwrap ($;@) {
my($message) = '';
if ($#_ > 0) {
if (defined($,)) {
$message = join($,,@_);
} else {
$message = join(' ',@_);
}
} else {
$message = $_[0];
}
my $width = get_width();
if (defined($width) && $width) {
$Text::Wrap::Columns = $width;
}
if ($message =~ m/\n\Z/) {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z/\n/;
return $message;
} else {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z//;
return $message;
}
}
sub get_width {
## The 'use strict' added above caused the calls
## GetTerminalSize(STDOUT) and GetTerminalSize(STDERR) to fail in
## compilation. The fix as to REMOVE the parens. It seems as if
## this call works the same way as 'print' - if you need to
## specify the filehandle, you don't use parens (and don't put a
## comma after the filehandle, although that is irrelevant here.)
## SO DON'T PUT THEM BACK! :-)
my($width) = eval {
local($SIG{__DIE__});
(GetTerminalSize(select))[0];
} || eval {
if (-T STDOUT) {
local($SIG{__DIE__});
return (GetTerminalSize STDOUT )[0];
} else {
return 0;
}
} || eval {
if (-T STDERR) {
local($SIG{__DIE__});
return (GetTerminalSize STDERR )[0];
} else {
return 0;
}
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDOUT )[0];
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDERR )[0];
};
return $width;
}ASKER
@wilcoxon: I tried to run the code and I saw an unexpected behavior. The code is supposed to copy the directories and files from one directory into another without changing the directory structure. In my experience with the code, it does copy the directories with the files inside them individually into the new directory.
The example that I posted in my initial post was like this:
Now I add some sub directories into this example:
When I tried to run the code, it copied the files and directories into the source directory instead of the target directory.
Can you please double check if something is wrong in the code?
Thanks,
The example that I posted in my initial post was like this:
/a/b/c/d/e/productA/bin/runtool.pl
/a/b/c/d/e/productA/lib/findFiles.pl
/a/b/c/d/e/productA/lib/findPeople.pl
/a/b/c/d/e/productB/bin/runGui.pl
/a/b/c/d/e/productB/lib/findDirectories.pl
/a/b/c/d/e/productB/lib/findApples.pl
/a/b/c/d/e/productC/bin/runSky.pl
/a/b/c/d/e/productC/lib/doThis.pl
/a/b/c/d/e/bin/runtool.pl
/a/b/c/d/e/bin/runGui.pl
/a/b/c/d/e/bin/runSky.pl
/a/b/c/d/e/lib/findFiles.pl
/a/b/c/d/e/lib/findPeople.pl
/a/b/c/d/e/lib/findApples.pl
/a/b/c/d/e/lib/doThis.plNow I add some sub directories into this example:
/a/b/c/d/e/productA/bin/runtool.pl
/a/b/c/d/e/productA/lib/findFiles.pl
/a/b/c/d/e/productA/lib/findPeople.pl
/a/b/c/d/e/productB/bin/runGui.pl
/a/b/c/d/e/productB/lib/findDirectories.pl
/a/b/c/d/e/productB/lib/findApples.pl
/a/b/c/d/e/productB/lib/standard/file1.pl
/a/b/c/d/e/productB/lib/standard/file1.pl
/a/b/c/d/e/productC/bin/runSky.pl
/a/b/c/d/e/productC/lib/doThis.pl
/a/b/c/d/e/bin/runtool.pl
/a/b/c/d/e/bin/runGui.pl
/a/b/c/d/e/bin/runSky.pl
/a/b/c/d/e/lib/findFiles.pl
/a/b/c/d/e/lib/findPeople.pl
/a/b/c/d/e/lib/findApples.pl
/a/b/c/d/e/lib/doThis.pl
/a/b/c/d/e/lib/standard/file1.pl
/a/b/c/d/e/lib/standard/file1.plWhen I tried to run the code, it copied the files and directories into the source directory instead of the target directory.
Can you please double check if something is wrong in the code?
Thanks,
I'm not following. Given your revised /a/b/c/d/e/product[ABC] structure, what behavior are you seeing? When I test (with subdirectories), it copies the files from the product directories into the base //bin and //lib dirs. Can you please be more specific - what is the exact file structure before running and how does the behavior differ from what you expect?
ASKER
@Wilcoxon: So, I tried it again and the behavior is like this:
I put the script in a folder called add2PathTest. and I have the following file and the three folders in it:
The content of the add2PathTest folder. (bin, lib and rel1.3 are folders.)
I cd to add2PathTest folder and I ran the following command:
After I ran this command, this is what I have:
Please see the directory structure in the attachment before and after the copy process:
beforeCopy.png
AfterCopy.png
I put the script in a folder called add2PathTest. and I have the following file and the three folders in it:
The content of the add2PathTest folder. (bin, lib and rel1.3 are folders.)
bin
lib
rel1.3
release2production.plI cd to add2PathTest folder and I ran the following command:
release2production.pl rel1.3After I ran this command, this is what I have:
bin and lib folders are empty. Nothing was copied into these directories.
rel1.3 folder was the source folder where I wanted to copy files and folders from. However, the copy process was done into this folder from within the folders inside it.
Please see the directory structure in the attachment before and after the copy process:
beforeCopy.png
AfterCopy.png
ASKER
Any ideas?
That's what I would expect. If you are already in add2PathTest dir then you should run
release2production.pl .release2production.pl /path/to/add2PathTestASKER
@wilcoxon: I need to be in add2PathTest directory. So I will need to use the first code you mentioned. But there will be different products in this directory aside from rel1.3 and I don't want to copy from all of them. Therefore, I need to mention the source directory. How can I do it with the code you sent me?
Thanks,
Thanks,
You can't. Your original requirements seemed to be to copy from all of them. This should allow doing so. The code now requires you to be in the add2PathTest dir when you run it and is run as
release2production.pl prod1 ... prodXuse strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath);
## taken from Term::Prompt
use Carp;
use Text::Wrap;
use Term::ReadKey qw (GetTerminalSize
ReadMode);
our $DEBUG = 0;
our $MULTILINE_INDENT = "\t";
my %menu = (
order => 'down',
return_base => 0,
display_base => 1,
accept_multiple_selections => 0,
accept_empty_selection => 0,
title => '',
prompt => '>',
separator => '[^0-9]+',
ignore_whitespace => 0,
ignore_empties => 0
);
sub prompt ($$$$;@);
# End Term::Prompt
#my $dir = shift or die "Usage: $0 base_dir\n";
#chdir $dir or die "could not cd to $dir: $!";
#opendir DIR, '.' or die "could not open $dir: $!";
#my @dirs = grep { -d $_ and $_ !~ m{^(?:bin|lib|\.+)$}o } readdir DIR;
#closedir DIR;
my @dirs = @ARGV;
print "checking @dirs...\n";
my ($base, %files, %multi);
foreach my $dir (sort @dirs) {
die "$dir is not a dir" unless (-d $dir);
$base = $dir;
File::Find::find({wanted => \&search}, $base);
}
if (%multi) {
foreach my $file (sort keys %multi) {
my $val = prompt('m', { prompt => 'which file?', title => 'conflict',
items => [ 'quit', map { "$_/$file" } @{$files{$file}} ],
cols => 1, display_base => 0 }, '', undef);
exit unless $val;
$files{$file} = [$files{$file}[$val-1]];
}
} else {
my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
items => ['quit', 'no conflicts - continue'], cols => 1,
display_base => 0 }, '', undef);
exit unless $val;
}
foreach my $file (keys %files) {
die "woa!! found conflict for $file after resolutions\n"
unless (@{$files{$file}} == 1);
# print "cp $files{$file}[0]/$file\n";
my $dir = $file;
$dir =~ s{/[^/]+$}{};
mkpath($dir) unless (-d $dir);
cp "$files{$file}[0]/$file", $file
or die "could not copy $files{$file}[0]/$file: $!";
}
sub search {
return unless -f $_;
my $name = $File::Find::name;
$name =~ s{^$base/}{};
if (exists $files{$name}) {
$multi{$name}++;
push @{$files{$name}}, $base;
} else {
push @{$files{$name}}, $base;
}
}
# BEGIN main part of Term::Prompt
# Preloaded methods go here.
sub prompt ($$$$;@) {
my($mopt, $prompt, $prompt_options, $default, @things) =
('','','',undef,());
my($repl, $match_options, $case, $low, $high, $before, $regexp, $coderef) =
('','','','','','','','');
my $prompt_full = '';
# Figure out just what we are doing here
$mopt = $_[0];
print "mopt is: $mopt\n" if $DEBUG;
# check the size of the match option, it should just have one char.
if (length($mopt) == 1
or $mopt =~ /\-n/i
or $mopt =~ /\+-n/i) {
my $dummy = 'mopt is ok';
} else {
croak "Illegal call of prompt; $mopt is more than one character; stopped";
}
my $type = 0;
my $menu = 0;
my $legal = 0;
my $range = 0;
my $expr = 0;
my $code = 0;
my $yn = 0;
my $uc = 0;
my $passwd = 0;
if ($mopt ne lc($mopt)) {
$uc = 1;
$mopt = lc($mopt);
}
if ($mopt eq 'm') {
($mopt, $prompt, $prompt_options, $default) = @_;
$menu = 1;
} else {
croak "prompt type $mopt not recognized";
}
my $ok = 0;
$mopt = lc($mopt);
while (1) {
if ($menu) {
## We're working on a menu
@menu{sort keys %{$prompt}} = @{$prompt}{sort keys %{$prompt}};
$prompt_full = "$menu{'prompt'} ";
my @menu_items = @{$menu{'items'}};
my $number_menu_items = scalar(@menu_items);
$menu{'low'} = $menu{'display_base'};
$menu{'high'} = $number_menu_items+$menu{'display_base'}-1;
my $digits_in_menu_item = (int(log($menu{'high'})/log(10)) + 1);
my $entry_length = 0;
my $item_length = 0;
for (@menu_items) {
$entry_length = length($_)
if length($_) > $entry_length;
}
$item_length = $entry_length;
$entry_length += ( $digits_in_menu_item ## Max number of digits in a selection
+
3 ## two for ') ', at least one for a column separator
);
my $gw = get_width();
my $num_cols = (defined($menu{'cols'})
? $menu{'cols'}
: int($gw/$entry_length));
$num_cols ||= 1; # Could be zero if longest entry in a
# list is wider than the screen
my $num_rows = (defined($menu{'rows'})
? $menu{'rows'}
: int($number_menu_items/$num_cols)+1) ;
my $data_fmt = "%${digits_in_menu_item}d) %-${item_length}.${item_length}s";
my $column_end_fmt = ("%s ");
my $line_end_fmt = ("%s\n");
my @menu_out = ();
my $row = 0;
my $col = 0;
my $idx = 0;
if ($menu{order} =~ /ACROSS/i) {
ACROSS_LOOP:
for ($row = 0; $row < $num_rows; $row++) {
for ($col = 0; $col < $num_cols; $col++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last ACROSS_LOOP
if $idx eq scalar(@menu_items);
}
}
} else {
DOWN_LOOP:
for ($col = 0; $col < $num_cols; $col++) {
for ($row = 0; $row < $num_rows; $row++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last DOWN_LOOP
if $idx eq scalar(@menu_items);
}
}
}
if (length($menu{'title'})) {
print $menu{'title'},"\n",'-' x length($menu{'title'}),"\n";
}
for ($row = 0;$row < $num_rows;$row++) {
for ($col = 0;$col < $num_cols-1;$col++) {
printf($column_end_fmt,$menu_out[$row][$col])
if defined($menu_out[$row][$col]);
}
if (defined($menu_out[$row][$num_cols-1])) {
printf($line_end_fmt,$menu_out[$row][$num_cols-1])
} else {
print "\n";
}
}
if ($number_menu_items != ($num_rows)*($num_cols)) {
print "\n";
}
unless (defined($prompt_options) && length($prompt_options)) {
$prompt_options = "$menu{'low'} - $menu{'high'}";
if ($menu{'accept_multiple_selections'}) {
$prompt_options .= ', separate multiple entries with spaces';
}
}
}
unless ($before || $uc || ($prompt_options eq '')) {
$prompt_full .= "($prompt_options) ";
}
if (defined($default) and $default ne '') {
$prompt_full .= "[default $default] ";
}
print termwrap($prompt_full);
my $old_divide = undef;
if (defined($/)) {
$old_divide = $/;
}
$/ = "\n";
ReadMode('noecho') if($passwd);
$repl = scalar(readline(*STDIN));
ReadMode('restore') if($passwd);
if (defined($old_divide)) {
$/ = $old_divide;
} else {
undef($/);
}
chomp($repl); # nuke the <CR>
$repl =~ s/^\s*//; # ignore leading white space
$repl =~ s/\s*$//; # ignore trailing white space
$repl = $default if $repl eq '';
print termwrap("Reply: '$repl'\n") if $DEBUG;
# Now here is where things get real interesting
my @menu_repl = ();
if ($menu) {
$ok = menuit(\@menu_repl, $repl, $DEBUG, $uc);
} else {
croak "No subroutine known for prompt type $mopt.";
}
if ($ok) {
if ($menu) {
if ($menu{'accept_multiple_selections'}) {
return (wantarray ? @menu_repl : \@menu_repl);
} else {
return $menu_repl[0];
}
}
} elsif (defined($prompt_options) && length($prompt_options)) {
if ($uc) {
print termwrap("$prompt_options\n");
} else {
if (!$menu) {
print termwrap("Options are: $prompt_options\n");
}
$before = 1;
}
}
}
}
sub rangeit ($$$$ ) {
# this routine makes sure that the reply is within a given range
my($repl, $low, $high, $uc) = @_;
if ( $low <= $repl && $repl <= $high ) {
return 1;
} elsif (!$uc) {
print 'Invalid range value. ';
}
return 0;
}
sub menuit (\@$$$ ) {
my ($ra_repl, $repl, $dbg, $uc) = @_;
print "inside of menuit\n" if $dbg;
my @msgs = ();
## Parse for multiple values. Strip all whitespace if requested or
## just strip leading and trailing whitespace to avoid a being
## interpreted as separating empty choices.
if($menu{'ignore_whitespace'}) {
$repl =~ s/\s+//g;
} else {
$repl =~ s/^(?:\s+)//;
$repl =~ s/(?:\s+)$//;
}
my @repls = split(/$menu{'separator'}/,$repl);
if($menu{ignore_empties}) {
@repls = grep{length($_)} @repls;
}
## Validations
if ( scalar(@repls) > 1
&&
!$menu{'accept_multiple_selections'} ) {
push @msgs, 'Multiple choices not allowed.';
} elsif (!scalar(@repls)
&&
!$menu{'accept_empty_selection'}) {
push @msgs, 'You must make a selection.';
} else {
for (@repls) {
if ( !rangeit($_,$menu{'low'},$menu{'high'},1)) {
push @msgs, "$_ is an invalid choice.";
}
}
}
## Print errors or return values
if (scalar(@msgs)) {
print "\n",join("\n",@msgs),"\n\n";
return 0;
} else {
@{$ra_repl} = map {$_ - $menu{'display_base'} + $menu{'return_base'}} @repls;
return 1;
}
}
sub termwrap ($;@) {
my($message) = '';
if ($#_ > 0) {
if (defined($,)) {
$message = join($,,@_);
} else {
$message = join(' ',@_);
}
} else {
$message = $_[0];
}
my $width = get_width();
if (defined($width) && $width) {
$Text::Wrap::Columns = $width;
}
if ($message =~ m/\n\Z/) {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z/\n/;
return $message;
} else {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z//;
return $message;
}
}
sub get_width {
## The 'use strict' added above caused the calls
## GetTerminalSize(STDOUT) and GetTerminalSize(STDERR) to fail in
## compilation. The fix as to REMOVE the parens. It seems as if
## this call works the same way as 'print' - if you need to
## specify the filehandle, you don't use parens (and don't put a
## comma after the filehandle, although that is irrelevant here.)
## SO DON'T PUT THEM BACK! :-)
my($width) = eval {
local($SIG{__DIE__});
(GetTerminalSize(select))[0];
} || eval {
if (-T STDOUT) {
local($SIG{__DIE__});
return (GetTerminalSize STDOUT )[0];
} else {
return 0;
}
} || eval {
if (-T STDERR) {
local($SIG{__DIE__});
return (GetTerminalSize STDERR )[0];
} else {
return 0;
}
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDOUT )[0];
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDERR )[0];
};
return $width;
}ASKER
So, how can we change the code so that I can specify the source directory (the product I want to copy from)?
Thanks,
Thanks,
To both specify the "source" dir (personally, I'd call it target since you want to copy files to "source"/(bin|lib)) and specify which product dirs, this should do it...
It is run as
It is run as
release2production.pl source_dir prod1 ... prodXrelease2production.pl /path/to/add2PathTest rel1.3use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath);
## taken from Term::Prompt
use Carp;
use Text::Wrap;
use Term::ReadKey qw (GetTerminalSize ReadMode);
our $DEBUG = 0;
our $MULTILINE_INDENT = "\t";
my %menu = (
order => 'down',
return_base => 0,
display_base => 1,
accept_multiple_selections => 0,
accept_empty_selection => 0,
title => '',
prompt => '>',
separator => '[^0-9]+',
ignore_whitespace => 0,
ignore_empties => 0
);
sub prompt ($$$$;@);
# End Term::Prompt
my $dir = shift or die "Usage: $0 base_dir prod_dirs\n";
my %chk = map { $_ => 1 } @ARGV;
chdir $dir or die "could not cd to $dir: $!";
opendir DIR, '.' or die "could not open $dir: $!";
my @dirs = grep { -d $_ and exists($chk{$_}) and $_ !~ m{^(?:bin|lib|\.+)$}o }
readdir DIR;
closedir DIR;
print "base dir $dir\n";
print "checking @dirs...\n";
my ($base, %files, %multi);
foreach my $dir (sort @dirs) {
$base = $dir;
File::Find::find({wanted => \&search}, $base);
}
if (%multi) {
foreach my $file (sort keys %multi) {
my $val = prompt('m', { prompt => 'which file?', title => 'conflict',
items => [ 'quit', map { "$_/$file" } @{$files{$file}} ],
cols => 1, display_base => 0 }, '', undef);
exit unless $val;
$files{$file} = [$files{$file}[$val-1]];
}
} else {
my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
items => ['quit', 'no conflicts - continue'], cols => 1,
display_base => 0 }, '', undef);
exit unless $val;
}
foreach my $file (keys %files) {
die "woa!! found conflict for $file after resolutions\n"
unless (@{$files{$file}} == 1);
# print "cp $files{$file}[0]/$file\n";
my $dir = $file;
$dir =~ s{/[^/]+$}{};
mkpath($dir) unless (-d $dir);
cp "$files{$file}[0]/$file", $file
or die "could not copy $files{$file}[0]/$file: $!";
}
sub search {
return unless -f $_;
my $name = $File::Find::name;
$name =~ s{^$base/}{};
if (exists $files{$name}) {
$multi{$name}++;
push @{$files{$name}}, $base;
} else {
push @{$files{$name}}, $base;
}
}
# BEGIN main part of Term::Prompt
# Preloaded methods go here.
sub prompt ($$$$;@) {
my($mopt, $prompt, $prompt_options, $default, @things) =
('','','',undef,());
my($repl, $match_options, $case, $low, $high, $before, $regexp, $coderef) =
('','','','','','','','');
my $prompt_full = '';
# Figure out just what we are doing here
$mopt = $_[0];
print "mopt is: $mopt\n" if $DEBUG;
# check the size of the match option, it should just have one char.
if (length($mopt) == 1
or $mopt =~ /\-n/i
or $mopt =~ /\+-n/i) {
my $dummy = 'mopt is ok';
} else {
croak "Illegal call of prompt; $mopt is more than one character; stopped";
}
my $type = 0;
my $menu = 0;
my $legal = 0;
my $range = 0;
my $expr = 0;
my $code = 0;
my $yn = 0;
my $uc = 0;
my $passwd = 0;
if ($mopt ne lc($mopt)) {
$uc = 1;
$mopt = lc($mopt);
}
if ($mopt eq 'm') {
($mopt, $prompt, $prompt_options, $default) = @_;
$menu = 1;
} else {
croak "prompt type $mopt not recognized";
}
my $ok = 0;
$mopt = lc($mopt);
while (1) {
if ($menu) {
## We're working on a menu
@menu{sort keys %{$prompt}} = @{$prompt}{sort keys %{$prompt}};
$prompt_full = "$menu{'prompt'} ";
my @menu_items = @{$menu{'items'}};
my $number_menu_items = scalar(@menu_items);
$menu{'low'} = $menu{'display_base'};
$menu{'high'} = $number_menu_items+$menu{'display_base'}-1;
my $digits_in_menu_item = (int(log($menu{'high'})/log(10)) + 1);
my $entry_length = 0;
my $item_length = 0;
for (@menu_items) {
$entry_length = length($_)
if length($_) > $entry_length;
}
$item_length = $entry_length;
$entry_length += ( $digits_in_menu_item ## Max number of digits in a selection
+
3 ## two for ') ', at least one for a column separator
);
my $gw = get_width();
my $num_cols = (defined($menu{'cols'})
? $menu{'cols'}
: int($gw/$entry_length));
$num_cols ||= 1; # Could be zero if longest entry in a
# list is wider than the screen
my $num_rows = (defined($menu{'rows'})
? $menu{'rows'}
: int($number_menu_items/$num_cols)+1) ;
my $data_fmt = "%${digits_in_menu_item}d) %-${item_length}.${item_length}s";
my $column_end_fmt = ("%s ");
my $line_end_fmt = ("%s\n");
my @menu_out = ();
my $row = 0;
my $col = 0;
my $idx = 0;
if ($menu{order} =~ /ACROSS/i) {
ACROSS_LOOP:
for ($row = 0; $row < $num_rows; $row++) {
for ($col = 0; $col < $num_cols; $col++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last ACROSS_LOOP
if $idx eq scalar(@menu_items);
}
}
} else {
DOWN_LOOP:
for ($col = 0; $col < $num_cols; $col++) {
for ($row = 0; $row < $num_rows; $row++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last DOWN_LOOP
if $idx eq scalar(@menu_items);
}
}
}
if (length($menu{'title'})) {
print $menu{'title'},"\n",'-' x length($menu{'title'}),"\n";
}
for ($row = 0;$row < $num_rows;$row++) {
for ($col = 0;$col < $num_cols-1;$col++) {
printf($column_end_fmt,$menu_out[$row][$col])
if defined($menu_out[$row][$col]);
}
if (defined($menu_out[$row][$num_cols-1])) {
printf($line_end_fmt,$menu_out[$row][$num_cols-1])
} else {
print "\n";
}
}
if ($number_menu_items != ($num_rows)*($num_cols)) {
print "\n";
}
unless (defined($prompt_options) && length($prompt_options)) {
$prompt_options = "$menu{'low'} - $menu{'high'}";
if ($menu{'accept_multiple_selections'}) {
$prompt_options .= ', separate multiple entries with spaces';
}
}
}
unless ($before || $uc || ($prompt_options eq '')) {
$prompt_full .= "($prompt_options) ";
}
if (defined($default) and $default ne '') {
$prompt_full .= "[default $default] ";
}
print termwrap($prompt_full);
my $old_divide = undef;
if (defined($/)) {
$old_divide = $/;
}
$/ = "\n";
ReadMode('noecho') if($passwd);
$repl = scalar(readline(*STDIN));
ReadMode('restore') if($passwd);
if (defined($old_divide)) {
$/ = $old_divide;
} else {
undef($/);
}
chomp($repl); # nuke the <CR>
$repl =~ s/^\s*//; # ignore leading white space
$repl =~ s/\s*$//; # ignore trailing white space
$repl = $default if $repl eq '';
print termwrap("Reply: '$repl'\n") if $DEBUG;
# Now here is where things get real interesting
my @menu_repl = ();
if ($menu) {
$ok = menuit(\@menu_repl, $repl, $DEBUG, $uc);
} else {
croak "No subroutine known for prompt type $mopt.";
}
if ($ok) {
if ($menu) {
if ($menu{'accept_multiple_selections'}) {
return (wantarray ? @menu_repl : \@menu_repl);
} else {
return $menu_repl[0];
}
}
} elsif (defined($prompt_options) && length($prompt_options)) {
if ($uc) {
print termwrap("$prompt_options\n");
} else {
if (!$menu) {
print termwrap("Options are: $prompt_options\n");
}
$before = 1;
}
}
}
}
sub rangeit ($$$$ ) {
# this routine makes sure that the reply is within a given range
my($repl, $low, $high, $uc) = @_;
if ( $low <= $repl && $repl <= $high ) {
return 1;
} elsif (!$uc) {
print 'Invalid range value. ';
}
return 0;
}
sub menuit (\@$$$ ) {
my ($ra_repl, $repl, $dbg, $uc) = @_;
print "inside of menuit\n" if $dbg;
my @msgs = ();
## Parse for multiple values. Strip all whitespace if requested or
## just strip leading and trailing whitespace to avoid a being
## interpreted as separating empty choices.
if($menu{'ignore_whitespace'}) {
$repl =~ s/\s+//g;
} else {
$repl =~ s/^(?:\s+)//;
$repl =~ s/(?:\s+)$//;
}
my @repls = split(/$menu{'separator'}/,$repl);
if($menu{ignore_empties}) {
@repls = grep{length($_)} @repls;
}
## Validations
if ( scalar(@repls) > 1
&&
!$menu{'accept_multiple_selections'} ) {
push @msgs, 'Multiple choices not allowed.';
} elsif (!scalar(@repls)
&&
!$menu{'accept_empty_selection'}) {
push @msgs, 'You must make a selection.';
} else {
for (@repls) {
if ( !rangeit($_,$menu{'low'},$menu{'high'},1)) {
push @msgs, "$_ is an invalid choice.";
}
}
}
## Print errors or return values
if (scalar(@msgs)) {
print "\n",join("\n",@msgs),"\n\n";
return 0;
} else {
@{$ra_repl} = map {$_ - $menu{'display_base'} + $menu{'return_base'}} @repls;
return 1;
}
}
sub termwrap ($;@) {
my($message) = '';
if ($#_ > 0) {
if (defined($,)) {
$message = join($,,@_);
} else {
$message = join(' ',@_);
}
} else {
$message = $_[0];
}
my $width = get_width();
if (defined($width) && $width) {
$Text::Wrap::Columns = $width;
}
if ($message =~ m/\n\Z/) {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z/\n/;
return $message;
} else {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z//;
return $message;
}
}
sub get_width {
## The 'use strict' added above caused the calls
## GetTerminalSize(STDOUT) and GetTerminalSize(STDERR) to fail in
## compilation. The fix as to REMOVE the parens. It seems as if
## this call works the same way as 'print' - if you need to
## specify the filehandle, you don't use parens (and don't put a
## comma after the filehandle, although that is irrelevant here.)
## SO DON'T PUT THEM BACK! :-)
my($width) = eval {
local($SIG{__DIE__});
(GetTerminalSize(select))[0];
} || eval {
if (-T STDOUT) {
local($SIG{__DIE__});
return (GetTerminalSize STDOUT )[0];
} else {
return 0;
}
} || eval {
if (-T STDERR) {
local($SIG{__DIE__});
return (GetTerminalSize STDERR )[0];
} else {
return 0;
}
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDOUT )[0];
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDERR )[0];
};
return $width;
}ASKER
@wilcoxon: ok. I got your code and I ran the following command when I am in the add2PathTest folder:
When it said no coflicts, I chose 1 and nothing happened. Nothing is copied.
release2Production.pl rel1.3When it said no coflicts, I chose 1 and nothing happened. Nothing is copied.
With that command, you are missing the source/base dir. If you are in add2PathTest, you still need to specify the dir (.) so it should be:
You can tell because the output from your command should look something like:
Here's a slight mod that will make sure at least 1 product dir is specified...
release2Production.pl . rel1.3You can tell because the output from your command should look something like:
(note the nothing listed as being checked).
base dir rel1.3
checking ...
Here's a slight mod that will make sure at least 1 product dir is specified...
use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath);
## taken from Term::Prompt
use Carp;
use Text::Wrap;
use Term::ReadKey qw (GetTerminalSize ReadMode);
our $DEBUG = 0;
our $MULTILINE_INDENT = "\t";
my %menu = (
order => 'down',
return_base => 0,
display_base => 1,
accept_multiple_selections => 0,
accept_empty_selection => 0,
title => '',
prompt => '>',
separator => '[^0-9]+',
ignore_whitespace => 0,
ignore_empties => 0
);
sub prompt ($$$$;@);
# End Term::Prompt
my $dir = shift or die "Usage: $0 base_dir prod_dirs\n";
my %chk = map { $_ => 1 } @ARGV;
chdir $dir or die "could not cd to $dir: $!";
opendir DIR, '.' or die "could not open $dir: $!";
my @dirs = grep { -d $_ and exists($chk{$_}) and $_ !~ m{^(?:bin|lib|\.+)$}o }
readdir DIR;
closedir DIR;
die "Usage: $0 base_dir prod_dirs\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";
my ($base, %files, %multi);
foreach my $dir (sort @dirs) {
$base = $dir;
File::Find::find({wanted => \&search}, $base);
}
if (%multi) {
foreach my $file (sort keys %multi) {
my $val = prompt('m', { prompt => 'which file?', title => 'conflict',
items => [ 'quit', map { "$_/$file" } @{$files{$file}} ],
cols => 1, display_base => 0 }, '', undef);
exit unless $val;
$files{$file} = [$files{$file}[$val-1]];
}
} else {
my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
items => ['quit', 'no conflicts - continue'], cols => 1,
display_base => 0 }, '', undef);
exit unless $val;
}
foreach my $file (keys %files) {
die "woa!! found conflict for $file after resolutions\n"
unless (@{$files{$file}} == 1);
# print "cp $files{$file}[0]/$file\n";
my $dir = $file;
$dir =~ s{/[^/]+$}{};
mkpath($dir) unless (-d $dir);
cp "$files{$file}[0]/$file", $file
or die "could not copy $files{$file}[0]/$file: $!";
}
sub search {
return unless -f $_;
my $name = $File::Find::name;
$name =~ s{^$base/}{};
if (exists $files{$name}) {
$multi{$name}++;
push @{$files{$name}}, $base;
} else {
push @{$files{$name}}, $base;
}
}
# BEGIN main part of Term::Prompt
# Preloaded methods go here.
sub prompt ($$$$;@) {
my($mopt, $prompt, $prompt_options, $default, @things) =
('','','',undef,());
my($repl, $match_options, $case, $low, $high, $before, $regexp, $coderef) =
('','','','','','','','');
my $prompt_full = '';
# Figure out just what we are doing here
$mopt = $_[0];
print "mopt is: $mopt\n" if $DEBUG;
# check the size of the match option, it should just have one char.
if (length($mopt) == 1
or $mopt =~ /\-n/i
or $mopt =~ /\+-n/i) {
my $dummy = 'mopt is ok';
} else {
croak "Illegal call of prompt; $mopt is more than one character; stopped";
}
my $type = 0;
my $menu = 0;
my $legal = 0;
my $range = 0;
my $expr = 0;
my $code = 0;
my $yn = 0;
my $uc = 0;
my $passwd = 0;
if ($mopt ne lc($mopt)) {
$uc = 1;
$mopt = lc($mopt);
}
if ($mopt eq 'm') {
($mopt, $prompt, $prompt_options, $default) = @_;
$menu = 1;
} else {
croak "prompt type $mopt not recognized";
}
my $ok = 0;
$mopt = lc($mopt);
while (1) {
if ($menu) {
## We're working on a menu
@menu{sort keys %{$prompt}} = @{$prompt}{sort keys %{$prompt}};
$prompt_full = "$menu{'prompt'} ";
my @menu_items = @{$menu{'items'}};
my $number_menu_items = scalar(@menu_items);
$menu{'low'} = $menu{'display_base'};
$menu{'high'} = $number_menu_items+$menu{'display_base'}-1;
my $digits_in_menu_item = (int(log($menu{'high'})/log(10)) + 1);
my $entry_length = 0;
my $item_length = 0;
for (@menu_items) {
$entry_length = length($_)
if length($_) > $entry_length;
}
$item_length = $entry_length;
$entry_length += ( $digits_in_menu_item ## Max number of digits in a selection
+
3 ## two for ') ', at least one for a column separator
);
my $gw = get_width();
my $num_cols = (defined($menu{'cols'})
? $menu{'cols'}
: int($gw/$entry_length));
$num_cols ||= 1; # Could be zero if longest entry in a
# list is wider than the screen
my $num_rows = (defined($menu{'rows'})
? $menu{'rows'}
: int($number_menu_items/$num_cols)+1) ;
my $data_fmt = "%${digits_in_menu_item}d) %-${item_length}.${item_length}s";
my $column_end_fmt = ("%s ");
my $line_end_fmt = ("%s\n");
my @menu_out = ();
my $row = 0;
my $col = 0;
my $idx = 0;
if ($menu{order} =~ /ACROSS/i) {
ACROSS_LOOP:
for ($row = 0; $row < $num_rows; $row++) {
for ($col = 0; $col < $num_cols; $col++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last ACROSS_LOOP
if $idx eq scalar(@menu_items);
}
}
} else {
DOWN_LOOP:
for ($col = 0; $col < $num_cols; $col++) {
for ($row = 0; $row < $num_rows; $row++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last DOWN_LOOP
if $idx eq scalar(@menu_items);
}
}
}
if (length($menu{'title'})) {
print $menu{'title'},"\n",'-' x length($menu{'title'}),"\n";
}
for ($row = 0;$row < $num_rows;$row++) {
for ($col = 0;$col < $num_cols-1;$col++) {
printf($column_end_fmt,$menu_out[$row][$col])
if defined($menu_out[$row][$col]);
}
if (defined($menu_out[$row][$num_cols-1])) {
printf($line_end_fmt,$menu_out[$row][$num_cols-1])
} else {
print "\n";
}
}
if ($number_menu_items != ($num_rows)*($num_cols)) {
print "\n";
}
unless (defined($prompt_options) && length($prompt_options)) {
$prompt_options = "$menu{'low'} - $menu{'high'}";
if ($menu{'accept_multiple_selections'}) {
$prompt_options .= ', separate multiple entries with spaces';
}
}
}
unless ($before || $uc || ($prompt_options eq '')) {
$prompt_full .= "($prompt_options) ";
}
if (defined($default) and $default ne '') {
$prompt_full .= "[default $default] ";
}
print termwrap($prompt_full);
my $old_divide = undef;
if (defined($/)) {
$old_divide = $/;
}
$/ = "\n";
ReadMode('noecho') if($passwd);
$repl = scalar(readline(*STDIN));
ReadMode('restore') if($passwd);
if (defined($old_divide)) {
$/ = $old_divide;
} else {
undef($/);
}
chomp($repl); # nuke the <CR>
$repl =~ s/^\s*//; # ignore leading white space
$repl =~ s/\s*$//; # ignore trailing white space
$repl = $default if $repl eq '';
print termwrap("Reply: '$repl'\n") if $DEBUG;
# Now here is where things get real interesting
my @menu_repl = ();
if ($menu) {
$ok = menuit(\@menu_repl, $repl, $DEBUG, $uc);
} else {
croak "No subroutine known for prompt type $mopt.";
}
if ($ok) {
if ($menu) {
if ($menu{'accept_multiple_selections'}) {
return (wantarray ? @menu_repl : \@menu_repl);
} else {
return $menu_repl[0];
}
}
} elsif (defined($prompt_options) && length($prompt_options)) {
if ($uc) {
print termwrap("$prompt_options\n");
} else {
if (!$menu) {
print termwrap("Options are: $prompt_options\n");
}
$before = 1;
}
}
}
}
sub rangeit ($$$$ ) {
# this routine makes sure that the reply is within a given range
my($repl, $low, $high, $uc) = @_;
if ( $low <= $repl && $repl <= $high ) {
return 1;
} elsif (!$uc) {
print 'Invalid range value. ';
}
return 0;
}
sub menuit (\@$$$ ) {
my ($ra_repl, $repl, $dbg, $uc) = @_;
print "inside of menuit\n" if $dbg;
my @msgs = ();
## Parse for multiple values. Strip all whitespace if requested or
## just strip leading and trailing whitespace to avoid a being
## interpreted as separating empty choices.
if($menu{'ignore_whitespace'}) {
$repl =~ s/\s+//g;
} else {
$repl =~ s/^(?:\s+)//;
$repl =~ s/(?:\s+)$//;
}
my @repls = split(/$menu{'separator'}/,$repl);
if($menu{ignore_empties}) {
@repls = grep{length($_)} @repls;
}
## Validations
if ( scalar(@repls) > 1
&&
!$menu{'accept_multiple_selections'} ) {
push @msgs, 'Multiple choices not allowed.';
} elsif (!scalar(@repls)
&&
!$menu{'accept_empty_selection'}) {
push @msgs, 'You must make a selection.';
} else {
for (@repls) {
if ( !rangeit($_,$menu{'low'},$menu{'high'},1)) {
push @msgs, "$_ is an invalid choice.";
}
}
}
## Print errors or return values
if (scalar(@msgs)) {
print "\n",join("\n",@msgs),"\n\n";
return 0;
} else {
@{$ra_repl} = map {$_ - $menu{'display_base'} + $menu{'return_base'}} @repls;
return 1;
}
}
sub termwrap ($;@) {
my($message) = '';
if ($#_ > 0) {
if (defined($,)) {
$message = join($,,@_);
} else {
$message = join(' ',@_);
}
} else {
$message = $_[0];
}
my $width = get_width();
if (defined($width) && $width) {
$Text::Wrap::Columns = $width;
}
if ($message =~ m/\n\Z/) {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z/\n/;
return $message;
} else {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z//;
return $message;
}
}
sub get_width {
## The 'use strict' added above caused the calls
## GetTerminalSize(STDOUT) and GetTerminalSize(STDERR) to fail in
## compilation. The fix as to REMOVE the parens. It seems as if
## this call works the same way as 'print' - if you need to
## specify the filehandle, you don't use parens (and don't put a
## comma after the filehandle, although that is irrelevant here.)
## SO DON'T PUT THEM BACK! :-)
my($width) = eval {
local($SIG{__DIE__});
(GetTerminalSize(select))[0];
} || eval {
if (-T STDOUT) {
local($SIG{__DIE__});
return (GetTerminalSize STDOUT )[0];
} else {
return 0;
}
} || eval {
if (-T STDERR) {
local($SIG{__DIE__});
return (GetTerminalSize STDERR )[0];
} else {
return 0;
}
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDOUT )[0];
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDERR )[0];
};
return $width;
}ASKER
Now it works as expected in terms of copying files. However, when it comes to detecting same files, it does not work as expected.
This is what happens:
I have some files in rel1.3 directory in the bin and lib directories.
Then I ran the following command:
This copied the files as expected. This is the output:
I have the same files are also in rel1.4 directory in the bin and lib directories.
I ran the following command:
This is the output:
The unexpected behavior is, it says "no conflicts" when I try to copy the same files from rel1.4 to the target directory even though all the files are already in the target bin and lib folders because I already copied them from rel1.3 folder. But the code does not detect this conflict.
To clarify: The conflict should be checked between the source and the target folders.
Can you please help me to resolve this part?
This is what happens:
I have some files in rel1.3 directory in the bin and lib directories.
Then I ran the following command:
perl release2Production.pl . rel1.3This copied the files as expected. This is the output:
Name "Text::Wrap::Columns" used only once: possible typo at release2Production.pl line 373.
base dir .
checking rel1.3...
no conflicts
------------
0) quit
1) no conflicts - continue
what to do? (0 - 1) 1I have the same files are also in rel1.4 directory in the bin and lib directories.
I ran the following command:
perl release2Production.pl . rel1.4This is the output:
Name "Text::Wrap::Columns" used only once: possible typo at release2Production.pl line 373.
base dir .
checking rel1.4...
no conflicts
------------
0) quit
1) no conflicts - continueThe unexpected behavior is, it says "no conflicts" when I try to copy the same files from rel1.4 to the target directory even though all the files are already in the target bin and lib folders because I already copied them from rel1.3 folder. But the code does not detect this conflict.
To clarify: The conflict should be checked between the source and the target folders.
Can you please help me to resolve this part?
Ah. I thought the conflict detection should only be between the multiple source (product) folders. I'll update the code - it may take a bit (but I should be able to do it today).
ASKER
Great. I am waiting for your solution.
Btw, to clarify: The conflict detection should only be between the source the target folders.
For example: If there is already a file in the target location with the same name then the code should notify the user by telling which files causes the conflict.
Thanks,
Btw, to clarify: The conflict detection should only be between the source the target folders.
For example: If there is already a file in the target location with the same name then the code should notify the user by telling which files causes the conflict.
Thanks,
Shouldn't it also find a conflict if prodA and prodB both contain bin/something.pl (whether or not ./bin/something.pl exists)?
ASKER
No, it shouldn't find the conflicts between the products. The only conflict that is important is between the product and the target location (./)
Thanks,
Thanks,
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
The script I posted will both check for conflicts with the dest dir and with other products specified on the command line (it ignores any products not specified when you run the script).
ASKER
I tried it and it works as expected. But there is a slight usage problem.
When I ran the script the first time there are no conflicts and it works ok. If I ran the script the second time, I have to approve all the conflicting files one by one. And if I have 50 files I have to make a choice for 50 times.
Instead of doing this, is it possible to make it as the following:
If there is a conflict then list all the conflicting files and ask the user to continue or to quit in order to resolve the problem.
This way the user will only make a choice once.
Thanks,
When I ran the script the first time there are no conflicts and it works ok. If I ran the script the second time, I have to approve all the conflicting files one by one. And if I have 50 files I have to make a choice for 50 times.
Instead of doing this, is it possible to make it as the following:
If there is a conflict then list all the conflicting files and ask the user to continue or to quit in order to resolve the problem.
This way the user will only make a choice once.
Thanks,
It seems like you have significantly changed your intended use (and requirements) as this question has progressed.
The big problem with what you are now asking is then it will not work for the case in your original question (when there is a conflict between prodA and prodB). If you describe how you want to resolve this type of conflict, it is definitely possible.
May I suggest closing this question (and awarding points since the code does everything requested in the original question and more) and creating a new question for this modification? The only "payment" experts get is points for our time.
The big problem with what you are now asking is then it will not work for the case in your original question (when there is a conflict between prodA and prodB). If you describe how you want to resolve this type of conflict, it is definitely possible.
May I suggest closing this question (and awarding points since the code does everything requested in the original question and more) and creating a new question for this modification? The only "payment" experts get is points for our time.
ASKER
Sure. I started this new question:
https://www.experts-exchange.com/questions/28329207/How-to-smrt-copy-files-between-folder-in-Perl.html
And, the problem you mentioned is not requirement actually. I don't need to check the conflicts between prodA and prodB. If this is already in the code we can just remove it.
The only conflict that I care are:
Thanks,
https://www.experts-exchange.com/questions/28329207/How-to-smrt-copy-files-between-folder-in-Perl.html
And, the problem you mentioned is not requirement actually. I don't need to check the conflicts between prodA and prodB. If this is already in the code we can just remove it.
The only conflict that I care are:
prod/bin and bin/
prod/lib and lib/Thanks,
ASKER
Perfect!
ASKER
@wilcoxon: In the code you sent me, there are sub functions called:
prompt, rangeit, menuit, termwrap anf get_width.
Did you write these functions or are there from different Perl modules?
And can you please tell me why and how we use them in the code?
Thanks,
prompt, rangeit, menuit, termwrap anf get_width.
Did you write these functions or are there from different Perl modules?
And can you please tell me why and how we use them in the code?
Thanks,
They are copied from Term::Prompt. I copied the Term::Prompt code and then removed any subs that weren't used in my code or in code I was calling in Term::Prompt.
In the code, lines 54 and 61 call prompt which calls get_width, menuit, and termwrap. menuit calls rangeit.
All of them have to do with the options display and getting user input.
In the code, lines 54 and 61 call prompt which calls get_width, menuit, and termwrap. menuit calls rangeit.
All of them have to do with the options display and getting user input.
ASKER
Ok. So, these sub functions does not need code review because they are from Term::Prompt to get user input.
And, I assume you did this because I didn't have Term::Prompt module.
And, I assume you did this because I didn't have Term::Prompt module.
Yes. I did that since you didn't have Term::Prompt installed and said it would be very difficult or impossible to get it installed (see this comment and the following 2 from above).
ASKER
that's right.
Thanks,
Thanks,
ASKER
Hi Wilcoxon,
Can you please take a look at this question if you have time?
https://www.experts-exchange.com/questions/28337275/How-to-detect-deleted-files-in-a-smart-copy-between-directories-in-Perl.html
Thanks,
Can you please take a look at this question if you have time?
https://www.experts-exchange.com/questions/28337275/How-to-detect-deleted-files-in-a-smart-copy-between-directories-in-Perl.html
Thanks,