How to detect deleted files in a smart copy between directories in Perl?

The following code copies files from a source directory to a target bin and lib directories.



The code checks the conflicts in the copy process and informs the user about the conflicting files and asks the user to quit or to continue copying the files.

There are two steps that I woud like to add to this code:

1- Creating an archive before copying file. This is just to keep the  old files before copying in case we need to go back to these files due to any problems.

2-  Checking the files that were deleted. If there are deleted files in the source (where you are copying from) then the target directory should also not have these files after the copy process.


Solution for Problem 1:

If there is no archive directory in the same level as the target bin and lib directories then create one and copy the target bin and lib directories to this archive directory. So now, we have copy of the old files.

Here is the directory structure before the first copy process:

someproduct1directory/
someproduct2directory/
someproduct3directory/
someproduct4directory/
someproduct5directory/
someproduct6directory/
bin/
lib/

Open in new window


The directory structure after the first copy process:

someproduct1directory/
someproduct2directory/
someproduct3directory/
someproduct4directory/
someproduct5directory/
someproduct6directory/
bin/
lib/
archive/bin/
archive/lib

Open in new window



Now, we have the old files in the archive directory. If I run the script the second time, the new bin and lib directories are going to overwrite the files in the archive directory.

Now the script can start the copy process as before.

Solution for Problem 2:

For example:

The source directory (let's say someproduct1directory) has these files in bin and lib directories:

someproduct1directory/bin/abc.x
someproduct1directory/lib/def.x
someproduct1directory/lib/ghj.x

Open in new window



After the copy process the target directories (bin and lib directories which are at the same level as the someproduct1directory and other product directories) will have the same files as below:


bin/abc.x
lib/def.x
lib/ghj.x

Open in new window



After a while, if I delete ghj.x file from the source directory, the source will be like this


someproduct1directory/bin/abc.x
someproduct1directory/lib/def.x

Open in new window


And then, if I use the following script to copy the new set of files, ghj.x will stay in the target directory because it is not conflicting with any file in the source (someproduct1directory). However, ideally, it should be reported as deleted file and after the delete process and the script should prompt to the user and ask if it is ok to delete this file from the target location. If the user says "yes" then it should delete this file, otherwise it should keep it there and quit.

In order to do that, the script should also look at the other product directories (such as someproduct2directory, someproduct3directory and so on...) which locate at the same level with the someproduct1directory (except prod, bin and lib directories because prod is the symlink to the bin directory. And bin and lib directories are the target directories) to check if the file is really deleted or it does locate in another product directory. If the script cannot find the file in any other product directory and it only locates in the target location then it means it is deleted and we can also delete it from the target location after the user approves the delete process as I explained above.

NOTE1: prod is a sym link to bin.
NOTE2: bin and lib directories are target directories.


Can you please help me to make this change to this code?

The original question about this script is in here:
http://www.experts-exchange.com/Programming/Languages/Scripting/Perl/Q_28319462.html

The second follow up question is in here:
http://www.experts-exchange.com/Programming/Languages/Scripting/Perl/Q_28329207.html


The script that I have is below:

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 e.g release2Production.pl . rel1.3\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

my ($base, %files, %multi, %dest);

foreach my $dir (qw(bin lib)) {
    File::Find::find({wanted => \&base}, $dir) if (-d $dir);
}

foreach my $dir (sort @dirs) {
    $base = $dir;
    File::Find::find({wanted => \&search}, $base);
}
if (%multi) {
    foreach my $file (sort keys %multi) {
        if (@{$files{$file}} > 2 or $files{$file}[0] ne '.') {
            warn "unresolvable conflicts found between products for $file:\n"
                . join ("\n", @{$files{$file}}) . "\n";
        }
        print "$file:\t", join("\t", @{$files{$file}}), "\n";
        $files{$file} = [$files{$file}[($files{$file}[0] eq '.') ? 1 : 0]];
    }
    my $val = prompt('m', { prompt => 'what to do?', title => 'conflicts',
                items => ['quit', 'conflicts - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
} 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 base {
    return unless -f $_;
    my $name = $File::Find::name;
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    if (exists $files{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, $base;
    } elsif (exists $dest{$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;
    }

}

# The termwrap is used to wrap lines to the width of the currently selected filehandle
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;
	print $Text::Wrap::Columns if 0; # dummy line to get rid of warning
    }

    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;
    }
}

# The get_width is used internally by it is likewise available for optional export; 
# it defaults to the current value of Text::Wrap::columns if the width cannot be determined.
sub get_width {
    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;
}

Open in new window

TolgarAsked:
Who is Participating?
 
wilcoxonConnect With a Mentor Commented:
That's pretty easy to fix...
use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath rmtree);

## 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 @alldirs = grep { -d $_ and $_ !~ m{^(?:bin|lib|archive|prod|\.+)$}o } readdir DIR;
my @dirs = grep { exists $chk{$_} } @alldirs;
closedir DIR;
die "Usage: $0 base_dir prod_dirs\n e.g release2Production.pl . rel1.3\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

my ($base, %files, %multi, %dest);

# catalog dest files
foreach my $dir (qw(bin lib)) {
    File::Find::find({wanted => \&base}, $dir) if (-d $dir);
}

# catalog product files
foreach my $dir (sort @dirs) {
    $base = $dir;
    File::Find::find({wanted => \&search}, $base);
}

if (%multi) {
    foreach my $file (sort keys %multi) {
        if (@{$files{$file}} > 2 or $files{$file}[0] ne '.') {
            warn "unresolvable conflicts found between products for $file:\n"
                . join ("\n", @{$files{$file}}) . "\n";
        }
        print "$file:\t", join("\t", @{$files{$file}}), "\n";
        $files{$file} = [$files{$file}[($files{$file}[0] eq '.') ? 1 : 0]];
    }
    my $val = prompt('m', { prompt => 'what to do?', title => 'conflicts',
                items => ['quit', 'conflicts - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
} 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;
}

# create archive
rmtree('archive');
foreach my $fil (keys %dest) {
    my $dir = "archive/$fil";
    $dir =~ s{/[^/]+$}{};
    mkpath($dir) unless (-d $dir);
    cp $fil, "archive/$fil" or die "could not archive $fil: $!";
}

# copy files
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: $!";
}

# check for files to delete
my (%all_files, @del);
foreach my $dir (@alldirs) {
    $base = $dir;
    File::Find::find({wanted => \&full_list}, $dir);
}
foreach my $fil (sort keys %dest) {
    push @del, $fil unless exists($all_files{$fil});
}
if (@del) {
    print "files to delete:\n\t", join("\n\t", @del), "\n";
    my $val = prompt('m', { prompt => 'what to do?', title => 'delete files',
                items => ['quit', 'delete - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
    foreach my $fil (@del) {
        unlink $fil or die "could not delete $fil: $!";
    }
}

## subroutines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    if (exists $files{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, $base;
    } elsif (exists $dest{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, '.', $base;
    } else {
        push @{$files{$name}}, $base;
    }
}

sub full_list {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    $all_files{$name}++;
}

# 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;
    }

}

# The termwrap is used to wrap lines to the width of the currently selected filehandle
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;
        print $Text::Wrap::Columns if 0; # dummy line to get rid of warning
    }

    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;
    }
}

# The get_width is used internally by it is likewise available for optional export; 
# it defaults to the current value of Text::Wrap::columns if the width cannot be determined.
sub get_width {
    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;
}

Open in new window

0
 
wilcoxonCommented:
I'm pretty sure this should do what you want.  I syntax checked it (eg perl -cw) but did not have a directory setup to test the behavior.  Let me know if there are any issues.
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 @alldirs = grep { -d $_ and $_ !~ m{^(?:bin|lib|archive|prod|\.+)$}o } readdir DIR;
my @dirs = grep { exists $chk{$_} } @alldirs;
closedir DIR;
die "Usage: $0 base_dir prod_dirs\n e.g release2Production.pl . rel1.3\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

my ($base, %files, %multi, %dest);

# catalog dest files
foreach my $dir (qw(bin lib)) {
    File::Find::find({wanted => \&base}, $dir) if (-d $dir);
}

# catalog product files
foreach my $dir (sort @dirs) {
    $base = $dir;
    File::Find::find({wanted => \&search}, $base);
}

if (%multi) {
    foreach my $file (sort keys %multi) {
        if (@{$files{$file}} > 2 or $files{$file}[0] ne '.') {
            warn "unresolvable conflicts found between products for $file:\n"
                . join ("\n", @{$files{$file}}) . "\n";
        }
        print "$file:\t", join("\t", @{$files{$file}}), "\n";
        $files{$file} = [$files{$file}[($files{$file}[0] eq '.') ? 1 : 0]];
    }
    my $val = prompt('m', { prompt => 'what to do?', title => 'conflicts',
                items => ['quit', 'conflicts - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
} 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;
}

# create archive
mkpath("$dir/archive/bin") unless (-d "$dir/archive/bin");
mkpath("$dir/archive/lib") unless (-d "$dir/archive/lib");
foreach my $fil (keys %dest) {
    cp $fil, "archive/$fil" or die "could not archive $fil: $!";
}

# copy files
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: $!";
}

# check for files to delete
my (%all_files, @del);
foreach my $dir (@alldirs) {
    $base = $dir;
    File::Find::find({wanted => \&full_list}, $dir);
}
foreach my $fil (sort keys %dest) {
    push @del, $fil unless exists($all_files{$fil});
}
if (@del) {
    print "files to delete:\n\t", join("\n\t", @del), "\n";
    my $val = prompt('m', { prompt => 'what to do?', title => 'delete files',
                items => ['quit', 'delete - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
    foreach my $fil (@del) {
        unlink $fil or die "could not delete $fil: $!";
    }
}

## subroutines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    if (exists $files{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, $base;
    } elsif (exists $dest{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, '.', $base;
    } else {
        push @{$files{$name}}, $base;
    }
}

sub full_list {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    $all_files{$name}++;
}

# 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;
    }

}

# The termwrap is used to wrap lines to the width of the currently selected filehandle
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;
        print $Text::Wrap::Columns if 0; # dummy line to get rid of warning
    }

    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;
    }
}

# The get_width is used internally by it is likewise available for optional export; 
# it defaults to the current value of Text::Wrap::columns if the width cannot be determined.
sub get_width {
    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;
}

Open in new window

0
 
TolgarAuthor Commented:
@wilcoxon: I will test it now and I will let you know how it works.
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
TolgarAuthor Commented:
@wilcoxon: The first time I ran the script on a product directory it worked fine. But when I tried to run the script on the same directory I got the following error after I selected 1 to continue:

could not archive lib/standardsRepository/third-partyTools/findbugs-2.0.1/doc/contributing.html: No such file or directory at release2Production.pl line 79, <STDIN> line 1.

Open in new window

0
 
wilcoxonCommented:
Corrected...
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 @alldirs = grep { -d $_ and $_ !~ m{^(?:bin|lib|archive|prod|\.+)$}o } readdir DIR;
my @dirs = grep { exists $chk{$_} } @alldirs;
closedir DIR;
die "Usage: $0 base_dir prod_dirs\n e.g release2Production.pl . rel1.3\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

my ($base, %files, %multi, %dest);

# catalog dest files
foreach my $dir (qw(bin lib)) {
    File::Find::find({wanted => \&base}, $dir) if (-d $dir);
}

# catalog product files
foreach my $dir (sort @dirs) {
    $base = $dir;
    File::Find::find({wanted => \&search}, $base);
}

if (%multi) {
    foreach my $file (sort keys %multi) {
        if (@{$files{$file}} > 2 or $files{$file}[0] ne '.') {
            warn "unresolvable conflicts found between products for $file:\n"
                . join ("\n", @{$files{$file}}) . "\n";
        }
        print "$file:\t", join("\t", @{$files{$file}}), "\n";
        $files{$file} = [$files{$file}[($files{$file}[0] eq '.') ? 1 : 0]];
    }
    my $val = prompt('m', { prompt => 'what to do?', title => 'conflicts',
                items => ['quit', 'conflicts - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
} 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;
}

# create archive
foreach my $fil (keys %dest) {
    my $dir = $fil;
    $dir =~ s{/[^/]+$}{};
    mkpath($dir) unless (-d $dir);
    cp $fil, "archive/$fil" or die "could not archive $fil: $!";
}

# copy files
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: $!";
}

# check for files to delete
my (%all_files, @del);
foreach my $dir (@alldirs) {
    $base = $dir;
    File::Find::find({wanted => \&full_list}, $dir);
}
foreach my $fil (sort keys %dest) {
    push @del, $fil unless exists($all_files{$fil});
}
if (@del) {
    print "files to delete:\n\t", join("\n\t", @del), "\n";
    my $val = prompt('m', { prompt => 'what to do?', title => 'delete files',
                items => ['quit', 'delete - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
    foreach my $fil (@del) {
        unlink $fil or die "could not delete $fil: $!";
    }
}

## subroutines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    if (exists $files{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, $base;
    } elsif (exists $dest{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, '.', $base;
    } else {
        push @{$files{$name}}, $base;
    }
}

sub full_list {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    $all_files{$name}++;
}

# 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;
    }

}

# The termwrap is used to wrap lines to the width of the currently selected filehandle
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;
        print $Text::Wrap::Columns if 0; # dummy line to get rid of warning
    }

    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;
    }
}

# The get_width is used internally by it is likewise available for optional export; 
# it defaults to the current value of Text::Wrap::columns if the width cannot be determined.
sub get_width {
    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;
}

Open in new window

0
 
TolgarAuthor Commented:
@wilcoxon: I got the same error when I ran the script the second time:

what to do? (0 - 1) 1
could not archive lib/standardsRepository/third-partyTools/findbugs-2.0.1/doc/contributing.html: No such file or directory at release2Production.pl line 80, <STDIN> line 1.

Open in new window

0
 
wilcoxonCommented:
Oops.  Typo...
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 @alldirs = grep { -d $_ and $_ !~ m{^(?:bin|lib|archive|prod|\.+)$}o } readdir DIR;
my @dirs = grep { exists $chk{$_} } @alldirs;
closedir DIR;
die "Usage: $0 base_dir prod_dirs\n e.g release2Production.pl . rel1.3\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

my ($base, %files, %multi, %dest);

# catalog dest files
foreach my $dir (qw(bin lib)) {
    File::Find::find({wanted => \&base}, $dir) if (-d $dir);
}

# catalog product files
foreach my $dir (sort @dirs) {
    $base = $dir;
    File::Find::find({wanted => \&search}, $base);
}

if (%multi) {
    foreach my $file (sort keys %multi) {
        if (@{$files{$file}} > 2 or $files{$file}[0] ne '.') {
            warn "unresolvable conflicts found between products for $file:\n"
                . join ("\n", @{$files{$file}}) . "\n";
        }
        print "$file:\t", join("\t", @{$files{$file}}), "\n";
        $files{$file} = [$files{$file}[($files{$file}[0] eq '.') ? 1 : 0]];
    }
    my $val = prompt('m', { prompt => 'what to do?', title => 'conflicts',
                items => ['quit', 'conflicts - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
} 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;
}

# create archive
foreach my $fil (keys %dest) {
    my $dir = "archive/$fil";
    $dir =~ s{/[^/]+$}{};
    mkpath($dir) unless (-d $dir);
    cp $fil, "archive/$fil" or die "could not archive $fil: $!";
}

# copy files
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: $!";
}

# check for files to delete
my (%all_files, @del);
foreach my $dir (@alldirs) {
    $base = $dir;
    File::Find::find({wanted => \&full_list}, $dir);
}
foreach my $fil (sort keys %dest) {
    push @del, $fil unless exists($all_files{$fil});
}
if (@del) {
    print "files to delete:\n\t", join("\n\t", @del), "\n";
    my $val = prompt('m', { prompt => 'what to do?', title => 'delete files',
                items => ['quit', 'delete - continue'], cols => 1,
                display_base => 0 }, '', undef);
    exit unless $val;
    foreach my $fil (@del) {
        unlink $fil or die "could not delete $fil: $!";
    }
}

## subroutines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    if (exists $files{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, $base;
    } elsif (exists $dest{$name}) {
        $multi{$name}++;
        push @{$files{$name}}, '.', $base;
    } else {
        push @{$files{$name}}, $base;
    }
}

sub full_list {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    $all_files{$name}++;
}

# 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;
    }

}

# The termwrap is used to wrap lines to the width of the currently selected filehandle
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;
        print $Text::Wrap::Columns if 0; # dummy line to get rid of warning
    }

    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;
    }
}

# The get_width is used internally by it is likewise available for optional export; 
# it defaults to the current value of Text::Wrap::columns if the width cannot be determined.
sub get_width {
    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;
}

Open in new window

0
 
TolgarAuthor Commented:
@wilcoxon: From my first few tests, it works as expected. This is perfect!!

I will do some more testing tomorrow.

I hope you will be able to check your emails during the day in case I find something.

Thanks,
0
 
TolgarAuthor Commented:
@wilcoxon: I found a small problem in copying files to the archive directory.

When I delete a file from my source product directory, the script successfully deletes the deleted file from the target directory if it does not locate anywhere else other than target and archive locations.

However, the deleted file stays in the archive directory. I assume the script overwrites the files in the archive directory and the deleted files just stay there.

Since archive should be the same as the previous (before the actual copy process) bin and lib directories, it would be better to delete everything in the archive and then copy from target bin and lib directories to the archive directory. So that archive will contain the same files as the target bin and lib  directories.

Example:

someproduct1/lib/abc.cpp
someproduct1/lib/def.cpp

Open in new window


And the target lib has the same files:

lib/abc.cpp
lib/def.cpp

Open in new window


And the archive has these:

archive/lib/abc.cpp
archive/lib/def.cpp

Open in new window


Then I delete def.cpp from the product location and now the product has this:

someproduct1/lib/abc.cpp

Open in new window


The target has this:

lib/abc.cpp

Open in new window


And the archive has this (because the files in the target are copied to the archive before the actual copy process) and it is ok until this point:

archive/lib/abc.cpp
archivelib/def.cpp

Open in new window


Then I run the script again without making any changes to the file list.

Since the target only has abc.cpp file, the archive should be like this:


archive/lib/abc.cpp

Open in new window


but now, it looks like this because, the script just overwrites to the archive directory.

archive/lib/abc.cpp
archivelib/def.cpp

Open in new window


How can we fix this?

Thanks,
0
 
TolgarAuthor Commented:
@wilcoxon: Great!

I will do a few more tests and then I will close this question by the end of Wednesday.

I wonder if you would be available if I find some issues this week?

Thanks,
0
 
wilcoxonCommented:
On and off.  I'll take a look when I can if you find any issues.
0
 
TolgarAuthor Commented:
@wilcoxon: I tried the code with some real files in production and there is something that does not work about the actual copy process.

The problem is the directory structure and it is like this:

bin/
lib/
product1/rel1.2/bin
product1/rel1.2/lib
product2/rel1.6/bin
product2/rel1.6/lib

Open in new window


when I run the command like this it gives me a usage error:

release2production.pl . product1

Open in new window



The missing part (and it is my mistake) is the one directory level after the product.

How can we change the code so that it would work with them as well?

Thanks,
0
 
TolgarAuthor Commented:
@wilcoxon: I wonder if you could be able to look at my last post today. I am also trying to fix it but I haven't made a good progress yet.

Thanks,
0
 
TolgarAuthor Commented:
@wilcoxon: And the other issue is about the directories in the product which are at the same level as bin and lib. These directories should be ignored but in the existing code, they are also copied to the same level as the target bin and lib directories.

Example:

someproduct1/bin/
someproduct1/lib/
someproduct1/somedir1/
someproduct1/somedir2/

Open in new window



Expected behavior:
somedir1 and somedir2 directories should ignored.

General rule:
Basically, anything at the same level with bin and lib directories in the product (other than bin and lib of this product) should be ignored.


Current behavior:
somedir1 and somedir2 directories are copied to the same level as the target bin and lib directories.
0
 
TolgarAuthor Commented:
@wilcoxon: I know you may not be available but it would be really great if you can help to make these changes tonight. I am very sure that these are the only things left after I did the test in the full test environment.

Please let me know if you will have a chance tonight.

I really appreciate.

Thanks,
0
 
wilcoxonCommented:
I see you opened a new question for the remaining issues you found above.  I'll take a look at the new question when I have time (if ozo hasn't answered it).

Sorry I haven't had a chance to look at it (and probably won't until Thursday) - this week has shifted around to be really busy through Wednesday (but less busy at the end of the week than it was supposed to be).
0
 
TolgarAuthor Commented:
@wilcoxon: it would have been really great if I could have resolved this issue before tomorrow morning but it seems like it won't be possible.

Ozo also didn't give me an answer yet.

I look forward to hearing from you.

Thanks,
0
 
TolgarAuthor Commented:
@wilcoxon: I added a new test directory structure to the following question:

http://www.experts-exchange.com/Programming/Languages/Scripting/Perl/Q_28343631.html#a39800175

This helps us to specify which version of the application we will copy.

The example command is:

perl release2Production.pl . CodingS/12

Open in new window


Thanks,
0
 
TolgarAuthor Commented:
@wilcoxon: Can we also print who edited the conflicting files in the target area and their sizes when we prompt to the user?

Thanks,
0
 
TolgarAuthor Commented:
@Wilcoxon: The requirements change slightly and I believe we have almost everything that does the trick in this code. I will create a new question with the new requirements and then I will close this question.

Thanks,
0
 
TolgarAuthor Commented:
@Wilcoxon: I created this new question with the new requirements.

http://www.experts-exchange.com/Programming/Languages/Scripting/Perl/Q_28345551.html

Thanks,
0
 
wilcoxonCommented:
I'll take a look when I have time (probably tomorrow).  This week is turning out much busier than I expected.
0
 
TolgarAuthor Commented:
Thanks and sorry for changing requirements.
0
 
TolgarAuthor Commented:
by the way. Please check with me if the new requirements are not clear. I check my email pretty often.

The TEST.zip file can make it clear.

Thanks,
0
 
wilcoxonCommented:
Does the new question replace the question that ozo partly looked at or do you need answers to both of them?
0
 
TolgarAuthor Commented:
@wilcoxon: The new question which I posted covers the questions in this one an the other one.

I only mentioned the new requirements in the new question. The others such as removing the deleted files from the target location is valid an you already answered it in this question.


Thanks,
0
 
TolgarAuthor Commented:
@wilcoxon: Will you be able to look at my last post on Friday?

Thanks,
0
 
TolgarAuthor Commented:
Hi Wilcoxon,
Thank you for all your replies to this question.

I am closing this question but I have another followup question. Can you please look at it?

You know the history of this question, so it may be better if you help me.

Please see my new question below:

http://www.experts-exchange.com/Programming/Languages/Scripting/Perl/Q_28352953.html


Thanks,
0
 
TolgarAuthor Commented:
Perfect solution. I really appreciate.
0
 
TolgarAuthor Commented:
@wilcoxon: can you please take a look at my last question?

http://www.experts-exchange.com/Programming/Languages/Scripting/Perl/Q_28352953.html

Thanks,
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.