"John W. Krahn" <jwkr...@shaw.ca> writes:
[...]
> Much simpler as:
>
> for ( my $i = 0; $i <= $#ar1; $i += 3 ) {
> dispt( $r1name, @ar1[ $i .. $i + 2 ] );
> }
Trying to make use of you suggestions. And has resulted in a much
tidier script. I may have tortured you examples beyond recognition,
and have run into a problem, getting the iterations to happen after
Lettered choices.
I'd like to be able to use the Lettered choices with a number too, but
see no way other than taking user input at those choices.
Is there a way to input NUMBER LETTER where the Number is not known in
advance?
In the example here... I've just taken more user input at the Lettered
choices.
The trouble I'm seeing is how to make an iteration happen after one of
the lettered choicse (A or N are the examples here).
At `A', I used `return' but that doesn't iterate through the next
incoming batch of names.
At `N', I used `last' which appears to have the desired effect but
throws a warning about using `last' to quit a subroutine.
(Note, I'd rather (At `A' and `N' have a single step, inputting
NUMBER,LETTER in one move, but not seeing how I could do that since
The number is unknown)
`L' isn't expected to iterate.
I changed `c' and `q' a bit too. Not because I wanted it different
other than I wanted to print something there.
It seemed if I wanted to print something at those choices (c q), then
a different syntax was required... And with printing involved, `next'
doesn't work there. Or in some way I botched it up. Anyway, used
`last' there too (at `c').
In summary:
1) I'd like to see how to make choices `A' and `N' be a one step
process by user entering both NUMBER and LETTER at once, or some
other way, get around needing to prompt user again.
2) Should I just dampen warnings at `A' and `N', and use `last' or is
there a more appropriate way to handle that?
------- --------- ---=--- --------- --------
#!/usr/local/bin/perl
use strict;
use warnings;
## These names ARE meaningless. could as well be foo, bar etc
## They represent filanems from specific directory (r2)
my @ar1 =qw(
r2one
r2two
r2three
r2four
r2five
r2six
r2seven
r2eight
r2nine
r2ten
r2eleven
r2twelve
);
## This name represents a file from a different directory.
my $r1name = "r1fname";
for ( my $i = 0; $i <= $#ar1; $i += 3 ) {
dispt( $r1name, @ar1[ $i .. $i + 2 ] );
}
## dispatch table to handle file names
sub dispt {
## This element will never be acted on. It is for display
## and comparison only
my ($r1name, @h ) = @_;
print "$r1name\n----- -----\n";
## creating an array containing this printed section
## to be used to redisplay current list.
push my @relist, sprintf "$r1name\n----- -----\n";
for my $key ( 0 .. $#h ) {
printf "%2d %s\n", $key + 1, $h[ $key ];
push @relist, sprintf "%2d %s\n", $key + 1, $h[ $key ];
}
print "----- -----\n";
push @relist, sprintf "----- -----\n";
## Users choice
my $chosen;
my %hash = (
A => sub { print "Which file number > ";
chomp($chosen = <STDIN>);
if ( $chosen =~ /\A\d+\z/ && $chosen >= 1 && $chosen <= @h )
{
print "Taking action A on $h[$chosen - 1]\n";
}
return;
},
N => sub { print "Which file number > ";
chomp($chosen = <STDIN>);
if ( $chosen =~ /\A\d+\z/ && $chosen >= 1 && $chosen <= @h )
{
print "Taking action N on $h[$chosen - 1]\n";
}
last;
},
L => sub { print relist(@relist); },
error => sub { print "invalid choice\n" }
);
my $exit_str = "\nAborted by user..\n";
my $con_str = "\nContinuing... no action taken\n";
while ( 1 ) {
print <<'PROMPT';
press a file number for the default action
press A to test this dispatch table
press N to test this dispatch table
press L to redisplay the list
press c to continue (no action taken)
press q to Exit (abort completely)
PROMPT
## Take in users choice
chomp(my $chosen = <STDIN>);
if ($chosen eq 'q') { print $exit_str; exit 0; }
if ($chosen eq 'c'){print $con_str; last; };
if ( $chosen =~ /\A\d+\z/ && $chosen >= 1 && $chosen <= @h ) {
print "Taking some default action on $h[$chosen - 1]\n";
last;
}
else {
my $code = $hash{ $chosen } || $hash{ error };
$code->();
}
}
## For redisplay of current file list
sub relist {
for (@_) {
print $_;
}
print "Relisting only, no action taken\n";
return;
}
}
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
