Tolgar
asked on
Why do I get warning about text wrap in Perl?
Hi,
I have the following script and I am getting a warning when I run this script. (the main functionality of this script is to copy files between folders by checking the conflicts.)
The command that run is:
The warning that I get is:
The script is in here:
How can I fix this warning?
I have the following script and I am getting a warning when I run this script. (the main functionality of this script is to copy files between folders by checking the conflicts.)
The command that run is:
perl release2Production.pl . rel1.3The warning that I get is:
Name "Text::Wrap::Columns" used only once: possible typo at release2Production.pl line 392.The script is in here:
use strict;
use warnings;
use File::Copy qw(cp);
use File::Find;
use File::Path qw(mkpath);
## taken from Term::Prompt
use Carp;
use Text::Wrap;
use Term::ReadKey qw (GetTerminalSize ReadMode);
our $DEBUG = 0;
our $MULTILINE_INDENT = "\t";
my %menu = (
order => 'down',
return_base => 0,
display_base => 1,
accept_multiple_selections => 0,
accept_empty_selection => 0,
title => '',
prompt => '>',
separator => '[^0-9]+',
ignore_whitespace => 0,
ignore_empties => 0
);
sub prompt ($$$$;@);
# End Term::Prompt
my $dir = shift or die "Usage: $0 base_dir prod_dirs\n";
my %chk = map { $_ => 1 } @ARGV;
chdir $dir or die "could not cd to $dir: $!";
opendir DIR, '.' or die "could not open $dir: $!";
my @dirs = grep { -d $_ and exists($chk{$_}) and $_ !~ m{^(?:bin|lib|\.+)$}o }
readdir DIR;
closedir DIR;
die "Usage: $0 base_dir prod_dirs\n e.g release2Production.pl . rel1.3\n" unless @dirs;
print "base dir $dir\n";
print "checking @dirs...\n";
my ($base, %files, %multi, %dest);
foreach my $dir (qw(bin lib)) {
File::Find::find({wanted => \&base}, $dir) if (-d $dir);
}
foreach my $dir (sort @dirs) {
$base = $dir;
File::Find::find({wanted => \&search}, $base);
}
if (%multi) {
foreach my $file (sort keys %multi) {
if (@{$files{$file}} > 2 or $files{$file}[0] ne '.') {
warn "unresolvable conflicts found between products for $file:\n"
. join ("\n", @{$files{$file}}) . "\n";
}
print "$file:\t", join("\t", @{$files{$file}}), "\n";
$files{$file} = [$files{$file}[($files{$file}[0] eq '.') ? 1 : 0]];
}
my $val = prompt('m', { prompt => 'what to do?', title => 'conflicts',
items => ['quit', 'conflicts - continue'], cols => 1,
display_base => 0 }, '', undef);
exit unless $val;
} else {
my $val = prompt('m', { prompt => 'what to do?', title => 'no conflicts',
items => ['quit', 'no conflicts - continue'], cols => 1,
display_base => 0 }, '', undef);
exit unless $val;
}
foreach my $file (keys %files) {
die "woa!! found conflict for $file after resolutions\n"
unless (@{$files{$file}} == 1);
# print "cp $files{$file}[0]/$file\n";
my $dir = $file;
$dir =~ s{/[^/]+$}{};
mkpath($dir) unless (-d $dir);
cp "$files{$file}[0]/$file", $file
or die "could not copy $files{$file}[0]/$file: $!";
}
sub base {
return unless -f $_;
my $name = $File::Find::name;
$dest{$name}++;
}
sub search {
return unless -f $_;
my $name = $File::Find::name;
$name =~ s{^$base/}{};
if (exists $files{$name}) {
$multi{$name}++;
push @{$files{$name}}, $base;
} elsif (exists $dest{$name}) {
$multi{$name}++;
push @{$files{$name}}, '.', $base;
} else {
push @{$files{$name}}, $base;
}
}
# BEGIN main part of Term::Prompt
# Preloaded methods go here.
sub prompt ($$$$;@) {
my($mopt, $prompt, $prompt_options, $default, @things) =
('','','',undef,());
my($repl, $match_options, $case, $low, $high, $before, $regexp, $coderef) =
('','','','','','','','');
my $prompt_full = '';
# Figure out just what we are doing here
$mopt = $_[0];
print "mopt is: $mopt\n" if $DEBUG;
# check the size of the match option, it should just have one char.
if (length($mopt) == 1
or $mopt =~ /\-n/i
or $mopt =~ /\+-n/i) {
my $dummy = 'mopt is ok';
} else {
croak "Illegal call of prompt; $mopt is more than one character; stopped";
}
my $type = 0;
my $menu = 0;
my $legal = 0;
my $range = 0;
my $expr = 0;
my $code = 0;
my $yn = 0;
my $uc = 0;
my $passwd = 0;
if ($mopt ne lc($mopt)) {
$uc = 1;
$mopt = lc($mopt);
}
if ($mopt eq 'm') {
($mopt, $prompt, $prompt_options, $default) = @_;
$menu = 1;
} else {
croak "prompt type $mopt not recognized";
}
my $ok = 0;
$mopt = lc($mopt);
while (1) {
if ($menu) {
## We're working on a menu
@menu{sort keys %{$prompt}} = @{$prompt}{sort keys %{$prompt}};
$prompt_full = "$menu{'prompt'} ";
my @menu_items = @{$menu{'items'}};
my $number_menu_items = scalar(@menu_items);
$menu{'low'} = $menu{'display_base'};
$menu{'high'} = $number_menu_items+$menu{'display_base'}-1;
my $digits_in_menu_item = (int(log($menu{'high'})/log(10)) + 1);
my $entry_length = 0;
my $item_length = 0;
for (@menu_items) {
$entry_length = length($_)
if length($_) > $entry_length;
}
$item_length = $entry_length;
$entry_length += ( $digits_in_menu_item ## Max number of digits in a selection
+
3 ## two for ') ', at least one for a column separator
);
my $gw = get_width();
my $num_cols = (defined($menu{'cols'})
? $menu{'cols'}
: int($gw/$entry_length));
$num_cols ||= 1; # Could be zero if longest entry in a
# list is wider than the screen
my $num_rows = (defined($menu{'rows'})
? $menu{'rows'}
: int($number_menu_items/$num_cols)+1) ;
my $data_fmt = "%${digits_in_menu_item}d) %-${item_length}.${item_length}s";
my $column_end_fmt = ("%s ");
my $line_end_fmt = ("%s\n");
my @menu_out = ();
my $row = 0;
my $col = 0;
my $idx = 0;
if ($menu{order} =~ /ACROSS/i) {
ACROSS_LOOP:
for ($row = 0; $row < $num_rows; $row++) {
for ($col = 0; $col < $num_cols; $col++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last ACROSS_LOOP
if $idx eq scalar(@menu_items);
}
}
} else {
DOWN_LOOP:
for ($col = 0; $col < $num_cols; $col++) {
for ($row = 0; $row < $num_rows; $row++) {
$menu_out[$row][$col] = sprintf($data_fmt,$idx+$menu{'display_base'},$menu_items[$idx++]);
last DOWN_LOOP
if $idx eq scalar(@menu_items);
}
}
}
if (length($menu{'title'})) {
print $menu{'title'},"\n",'-' x length($menu{'title'}),"\n";
}
for ($row = 0;$row < $num_rows;$row++) {
for ($col = 0;$col < $num_cols-1;$col++) {
printf($column_end_fmt,$menu_out[$row][$col])
if defined($menu_out[$row][$col]);
}
if (defined($menu_out[$row][$num_cols-1])) {
printf($line_end_fmt,$menu_out[$row][$num_cols-1])
} else {
print "\n";
}
}
if ($number_menu_items != ($num_rows)*($num_cols)) {
print "\n";
}
unless (defined($prompt_options) && length($prompt_options)) {
$prompt_options = "$menu{'low'} - $menu{'high'}";
if ($menu{'accept_multiple_selections'}) {
$prompt_options .= ', separate multiple entries with spaces';
}
}
}
unless ($before || $uc || ($prompt_options eq '')) {
$prompt_full .= "($prompt_options) ";
}
if (defined($default) and $default ne '') {
$prompt_full .= "[default $default] ";
}
print termwrap($prompt_full);
my $old_divide = undef;
if (defined($/)) {
$old_divide = $/;
}
$/ = "\n";
ReadMode('noecho') if($passwd);
$repl = scalar(readline(*STDIN));
ReadMode('restore') if($passwd);
if (defined($old_divide)) {
$/ = $old_divide;
} else {
undef($/);
}
chomp($repl); # nuke the <CR>
$repl =~ s/^\s*//; # ignore leading white space
$repl =~ s/\s*$//; # ignore trailing white space
$repl = $default if $repl eq '';
print termwrap("Reply: '$repl'\n") if $DEBUG;
# Now here is where things get real interesting
my @menu_repl = ();
if ($menu) {
$ok = menuit(\@menu_repl, $repl, $DEBUG, $uc);
} else {
croak "No subroutine known for prompt type $mopt.";
}
if ($ok) {
if ($menu) {
if ($menu{'accept_multiple_selections'}) {
return (wantarray ? @menu_repl : \@menu_repl);
} else {
return $menu_repl[0];
}
}
} elsif (defined($prompt_options) && length($prompt_options)) {
if ($uc) {
print termwrap("$prompt_options\n");
} else {
if (!$menu) {
print termwrap("Options are: $prompt_options\n");
}
$before = 1;
}
}
}
}
sub rangeit ($$$$ ) {
# this routine makes sure that the reply is within a given range
my($repl, $low, $high, $uc) = @_;
if ( $low <= $repl && $repl <= $high ) {
return 1;
} elsif (!$uc) {
print 'Invalid range value. ';
}
return 0;
}
sub menuit (\@$$$ ) {
my ($ra_repl, $repl, $dbg, $uc) = @_;
print "inside of menuit\n" if $dbg;
my @msgs = ();
## Parse for multiple values. Strip all whitespace if requested or
## just strip leading and trailing whitespace to avoid a being
## interpreted as separating empty choices.
if($menu{'ignore_whitespace'}) {
$repl =~ s/\s+//g;
} else {
$repl =~ s/^(?:\s+)//;
$repl =~ s/(?:\s+)$//;
}
my @repls = split(/$menu{'separator'}/,$repl);
if($menu{ignore_empties}) {
@repls = grep{length($_)} @repls;
}
## Validations
if ( scalar(@repls) > 1
&&
!$menu{'accept_multiple_selections'} ) {
push @msgs, 'Multiple choices not allowed.';
} elsif (!scalar(@repls)
&&
!$menu{'accept_empty_selection'}) {
push @msgs, 'You must make a selection.';
} else {
for (@repls) {
if ( !rangeit($_,$menu{'low'},$menu{'high'},1)) {
push @msgs, "$_ is an invalid choice.";
}
}
}
## Print errors or return values
if (scalar(@msgs)) {
print "\n",join("\n",@msgs),"\n\n";
return 0;
} else {
@{$ra_repl} = map {$_ - $menu{'display_base'} + $menu{'return_base'}} @repls;
return 1;
}
}
sub termwrap ($;@) {
my($message) = '';
if ($#_ > 0) {
if (defined($,)) {
$message = join($,,@_);
} else {
$message = join(' ',@_);
}
} else {
$message = $_[0];
}
my $width = get_width();
if (defined($width) && $width) {
$Text::Wrap::Columns = $width;
}
if ($message =~ m/\n\Z/) {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z/\n/;
return $message;
} else {
$message = wrap('', $MULTILINE_INDENT, $message);
$message =~ s/\n*\Z//;
return $message;
}
}
sub get_width {
## The 'use strict' added above caused the calls
## GetTerminalSize(STDOUT) and GetTerminalSize(STDERR) to fail in
## compilation. The fix as to REMOVE the parens. It seems as if
## this call works the same way as 'print' - if you need to
## specify the filehandle, you don't use parens (and don't put a
## comma after the filehandle, although that is irrelevant here.)
## SO DON'T PUT THEM BACK! :-)
my($width) = eval {
local($SIG{__DIE__});
(GetTerminalSize(select))[0];
} || eval {
if (-T STDOUT) {
local($SIG{__DIE__});
return (GetTerminalSize STDOUT )[0];
} else {
return 0;
}
} || eval {
if (-T STDERR) {
local($SIG{__DIE__});
return (GetTerminalSize STDERR )[0];
} else {
return 0;
}
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDOUT )[0];
} || eval {
local($SIG{__DIE__});
(GetTerminalSize STDERR )[0];
};
return $width;
}How can I fix this warning?
ASKER
I am not sure if this is the best approach.
Do you know the cause of this warning? I would prefer to fix it rather than hiding it.
Thanks,
Do you know the cause of this warning? I would prefer to fix it rather than hiding it.
Thanks,
Some more info:
whet you set the var $Text::Wrap::Columns in line 392:
$Text::Wrap::Columns = $width;
it is clear, that you set a parameter for the modude Text::Wrap.
You don't use the variable $Text::Wrap::Columns in your own code.
The module warnings does not know, that this variable is used in another module, so it outputs the warning as it seems, that you set a variable which you never use.
Oli
whet you set the var $Text::Wrap::Columns in line 392:
$Text::Wrap::Columns = $width;
it is clear, that you set a parameter for the modude Text::Wrap.
You don't use the variable $Text::Wrap::Columns in your own code.
The module warnings does not know, that this variable is used in another module, so it outputs the warning as it seems, that you set a variable which you never use.
Oli
You can dummy use the variable, e.g. in a new line directly after it:
$width = $Text::Wrap::Columns;
Oli
$width = $Text::Wrap::Columns;
Oli
The best way is propably to add:
before line 392
Oli
no warnings qw(once);before line 392
Oli
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
use warnings;
When you finished development, you do not need the aditional warnings you get with this.
Oli