?
Solved

Why do I get warning about text wrap in Perl?

Posted on 2014-01-07
7
Medium Priority
?
244 Views
Last Modified: 2014-01-07
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:

perl release2Production.pl . rel1.3

Open in new window


The warning that I get is:

Name "Text::Wrap::Columns" used only once: possible typo at release2Production.pl line 392.

Open in new window



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

Open in new window



How can I fix this warning?
0
Comment
Question by:Tolgar
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
7 Comments
 
LVL 9

Expert Comment

by:oheil
ID: 39762139
You can remove the line
use warnings;

When you finished development, you do not need the aditional warnings you get with this.

Oli
0
 

Author Comment

by:Tolgar
ID: 39762144
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,
0
 
LVL 9

Expert Comment

by:oheil
ID: 39762148
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
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 9

Expert Comment

by:oheil
ID: 39762151
You can dummy use the variable, e.g. in a new line directly after it:
$width = $Text::Wrap::Columns;

Oli
0
 
LVL 9

Expert Comment

by:oheil
ID: 39762176
The best way is propably to add:

no warnings qw(once);

Open in new window


before line 392

Oli
0
 
LVL 26

Accepted Solution

by:
wilcoxon earned 1200 total points
ID: 39762177
You can even add something unused and the warning will go away.  I usually add something like:
print $Text::Wrap::Columns if 0; # dummy line to get rid of warning

Open in new window

just after the line causing the warning
0
 
LVL 9

Assisted Solution

by:oheil
oheil earned 800 total points
ID: 39762184
Or add somewhere at the beginning, but after line 9 use Text::Wrap  :

use vars qw($Text::Wrap::Columns);

Open in new window


Oli
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I've just discovered very important differences between Windows an Unix formats in Perl,at least 5.xx.. MOST IMPORTANT: Use Unix file format while saving Your script. otherwise it will have ^M s or smth likely weird in the EOL, Then DO NOT use m…
There are many situations when we need to display the data in sorted order. For example: Student details by name or by rank or by total marks etc. If you are working on data driven based projects then you will use sorting techniques very frequently.…
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…
Six Sigma Control Plans

718 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