Solved

How to do a smart copy between directories using Perl?

Posted on 2014-01-22
34
323 Views
Last Modified: 2014-03-24
Hi,
I have a code that copies files between directories. However, the requirements slightly changed and now this code does not satisfy them.

The new requirements are like this:

1- This script should copy files from bin and lib directories of a product into bin and lib directories under version/$timeStamp/ directory.

The $timeStamp (preferably in this format. YearMonthDay e.g. 20140122) directory and the bin and lib directories in it are going to be created while running the script.

And if there is a previous $timeStamp directory (let's say it was created before by running this script) in the version directory, the bin and lib directories in this last $timeStamp directory should be copied to the new $timeStamp directory first. And then the copy process should start. So  that, the files that were copied from other products into this old $timeStamp directory will be guaranteed that they will be in the last $timeStamp directory after the copy process which copied files and directories from the requested source directory (product).

By doing that we will keep all previous versions in the version directory and other product files will not be impacted.

2- The next part is to create symbolic link to the last $timeStamp directory. In order to do that, the script should first ask this to the user and if the user says yes, then it should change the symbolic link to the latest $timeStamp directory in the version folder. Otherwise, it should not change it. The symbolic link should be between the prod and the last $timeStamp directory. The prod directory will be in the same level as the products. (please see the example in the attachment.)

I attached an example directory structure in the zip file.

The version directory in the attached zip file has two directories in it just for representation in this example. In the actual scenario, version directory should not exist at all. And then it should be created in the first run after making sure it does not exist. And then, in time version directory will accumulate $timeStamp directories. If at some point somebody deletes it by mistake, the code should recognize that it does not exist and it should create it again. The better way is to check if version directory does exist, if not then the script should create it otherwise, it can use the existing one.

Since $timeStamp consists of year, month and day, it would cause a problem if you need to run the script twice in one day. Therefore, the code should check if the same name directory exists in the version directory, then it should add a number to the end of the timeStamp name. (e.g. 20140122-2. Because 20140122 already exists)

NOTE: Any directory other then bin and lib in the product directories should be ignored in the copy process. For example, in the attachment I posted, StoreS/11 has somedir7 directory. It should NOT be copied at all.

3- The other new requirement is the information that is printed on the screen when there is a conflict. It would be better if the owner of the conflicting file and the file size is also printed along with the file name.

4- Would it be possible not to need to need to type "." after the command to mention the current location.

The preferred way of running this script is the name of the script and the product name.

e.g. releaseScript.pl CodeS/12

Open in new window


I attached visual designs as well to make it more clear.

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


Thanks,
TEST.zip
IMG-20140122-205437.jpg
IMG-20140122-205449.jpg
IMG-20140122-205458.jpg
0
Comment
Question by:Tolgar
  • 27
  • 7
34 Comments
 
LVL 26

Expert Comment

by:wilcoxon
ID: 39807821
This isn't finished yet but should handle requirements 1-2 and 4 (not 3).  I assume that with these new requirements, the archive dir is no longer needed (since version/$date handles the same functionality)?

use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath rmtree);

my @tmp = (localtime)[5,4,3];
$tmp[0] += 1900;
$tmp[1]++;
my $ts = join '', @tmp;
@tmp = ();

## 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 = '.';
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 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);

# check for ts dir existence
if (-d 'version' and -d "version/$ts") {
    my $num = 2;
    $num++ while (-d "version/$ts-$num");
    $ts = "$ts-$num";
}

# copy from most recent timestamp dir and catalog dest files
if (opendir DIR, 'version') {
    my @dirs = sort { $b <=> $a } grep { -d "version/$_" } readdir DIR;
    closedir DIR;
    my $rec = $dirs[0];
    $base = "version/$rec";
    File::Find::find({wanted => \&base}, "version/$rec") if (-d "version/$rec");
    foreach my $fil (keys %dest) {
        my $dir = $fil;
        $dir =~ s{/[^/]+$}{};
        mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
        cp "version/$rec/$fil", "version/$ts/$fil"
            or die "could not copy version/$rec/$fil to $ts: $!";
    }
}

# 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("version/$ts/$dir") unless (-d "version/$ts/$dir");
    cp "$files{$file}[0]/$file", "version/$ts/$file"
            or die "could not copy $files{$file}[0]/$file to $ts: $!";
}

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

if (-d "version/$ts") {
    my $val = prompt('m', { prompt => "do you want link prod to $ts?",
                     title => 'symlink', items => ['quit', 'yes'],
                     cols => 1, display_base => 0 }, '', undef);
    if ($val) {
        unlink 'prod';
        symlink("version/$ts", 'prod');
    }
}

## subroutines

# File::Find wanted routines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    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/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $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
 

Author Comment

by:Tolgar
ID: 39807871
@wilcoxon: you are right. The archive dir is not needed.

Thanks a lot.
0
 

Author Comment

by:Tolgar
ID: 39809407
@wilcoxon: I tried to run the script on the test file I sent you and I got this error:

% perl release2Production.pl CodingS/12/
Usage: release2Production.pl prod_dirs
 e.g release2Production.pl . rel1.3

Open in new window

0
 

Author Comment

by:Tolgar
ID: 39809459
@wilcoxon: I would appreciate if you could let me know tonight so that I can test it before tomorrow.

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39809656
@wilcoxon: any idea?
0
 

Author Comment

by:Tolgar
ID: 39810533
@wilcoxon: I think, for the error I sent you, the solution would be to trim the last directory from the path while doing grep on allDirs. Because having a directory in the product such as rel1.2 is guaranteed

I hope this would help to solve the issue.

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39810889
@wilcoxon: any news?
0
 

Author Comment

by:Tolgar
ID: 39811093
@wilcoxon: The deleted files cannot be detected correctly in the new code. I assume the new directory layer such as rel1.2 made it not working.

In this case, the comparison should be done by checking the content of the newest directory in the product folder. Because there is no general rule/convention for this directory name. But the newest one is the most up to date one.

And I changed the as below to fix the previous problem:

use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath rmtree);

my @tmp = (localtime)[5,4,3];
$tmp[0] += 1900;
$tmp[1]++;
my $ts = join '', @tmp;
@tmp = ();

## 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 = '.';
#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{^(?:version|prod|\.+)$}o } readdir DIR;
#my @dirs = grep { exists $chk{$_} } @alldirs;
push(my @dirs, $ARGV[0]);
closedir DIR;
die "Usage: $0 prod_dirs\n e.g release2Production.pl Coding-Standards/rel1.3/\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

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

# check for ts dir existence
if (-d 'version' and -d "version/$ts") {
    my $num = 2;
    $num++ while (-d "version/$ts-$num");
    $ts = "$ts-$num";
}

# copy from most recent timestamp dir and catalog dest files
if (opendir DIR, 'version') {
    my @dirs = sort { $b <=> $a } grep { -d "version/$_" } readdir DIR;
    closedir DIR;
    my $rec = $dirs[0];
    $base = "version/$rec";
    File::Find::find({wanted => \&base}, "version/$rec") if (-d "version/$rec");
    foreach my $fil (keys %dest) {
        my $dir = $fil;
        $dir =~ s{/[^/]+$}{};
        mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
        cp "version/$rec/$fil", "version/$ts/$fil"
            or die "could not copy version/$rec/$fil to $ts: $!";
    }
}

my $var = substr($dirs[0],length($dirs[0])-1);


if ($var eq "/"){
	chop($dirs[0]);
}

# 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 "Found conflict for $file after resolutions\n"
        unless (@{$files{$file}} == 1);
#    print "cp $files{$file}[0]/$file\n";
    my $dir = $file;
    $dir =~ s{/[^/]+$}{};
    mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
    cp "$files{$file}[0]/$file", "version/$ts/$file"
            or die "could not copy $files{$file}[0]/$file to $ts: $!";
}

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

if (-d "version/$ts") {
    my $val = prompt('m', { prompt => "do you want link prod to $ts?",
                     title => 'symlink', items => ['quit', 'yes'],
                     cols => 1, display_base => 0 }, '', undef);
    if ($val) {
        unlink 'prod';
        symlink("version/$ts", 'prod');
    }
}

## subroutines

# File::Find wanted routines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    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/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $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



I am waiting for your reply.

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39811128
@wilcoxon: I made slight changes to the code and it works as expected except detecting the deleted files.

How can I do it by looking at the last created directory in the products (such as CodeS) directory?

Please see the last version on the script below:

use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath rmtree);

my @tmp = (localtime)[5,4,3];
$tmp[0] += 1900;
$tmp[1]++;
my $ts = join '', @tmp;
@tmp = ();

## 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 = '.';
#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{^(?:version|prod|\.+)$}o } readdir DIR;
#my @dirs = grep { exists $chk{$_} } @alldirs;
push(my @dirs, $ARGV[0]);
closedir DIR;
die "Usage: $0 prod_dirs\n e.g release2Production.pl Coding-Standards/rel1.3/\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

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

# check for ts dir existence
if (-d 'version' and -d "version/$ts") {
    my $num = 2;
    $num++ while (-d "version/$ts-$num");
    $ts = "$ts-$num";
}

# copy from most recent timestamp dir and catalog dest files
if (opendir DIR, 'version') {
    my @dirs = sort { $b <=> $a } grep { -d "version/$_" } readdir DIR;
    closedir DIR;
    my $rec = $dirs[0];
    $base = "version/$rec";
    File::Find::find({wanted => \&base}, "version/$rec") if (-d "version/$rec");
    foreach my $fil (keys %dest) {
        my $dir = $fil;
        $dir =~ s{/[^/]+$}{};
        mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
        cp "version/$rec/$fil", "version/$ts/$fil"
            or die "could not copy version/$rec/$fil to $ts: $!";
    }
}

my $var = substr($dirs[0],length($dirs[0])-1);


if ($var eq "/"){
	chop($dirs[0]);
}

# 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);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
} else {
    my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
                     items => ['quit', 'no conflicts - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
}

## 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 "Found conflict for $file after resolutions\n"
        unless (@{$files{$file}} == 1);
#    print "cp $files{$file}[0]/$file\n";
    my $dir = $file;
    $dir =~ s{/[^/]+$}{};
    mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
    cp "$files{$file}[0]/$file", "version/$ts/$file"
            or die "could not copy $files{$file}[0]/$file to $ts: $!";
}

# 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 => ['do not delete', 'delete - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if ($val){
		foreach my $fil (@del) {
			unlink $fil or die "could not delete $fil: $!";
		}
	}
}

if (-d "version/$ts") {
    my $val = prompt('m', { prompt => "do you want link prod to $ts?",
                     title => 'symlink', items => ['quit', 'yes'],
                     cols => 1, display_base => 0 }, '', undef);
    if ($val) {
        unlink 'prod';
        symlink("version/$ts", 'prod');
    }
}

## subroutines

# File::Find wanted routines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    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/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $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
 

Author Comment

by:Tolgar
ID: 39811321
@wilcoxon: I finally solved the issues I mentioned earlier.

This is the code I ended up with:

use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath rmtree);

my @tmp = (localtime)[5,4,3];
$tmp[0] += 1900;
$tmp[1]++;
my $ts = join '', @tmp;
@tmp = ();

## 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 = '.';
#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{^(?:version|prod|\.+)$}o } readdir DIR;
#my @dirs = grep { exists $chk{$_} } @alldirs;
push(my @dirs, $ARGV[0]);
closedir DIR;
die "Usage: $0 prod_dirs\n e.g release2Production.pl Coding-Standards/rel1.3/\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

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

# check for ts dir existence
if (-d 'version' and -d "version/$ts") {
    my $num = 2;
    $num++ while (-d "version/$ts$num");
    $ts = $ts.$num;
}

# copy from most recent timestamp dir and catalog dest files
if (opendir DIR, 'version') {
    #my @dirs = sort { $a <=> $b } grep { -d "version/$_" } readdir DIR;
	
	#ignore anything that is not a number
	my @dirs = sort {
                        (my $x = $a) =~ s/\D//g;
                        (my $y = $b) =~ s/\D//g;
                        ($x?$x:0) <=> ($y?$y:0)
                    } readdir DIR;
	
    closedir DIR;
    my $rec = $dirs[-1];
    $base = "version/$rec";
    File::Find::find({wanted => \&base}, "version/$rec") if (-d "version/$rec");
    foreach my $fil (keys %dest) {
        my $dir = $fil;
        $dir =~ s{/[^/]+$}{};
        mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
        cp "version/$rec/$fil", "version/$ts/$fil"
            or die "could not copy version/$rec/$fil to $ts: $!";
    }
}

#remove "/" from the command if it ends with "/"
my $var = substr($dirs[0],length($dirs[0])-1);
if ($var eq "/"){
	chop($dirs[0]);
}

# 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);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
} else {
    my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
                     items => ['quit', 'no conflicts - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
}

## 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 "Found conflict for $file after resolutions\n"
        unless (@{$files{$file}} == 1);
#    print "cp $files{$file}[0]/$file\n";
    my $dir = $file;
    $dir =~ s{/[^/]+$}{};
    mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
    cp "$files{$file}[0]/$file", "version/$ts/$file"
            or die "could not copy $files{$file}[0]/$file to $ts: $!";
}

# check for files to delete
my (%all_files, @del);
foreach my $dir (@alldirs) {

	#find the newest created directory in the product folder ($dir)
	opendir( DATA_DIR, $dir) || die "Cannot open $dir\n";

	#my @versions = sort { $a <=> $b } grep { -d "$dir/$_"} readdir(DATA_DIR);
	
	#ignore anything that is not a number
	my @versions = sort {
                        (my $x = $a) =~ s/\D//g;
                        (my $y = $b) =~ s/\D//g;
                        ($x?$x:0) <=> ($y?$y:0)
                    } readdir DATA_DIR;
	
    closedir DATA_DIR;
	my $latest_dir = $versions[-1];

    $dir = "$dir/$latest_dir";
	$base = $dir;
    File::Find::find({wanted => \&full_list}, $dir);
}

foreach my $fil (sort keys %dest) {
    push @del, "version/$ts/$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 => ['do not delete', 'delete - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if ($val){
		foreach my $fil (@del) {
			unlink $fil or die "could not delete $fil: $! \n";
			print "Deleted $fil \n";
		}
	} else{
		print "The files were not deleted. \n";
	}
}

if (-d "version/$ts") {
    my $val = prompt('m', { prompt => "do you want link prod to $ts?",
                     title => 'symlink', items => ['quit', 'yes'],
                     cols => 1, display_base => 0 }, '', undef);
    if ($val) {
        unlink 'prod';
        symlink("version/$ts", 'prod');
    } else{
		exit;
	}
}

## subroutines

# File::Find wanted routines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    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/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $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


Thanks,
0
 

Author Comment

by:Tolgar
ID: 39813625
@wilcoxon: This is the final code that I have and it works as expected.

But, I am having hard time to read some part of it.

Can you please put some more comments especially for the "base", "search" and "full_list" subroutines? (and this type of line: my $name = $File::Find::name;)

I would appreciate if you could add more comment in general.

Thanks,

#!/usr/local/apps/bat/latest/bin/perl
use strict;
use warnings;
use File::Find;
use File::Path qw(mkpath rmtree);

my @tmp = (localtime)[5,4,3];
$tmp[0] += 1900;
$tmp[1]++;
my $ts = join '', @tmp;
@tmp = ();

## 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 = '.';
opendir DIR, '.' or die "could not open $dir: $!";
my @alldirs = grep { -d $_ and $_ !~ m{^(?:version|prod|\.+)$}o } readdir DIR;
push(my @dirs, $ARGV[0]);
closedir DIR;
die "Usage: $0 prod_dirs\n e.g release2Production.pl Coding-Standards/1.3/\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";


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

# check for ts dir existence
if (-d 'version' and -d "version/$ts") {
    my $num = 2;
    $num++ while (-d "version/$ts$num");
    $ts = $ts.$num;
}

# copy from most recent timestamp dir and catalog dest files
if (opendir DIR, 'version') {
	#ignore anything that is not a number while sorting
	my @dirs = sort {
                        (my $x = $a) =~ s/\D//g;
                        (my $y = $b) =~ s/\D//g;
                        ($x?$x:0) <=> ($y?$y:0)
                    } readdir DIR;
	
    closedir DIR;
    my $rec = $dirs[-1];
    $base = "version/$rec";
    File::Find::find({wanted => \&base}, "version/$rec") if (-d "version/$rec");
    foreach my $fil (keys %dest) {
        my $dir = $fil;
        $dir =~ s{/[^/]+$}{};
        mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
        `cp -r "version/$rec/$fil" "version/$ts/$fil"`
    }
}

#remove "/" from the command if it ends with "/"
my $var = substr($dirs[0],length($dirs[0])-1);
if ($var eq "/"){
	chop($dirs[0]);
}

# 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);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
} else {
    my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
                     items => ['quit', 'no conflicts - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
}

# copy files
foreach my $file (keys %files) {
    die "Found conflict for $file after resolutions\n"
        unless (@{$files{$file}} == 1);
#    print "cp $files{$file}[0]/$file\n";
    my $dir = $file;
    $dir =~ s{/[^/]+$}{};
    mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
    `cp "$files{$file}[0]/$file" "version/$ts/$file"`
}

# check for files to delete
my (%all_files, @del);
foreach my $dir (@alldirs) {

	#find the newest created directory in the product folder ($dir)
	opendir( DATA_DIR, $dir) || die "Cannot open $dir\n";
	
	#ignore anything that is not a number while sorting
	my @versions = sort {
                        (my $x = $a) =~ s/\D//g;
                        (my $y = $b) =~ s/\D//g;
                        ($x?$x:0) <=> ($y?$y:0)
                    } readdir DATA_DIR;
	
    closedir DATA_DIR;
	my $latest_dir = $versions[-1];

    $dir = "$dir/$latest_dir";
	$base = $dir;
    File::Find::find({wanted => \&full_list}, $dir);
}

foreach my $fil (sort keys %dest) {
    push @del, "version/$ts/$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 => ['do not delete', 'delete - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if ($val){
		foreach my $fil (@del) {
			unlink $fil or die "could not delete $fil: $! \n";
			print "Deleted $fil \n";
		}
	} else{
		print "The files were not deleted. \n";
	}
}

if (-d "version/$ts") {
    my $val = prompt('m', { prompt => "do you want link prod to $ts?",
                     title => 'symlink', items => ['quit', 'yes'],
                     cols => 1, display_base => 0 }, '', undef);
    if ($val) {
        unlink 'prod';
        symlink("version/$ts", 'prod');
    } else{
		exit;
	}
}

## subroutines

# File::Find wanted routines

sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $dest{$name}++;
}

sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    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/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $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
 
LVL 26

Expert Comment

by:wilcoxon
ID: 39813654
Sorry.  Things have continued to be really busy.

Glad you were able to figure it out.  Deleted files are now working as well?

Sure - I'll add some more comments when I have some time.

For the specifics you were asking about (&base, &search, &full_list, and $name=$File::Find::name), they are all related to File::Find.  The perldoc for that module should explain them.
0
 

Author Comment

by:Tolgar
ID: 39816544
@wilcoxon: The delete functionality also works. I really appreciate your help.

Can you please put some more comments to the code tonight, if possible?

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39823074
Hi Wilcoxon,
Thank you for all your replies to this question.

I will closing this question but I have another follow-up 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
 

Author Comment

by:Tolgar
ID: 39823081
Hi Wilcoxon,
Can you please let me know if you could help me with my new questions before Wednesday?

Thanks,
0
 
LVL 26

Expert Comment

by:wilcoxon
ID: 39823152
Sure.  I'll add comments to the code for this question on Saturday and then take a look at the new question.  I'm not sure if I'll have time to do the code changes for the new question on Saturday or not.
0
 

Author Comment

by:Tolgar
ID: 39823179
Thanks. I appreciate your help.
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 26

Accepted Solution

by:
wilcoxon earned 500 total points
ID: 39827037
Commented...  Let me know if you want more comments and in which sections...
#!/usr/local/apps/bat/latest/bin/perl
use strict;
use warnings;
use File::Find;
use File::Path qw(mkpath rmtree);

# get the current timestamp/date
my @tmp = (localtime)[5,4,3];
$tmp[0] += 1900;
$tmp[1]++;
my $ts = join '', @tmp;
@tmp = ();

## XXX - 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 ($$$$;@);
## XXX - End Term::Prompt

my $dir = '.';
opendir DIR, '.' or die "could not open $dir: $!";
my @alldirs = grep { -d $_ and $_ !~ m{^(?:version|prod|\.+)$}o } readdir DIR;
push(my @dirs, $ARGV[0]);
closedir DIR;
die "Usage: $0 prod_dirs\n e.g release2Production.pl Coding-Standards/1.3/\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";

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

# check for ts dir existence
if (-d 'version' and -d "version/$ts") {
    my $num = 2;
    $num++ while (-d "version/$ts$num");
    $ts = $ts.$num;
}

# copy from most recent timestamp dir and catalog dest files
if (opendir DIR, 'version') {
	# ignore anything that is not a number while sorting
	my @dirs = sort {
                        (my $x = $a) =~ s/\D//g;
                        (my $y = $b) =~ s/\D//g;
                        ($x?$x:0) <=> ($y?$y:0)
                    } readdir DIR;
	
    closedir DIR;
    my $rec = $dirs[-1];
    $base = "version/$rec";
    # put files under version into %dest
    File::Find::find({wanted => \&base}, "version/$rec") if (-d "version/$rec");
    # loop over hash
    # XXX - you should be able to do this using cp (and not have to shell out)
    foreach my $fil (keys %dest) {
        my $dir = $fil;
        $dir =~ s{/[^/]+$}{};
        mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
        `cp -r "version/$rec/$fil" "version/$ts/$fil"`
    }
}

# remove "/" from the command if it ends with "/"
my $var = substr($dirs[0],length($dirs[0])-1);
if ($var eq "/"){
	chop($dirs[0]);
}

# 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);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
} else {
    my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
                     items => ['quit', 'no conflicts - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if (!$val){
		system("rm -rf version/$ts/");
		exit;
	}
}

# copy files
foreach my $file (keys %files) {
    die "Found conflict for $file after resolutions\n"
        unless (@{$files{$file}} == 1);
#    print "cp $files{$file}[0]/$file\n";
    my $dir = $file;
    $dir =~ s{/[^/]+$}{};
    mkpath("version/$ts/$dir") unless (-d "version/$ts/$dir");
    cp "$files{$file}[0]/$file", "version/$ts/$file"
        or die "could not copy $file from $files{$file}[0]: $!";
}

# check for files to delete
my (%all_files, @del);
foreach my $dir (@alldirs) {

	# find the newest created directory in the product folder ($dir)
	opendir DATA_DIR, $dir or die "Cannot open $dir\n";
	
	# ignore anything that is not a number while sorting
	my @versions = sort {
                        (my $x = $a) =~ s/\D//g;
                        (my $y = $b) =~ s/\D//g;
                        ($x?$x:0) <=> ($y?$y:0)
                    } readdir DATA_DIR;

    closedir DATA_DIR;
	my $latest_dir = $versions[-1];

    $dir = "$dir/$latest_dir";
	$base = $dir;
    File::Find::find({wanted => \&full_list}, $dir);
}

foreach my $fil (sort keys %dest) {
    push @del, "version/$ts/$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 => ['do not delete', 'delete - continue'], cols => 1,
                     display_base => 0 }, '', undef);
    if ($val){
		foreach my $fil (@del) {
			unlink $fil or die "could not delete $fil: $! \n";
			print "Deleted $fil \n";
		}
	} else{
		print "The files were not deleted. \n";
	}
}

if (-d "version/$ts") {
    my $val = prompt('m', { prompt => "do you want link prod to $ts?",
                     title => 'symlink', items => ['quit', 'yes'],
                     cols => 1, display_base => 0 }, '', undef);
    if ($val) {
        unlink 'prod';
        symlink("version/$ts", 'prod');
    } else{
		exit;
	}
}

## subroutines

## File::Find wanted routines

# File::Find::name = name found during File::Find call

# populate %dest from File::Find
sub base {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $dest{$name}++;
}

# populate %files and %multi based on File::Find call
sub search {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    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;
    }
}

# populate %all_files based on File::Find call
sub full_list {
    return unless -f $_;
    my $name = $File::Find::name;
    $name =~ s{^$base/}{};
    return unless ($name =~ m{^(?:bin|lib)/});
    $all_files{$name}++;
}

## XXX - 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
 

Author Comment

by:Tolgar
ID: 39827196
Hi Wilcoxon,
Will you be able to look at my other question? The code is a little bit different than this one. So, it would be great if you could make changes on top of my version in my last post?

Thanks,
0
 
LVL 26

Expert Comment

by:wilcoxon
ID: 39827742
I'll try.  I ran out of time yesterday and am not sure how busy this week will be overall.
0
 

Author Comment

by:Tolgar
ID: 39828126
ok. Thanks. I will wait for your reply.
0
 

Author Comment

by:Tolgar
ID: 39832822
@wilcoxon: any news about my last post?
0
 

Author Comment

by:Tolgar
ID: 39839336
@wilcoxon: Do you think you can take a look at my other open question on Friday or Saturday?

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39843798
@wilcoxon: any news?
0
 

Author Comment

by:Tolgar
ID: 39845032
@wilcoxon: do you think you can take a look at my last post this weekend?

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39845757
@wilcoxon: I marked my last post as "need attention" but no one has commented on it yet. Do you think you will be able to take a look at it?
0
 

Author Comment

by:Tolgar
ID: 39850649
@wilcoxon: I think my last question was sent to the experts but I haven't heard from them yet. Since they are not familiar with the code, the question might have looked scary.

Can you please let me know if you will be able to take look at it?

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39857244
Hi Wilcoxon,
I wonder if you are around?

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39867594
@wilcoxon: I feel like you are not going to respond to my last post. Am I right? If this is the case, I will look for other options to resolve the issue. Please let me know.

Thanks,
0
 
LVL 26

Expert Comment

by:wilcoxon
ID: 39875914
Sorry.  I honestly intend to look at it.  However, things have continued being really busy.  I may have time to look at it this Saturday (but I can't guarantee it).  I'm surprised nobody else has taken a stab at it (beyond suggesting rsync).
0
 

Author Comment

by:Tolgar
ID: 39875928
Thanks wilcoxon.

I solved the symlink change.

But the other one is still unresolved. I would appreciate if you could take a look at it.

Thanks,
0
 

Author Comment

by:Tolgar
ID: 39880663
Hi Wilcoxon,
Do you think you will be able to take a look at my question? An admin sent me a comment that I need to close my question and re-open another one due to no response.

If you won't be able to take a look at it, I will do it but I prefer you take this question.

Thanks,
0
 
LVL 26

Expert Comment

by:wilcoxon
ID: 39952136
Sorry I never got a chance to look at your new question - it's been a really busy few months for me.  I see you have now deleted the question.  I hope you were able to figure out the remaining issue on your own.
0
 

Author Comment

by:Tolgar
ID: 39952154
Thanks Wilcoxon. I figured it out. I also appreciate your help.
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Many time we need to work with multiple files all together. If its windows system then we can use some GUI based editor to accomplish our task. But what if you are on putty or have only CLI(Command Line Interface) as an option to  edit your files. I…
I have been pestered over the years to produce and distribute regular data extracts, and often the request have explicitly requested the data be emailed as an Excel attachement; specifically Excel, as it appears: CSV files confuse (no Red or Green h…
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now