Solved

Why do I get warning about text wrap in Perl?

Posted on 2014-01-07
7
229 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
  • 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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 300 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 200 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

A year or so back I was asked to have a play with MongoDB; within half an hour I had downloaded (http://www.mongodb.org/downloads),  installed and started the daemon, and had a console window open. After an hour or two of playing at the command …
In the distant past (last year) I hacked together a little toy that would allow a couple of Manager types to query, preview, and extract data from a number of MongoDB instances, to their tool of choice: Excel (http://dilbert.com/strips/comic/2007-08…
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…
Along with being a a promotional video for my three-day Annielytics Dashboard Seminor, this Micro Tutorial is an intro to Google Analytics API data.

863 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

25 Experts available now in Live!

Get 1:1 Help Now