Shell-POSIX-Select-0.09/0000755000175000000000000000000014454517773012456 5ustar rootShell-POSIX-Select-0.09/browse_images.plx.PL0000755000175000000000000000144714454516447016351 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/Changes0000755000175000000000000000317214454516447013754 0ustar rootRevision history for Perl extension Shell::POSIX::Select. 0.01 Sun May 4 00:47:26 PDT 2003 - original version; created by h2xs 1.21 with options '-XA -n Shell::POSIX::Select' 0.02 Mon May 5 11:07:55 PDT 2003 - fixed some typos and bugs in sample scripts - reworked documentation slightly - deleted some test programs, modified others - removed some debugging statements to simplify code - added vi:ts=2 sw=2: to dumped source code samples for readability 0.03 Mon May 5 17:51:54 PDT 2003 - fixed more typos in documentation - rearranged documentation slightly - added some diagnostics to test.pl 0.04 Thu May 8 10:34:49 PDT 2003 - enhanced "Failure to identify" section in docs - modified test.pl to omit screen dumps for comparison testing; seems that even with buffering disabled, order of STDERR vs STDOUT outputs is unpredictable, and causing tests to fail although everything actually works okay - removed disturbing messages from eval if killed by signal 0.05 Sun May 11 11:34:59 PDT 2003 - removed large chunks of commented-out code, no longer needed - dumbed-down the markup for SYNOPSIS in documentation, which the PAUSE version of pod2html was not handling correctly correctly. 0.06 Sat, 04 Feb 2017 13:38:36 GMT - no code changes; repackaged by Martin Thurn 0.07 2017-07-29 changes by Przemek Czerkas : - fixed module and test.pl suite to work on MSWin32 platform - explicit dependency on Text::Balanced 1.97 and Filter::Simple 0.84 - added more tests - refreshed documentation Shell-POSIX-Select-0.09/perl_man.00000755000175000000000000000076514454516447014344 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ; # Extract man-page names from the TOC portion of the output of "perldoc perl" select $manpage ( sort ( `perldoc perl` =~ /^\s+(perl\w+)\s/mg) ) { system "perldoc '$manpage'" ; } Shell-POSIX-Select-0.09/order.plx.PL0000755000175000000000000000144714454516447014636 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/pick_file.00000755000175000000000000000064614454516447014472 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( prompt => 'Pick File(s):' , style => 'Korn' # for automatic prompting ); select ( <*> ) { } Shell-POSIX-Select-0.09/long_listem.00000755000175000000000000000056314454516447015057 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ; select my $var (@ARGV) { system "ls -ldi '$var'" } Shell-POSIX-Select-0.09/perl_man.plx.PL0000755000175000000000000000144714454516447015320 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/delete_file.plx.PL0000755000175000000000000000144714454516447015764 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/Ref_Data/0000755000175000000000000000000014454517773014123 5ustar rootShell-POSIX-Select-0.09/Ref_Data/ourvar.cdump_ref0000755000175000000000000001435614454517566017343 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; our $var; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$var\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: print "Outside loop, var is $var\n"; Shell-POSIX-Select-0.09/Ref_Data/badvar.cdump_ref0000755000175000000000000001430314454517565017253 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1,2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$_\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/prompt.nested.cdump_ref0000755000175000000000000003070614454517566020624 0ustar root $Prompt='Custom Prompt for loop 1'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=( 1 ); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW $Prompt='Custom Prompt for loop 2'; LOOP2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #2 **** $Shell::POSIX::Select::DEBUG > 1 and 2 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP2: { # **** NEW SCOPE FOR SELECTLOOP #2 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=( 2 ); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[2], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[2] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[2]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[2]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[2] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[2]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP2; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 2 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[2-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP2\n"; $Eof=1; last _SEL_LOOP2; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[2] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW last LOOP2;; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #2 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #2 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #2 **** # vi:ts=2 sw=2: ; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/novar.cdump_ref0000755000175000000000000001430314454517565017141 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1,2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$_\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/sub2.cdump_ref0000755000175000000000000001446214454517566016676 0ustar root sub select_in_sub { # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=defined ((( caller 0 )[3]) and (( caller 0 )[3]) ne "") ? @_ : @ARGV ; local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$var\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: } @ARGV=1..3; select_in_sub qw(a b) ; Shell-POSIX-Select-0.09/Ref_Data/other_select1.cdump_ref0000755000175000000000000000062514454517565020557 0ustar root # Make sure that filehandle version of select doesn't get parsed as loopy one # select ('^d to exit') { } $old_fh = select (STDERR); $|=1; select ($old_fh); # select ('^d to exit') { } print STDOUT "STDOUT\n"; # Found during testing that I can't actually print output to both channels # and know the order in which the words will appear! Linux differs # from Solaris! # print STDERR "STDERR\n"; Shell-POSIX-Select-0.09/Ref_Data/loop_variable_names.cdump_ref0000755000175000000000000015704514454517565022030 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $m; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $m = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$m\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #2 **** $Shell::POSIX::Select::DEBUG > 1 and 2 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP2: { # **** NEW SCOPE FOR SELECTLOOP #2 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[2], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[2] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[2]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[2]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[2] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[2]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $a; # last Shell::POSIX::Select::_SEL_LOOP2; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 2 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[2-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP2\n"; $Eof=1; last _SEL_LOOP2; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[2] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $a = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$a\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #2 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #2 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #2 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #3 **** $Shell::POSIX::Select::DEBUG > 1 and 3 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP3: { # **** NEW SCOPE FOR SELECTLOOP #3 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[3], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[3] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[3]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[3]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[3] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[3]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $s; # last Shell::POSIX::Select::_SEL_LOOP3; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 3 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[3-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP3\n"; $Eof=1; last _SEL_LOOP3; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[3] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $s = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$s\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #3 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #3 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #3 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #4 **** $Shell::POSIX::Select::DEBUG > 1 and 4 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP4: { # **** NEW SCOPE FOR SELECTLOOP #4 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[4], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[4] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[4]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[4]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[4] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[4]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $y; # last Shell::POSIX::Select::_SEL_LOOP4; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 4 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[4-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP4\n"; $Eof=1; last _SEL_LOOP4; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[4] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $y = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$y\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #4 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #4 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #4 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #5 **** $Shell::POSIX::Select::DEBUG > 1 and 5 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP5: { # **** NEW SCOPE FOR SELECTLOOP #5 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[5], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[5] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[5]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[5]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[5] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[5]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $tr; # last Shell::POSIX::Select::_SEL_LOOP5; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 5 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[5-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP5\n"; $Eof=1; last _SEL_LOOP5; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[5] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $tr = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$tr\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #5 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #5 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #5 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #6 **** $Shell::POSIX::Select::DEBUG > 1 and 6 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP6: { # **** NEW SCOPE FOR SELECTLOOP #6 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[6], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[6] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[6]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[6]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[6] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[6]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $qq; # last Shell::POSIX::Select::_SEL_LOOP6; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 6 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[6-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP6\n"; $Eof=1; last _SEL_LOOP6; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[6] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $qq = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$qq\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #6 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #6 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #6 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #7 **** $Shell::POSIX::Select::DEBUG > 1 and 7 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP7: { # **** NEW SCOPE FOR SELECTLOOP #7 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[7], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[7] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[7]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[7]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[7] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[7]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $qw; # last Shell::POSIX::Select::_SEL_LOOP7; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 7 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[7-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP7\n"; $Eof=1; last _SEL_LOOP7; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[7] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $qw = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$qw\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #7 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #7 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #7 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #8 **** $Shell::POSIX::Select::DEBUG > 1 and 8 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP8: { # **** NEW SCOPE FOR SELECTLOOP #8 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[8], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[8] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[8]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[8]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[8] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[8]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $qr; # last Shell::POSIX::Select::_SEL_LOOP8; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 8 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[8-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP8\n"; $Eof=1; last _SEL_LOOP8; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[8] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $qr = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$qr\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #8 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #8 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #8 **** # vi:ts=2 sw=2: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #9 **** $Shell::POSIX::Select::DEBUG > 1 and 9 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP9: { # **** NEW SCOPE FOR SELECTLOOP #9 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[9], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[9] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[9]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[9]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[9] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[9]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $qx; # last Shell::POSIX::Select::_SEL_LOOP9; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 9 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[9-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP9\n"; $Eof=1; last _SEL_LOOP9; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[9] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $qx = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$qx\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #9 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #9 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #9 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/failure_to_identify_loops.cdump_ref0000755000175000000000000000001214454517565023244 0ustar root # $X$ Shell-POSIX-Select-0.09/Ref_Data/arrayvar.cdump_ref0000755000175000000000000001427514454517565017653 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var[0]; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var[0] = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$var[0]\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/eslect_fixed.cdump_ref0000755000175000000000000001443414454517565020457 0ustar root BEGIN { @ARGV or @ARGV=qw(A B C) ; } # select $var[2] ( ) { print "$var[2]\n" } $Heading='MENU CITY'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$var\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/nested2b.cdump_ref0000755000175000000000000003104714454517565017526 0ustar root $Prompt='Outer'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $var; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW warn "inside Outer loop\n"; $Prompt='Inner'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #2 **** $Shell::POSIX::Select::DEBUG > 1 and 2 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP2: { # **** NEW SCOPE FOR SELECTLOOP #2 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(qw (a b) ); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $var2; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[2], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[2] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[2]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[2]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[2] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[2]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var2; # last Shell::POSIX::Select::_SEL_LOOP2; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 2 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[2-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP2\n"; $Eof=1; last _SEL_LOOP2; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[2] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var2 = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW warn "inside Inner loop\n"; print "$var$var2\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #2 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #2 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #2 **** # vi:ts=2 sw=2: warn "outside Inner loop\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: warn "outside all loops\n"; Shell-POSIX-Select-0.09/Ref_Data/other_select2.cdump_ref0000755000175000000000000000054614454517565020562 0ustar root # Make sure that file-descriptor monitoring version of select # doesn't get identified as loopy one $rout= $timeleft= $nfound= $wout= $eout= $timeout = 0; $rin = $win = $ein = ''; vec($rin,fileno(STDIN),1) = 1; vec($win,fileno(STDOUT),1) = 1; $ein = $rin | $win; ($nfound,$timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout); Shell-POSIX-Select-0.09/Ref_Data/stderr.cdump_ref0000755000175000000000000000003314454517566017313 0ustar root print STDERR "STDERR\n"; Shell-POSIX-Select-0.09/Ref_Data/stdout.cdump_ref0000755000175000000000000000003314454517566017332 0ustar root print STDOUT "STDOUT\n"; Shell-POSIX-Select-0.09/Ref_Data/localvar.cdump_ref0000755000175000000000000001431514454517565017622 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $var; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "/$var/\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/nested_heading_prompt.cdump_ref0000755000175000000000000003130114454517565022353 0ustar root $Heading="\n\nQuantity Menu:"; $Prompt="Choose Quantity:"; OUTER: # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1..4); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $quantity; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $quantity; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $quantity = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW # warn "inside Outer loop\n"; $Heading="\nSize Menu:"; $Prompt='Choose Size:'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #2 **** $Shell::POSIX::Select::DEBUG > 1 and 2 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP2: { # **** NEW SCOPE FOR SELECTLOOP #2 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=( qw (L XL) ); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $size; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[2], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[2] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[2]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[2]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[2] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[2]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $size; # last Shell::POSIX::Select::_SEL_LOOP2; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 2 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[2-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP2\n"; $Eof=1; last _SEL_LOOP2; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[2] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $size = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW # warn "inside Inner loop\n"; print "You chose $quantity units of size $size\n"; last OUTER;; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #2 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #2 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #2 **** # vi:ts=2 sw=2: # warn "outside Inner loop\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: #warn "outside all loops\n"; Shell-POSIX-Select-0.09/Ref_Data/alldefaults.cdump_ref0000755000175000000000000001444714454517565020325 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=defined ((( caller 0 )[3]) and (( caller 0 )[3]) ne "") ? @_ : @ARGV ; local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$_\n" ; # ** USING DEFAULT CODEBLOCK **; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/argv_heading.cdump_ref0000755000175000000000000001435614454517565020442 0ustar root BEGIN { @ARGV or @ARGV=qw(A B C) } $Heading='MENU CITY'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$var\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/no_decl_var.cdump_ref0000755000175000000000000001430314454517565020267 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1,2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$_\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/eslect.cdump_ref0000755000175000000000000001443414454517565017300 0ustar root BEGIN { @ARGV or @ARGV=qw(A B C) ; } # eslect $var[2] ( ) { print "$var[2]\n" } $Heading='MENU CITY'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(@ARGV); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$var\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/refvar.cdump_ref0000755000175000000000000001437714454517566017315 0ustar root $var = '$loopvar'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1,2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; ; # NO DECLARATION OF LOOP-VAR REQUESTED # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $$var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $$var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$$var\n"; last;; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: print "After loop, loopvar contains: $$var\n"; Shell-POSIX-Select-0.09/Ref_Data/nested2c.cdump_ref0000755000175000000000000003106114454517565017523 0ustar root $Prompt='Menu 1'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $var; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW warn "inside Outer loop\n"; $Prompt='Menu 2'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #2 **** $Shell::POSIX::Select::DEBUG > 1 and 2 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP2: { # **** NEW SCOPE FOR SELECTLOOP #2 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(qw (a b) ); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $var2; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[2], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[2] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[2]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[2]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[2] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[2]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var2; # last Shell::POSIX::Select::_SEL_LOOP2; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 2 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[2-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP2\n"; $Eof=1; last _SEL_LOOP2; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[2] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var2 = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW warn "inside Inner loop\n"; print "$var$var2\n"; last;; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #2 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #2 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #2 **** # vi:ts=2 sw=2: warn "outside Inner loop\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: warn "outside all loops\n"; Shell-POSIX-Select-0.09/Ref_Data/nested2a.cdump_ref0000755000175000000000000003062414454517565017525 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #2 **** $Shell::POSIX::Select::DEBUG > 1 and 2 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP2: { # **** NEW SCOPE FOR SELECTLOOP #2 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[2], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[2] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[2]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[2]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[2] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[2]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP2; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 2 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[2-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP2\n"; $Eof=1; last _SEL_LOOP2; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[2] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$_\n" ; # ** USING DEFAULT CODEBLOCK **; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #2 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #2 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #2 **** # vi:ts=2 sw=2: ; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/myvar.cdump_ref0000755000175000000000000001431214454517565017152 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1,2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $var; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$var\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Ref_Data/reply.cdump_ref0000755000175000000000000003121014454517566017144 0ustar root $Heading='Menu 1'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1,2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $var; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW warn "inside Outer loop\n"; warn "Reply is $Reply\n"; $Heading='Menu 2'; # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #2 **** $Shell::POSIX::Select::DEBUG > 1 and 2 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP2: { # **** NEW SCOPE FOR SELECTLOOP #2 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(qw (a b) ); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; my $var2; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[2], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[2] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[2]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[2]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[2] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[2]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $var2; # last Shell::POSIX::Select::_SEL_LOOP2; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 2 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[2-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP2\n"; $Eof=1; last _SEL_LOOP2; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[2] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $var2 = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW warn "inside Inner loop\n"; warn "Reply is $Reply\n"; print "$var$var2\n"; last;; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #2 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #2 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #2 **** # vi:ts=2 sw=2: warn "outside Inner loop\n"; warn "Reply is $Reply\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: warn "outside all loops\n"; Shell-POSIX-Select-0.09/Ref_Data/select2foreach.cdump_ref0000755000175000000000000001430314454517566020706 0ustar root # Code generated by Shell::POSIX::Select v0.09, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #1 **** $Shell::POSIX::Select::DEBUG > 1 and 1 == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\n"; _SEL_LOOP1: { # **** NEW SCOPE FOR SELECTLOOP #1 **** # critical for values's contents to be resolved in user's scope local @Shell::POSIX::Select::looplist=(1,2); local $Shell::POSIX::Select::num_values=@Shell::POSIX::Select::looplist; $Shell::POSIX::Select::DEBUG > 4 and do { warn "ARRAY VALUES ARE: @Shell::POSIX::Select::looplist\n"; warn "NUM VALUES is $Shell::POSIX::Select::num_values\n"; warn "user-program debug level is $Shell::POSIX::Select::U_WARN\n"; }; local $_; # LOOP-VAR DECLARATION REQUESTED (perhaps by default) # loop-var declaration appears here ; local ( $Shell::POSIX::Select::Prompt[1], $Shell::POSIX::Select::menu ) = Shell::POSIX::Select::make_menu( $Shell::POSIX::Select::Heading || "", $Shell::POSIX::Select::Prompt || "" , # Might be overridden in make_menu @Shell::POSIX::Select::looplist ); # no point in prompting a pipe! local $Shell::POSIX::Select::do_prompt[1] = (-t) ? 1 : 0 ; 0 > 2 and warn "do_prompt is $Shell::POSIX::Select::do_prompt[1]\n"; if ( defined $Shell::POSIX::Select::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset for # outer loop on exit from inner local ($Reply); while (1) { # for validating user's input local $Shell::POSIX::Select::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local $\; if ($Shell::POSIX::Select::do_prompt[1]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( $Shell::POSIX::Select::_extra_nl) { print STDERR "\n\n"; $Shell::POSIX::Select::_extra_nl=0; } print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt[1] "; } } # $Shell::POSIX::Select::do_prompt=0; # constant prompting depends on style $Shell::POSIX::Select::do_prompt[1]= 0; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # $^W=0; # warn "Waiting for input"; $Eof=0; $Reply = ; # warn "Got input"; # $^W=1; if ( !defined( $Reply ) ) { defined "" and "" ne "" and print STDERR ""; # need to undef loop var; user may check it! undef $_; # last Shell::POSIX::Select::_SEL_LOOP1; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( 1 > 1 and -t ) { # reset prompting for outer loop $Shell::POSIX::Select::do_prompt[1-1] = 1; $Shell::POSIX::Select::_extra_nl=1; } 0 > 2 and warn "Lasting out of _SEL_LOOP1\n"; $Eof=1; last _SEL_LOOP1; } !defined $Reply and die "REPLY accessed, while undefined"; chomp $Reply; # undo emboldening of user input defined "" and "" ne "" and print STDERR ""; #print STDERR "$Shell::POSIX::Select::menu\n$Shell::POSIX::Select::Prompt "; if ( $Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu $Shell::POSIX::Select::U_WARN > 1 and warn "\tINPUT IS: empty\n"; $Shell::POSIX::Select::bad = $Shell::POSIX::Select::do_prompt[1] = 1; } elsif ( $Reply =~ /\D/ ) { # shouldn't be any non-digit! $Shell::POSIX::Select::U_WARN > 0 and warn "\tINPUT CONTAINS NON-DIGIT: '$Reply'\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } elsif ( $Reply < 1 or $Reply > $Shell::POSIX::Select::num_values ) { $Shell::POSIX::Select::U_WARN > 0 and warn "\t'$Reply' IS NOT IN RANGE: 1 - $Shell::POSIX::Select::num_values\n"; $Shell::POSIX::Select::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: $Shell::POSIX::Select::bad"; $Shell::POSIX::Select::bad or 0 > 2 and warn "About to last out of Reply Validator Loop "; $Shell::POSIX::Select::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $_ = $Shell::POSIX::Select::looplist[$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW print "$_\n";; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! 0 > 2 and warn "At end of prompt-repeating loop "; } # infinite while for repeating collection of selections 0 and warn "BEYOND end of prompt-repeating loop "; } # endif (defined $Shell::POSIX::Select::menu) else { $Shell::POSIX::Select::DEBUG > 0 and warn "Shell::POSIX::Select: Select Loop #1 has no list, so no iterations\n"; if ( $Shell::POSIX::Select::dump_data ) { $Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic "; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version } # **** END NEW SCOPE FOR SELECTLOOP #1 **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #1 **** # vi:ts=2 sw=2: Shell-POSIX-Select-0.09/Compile_Bugs/0000755000175000000000000000000014454517773015026 5ustar rootShell-POSIX-Select-0.09/Compile_Bugs/rt53556.pl0000755000175000000000000000030014454516447016411 0ustar root#!perl use Shell::POSIX::Select; &print_count(); sub nll() { 0; } { our $count; format STDOUT = ^<<< $count . sub print_count() { $count=0; select(STDOUT); write(STDOUT); }; } __END__ Shell-POSIX-Select-0.09/Compile_Bugs/dual_select0000755000175000000000000000065614454516447017244 0ustar root#! /usr/bin/perl -w use Shell::POSIX::Select; # Make sure that filehandle version of select doesn't get parsed as loopy one # select ('^d to exit') { } $old_fh = select (STDERR); $|=1; select ($old_fh); print STDOUT "STDOUT\n"; print STDERR "STDERR\n"; # select ('^d to exit') { } # Found during testing that I can't actually print output and know # the order in which the words will appear! Linux differs from Solaris! Shell-POSIX-Select-0.09/Compile_Bugs/require0000755000175000000000000000005714454516447016427 0ustar rootrequire Shell::POSIX::Select; select (1) {; } Shell-POSIX-Select-0.09/pick.plx.PL0000755000175000000000000000144714454516447014451 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/browse_records.plx.PL0000755000175000000000000000144714454516447016545 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/lc_filename.plx.PL0000755000175000000000000000144714454516447015761 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/order.00000755000175000000000000000116014454516447013650 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select qw($Prompt $Heading); $Heading="\n\nQuantity Menu:"; $Prompt="Choose Quantity:"; OUTER: select my $quantity (1..4) { $Heading="\nSize Menu:" ; $Prompt='Choose Size:' ; select my $size ( qw (L XL) ) { print "You chose $quantity units of size $size\n" ; last OUTER ; # Order is complete } } Shell-POSIX-Select-0.09/Test_Progs/0000755000175000000000000000000014454517773014547 5ustar rootShell-POSIX-Select-0.09/Test_Progs/myvar0000755000175000000000000000017214454516447015630 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select ; select my $var (1,2) { print "$var\n"; } Shell-POSIX-Select-0.09/Test_Progs/arrayvar0000755000175000000000000000017614454516447016325 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; select $var[0] (@ARGV) { print "$var[0]\n"; } Shell-POSIX-Select-0.09/Test_Progs/select2foreach0000755000175000000000000000017714454516447017370 0ustar root#!perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select ( testmode => 'foreach' ); select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.09/Test_Progs/reply0000755000175000000000000000064714454516447015634 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select qw( $Heading); $Heading='Menu 1'; select my $var (1,2) { warn "inside Outer loop\n"; warn "Reply is $Reply\n"; $Heading='Menu 2'; select my $var2 (qw (a b) ) { warn "inside Inner loop\n"; warn "Reply is $Reply\n"; print "$var$var2\n"; last; } warn "outside Inner loop\n"; warn "Reply is $Reply\n"; } warn "outside all loops\n"; Shell-POSIX-Select-0.09/Test_Progs/alldefaults0000755000175000000000000000013714454516447016773 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select ; select () { } Shell-POSIX-Select-0.09/Test_Progs/prompt.nested0000755000175000000000000000033214454516447017272 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select qw($Prompt); $Prompt='Custom Prompt for loop 1'; select ( 1 ){ $Prompt='Custom Prompt for loop 2'; LOOP2: select ( 2 ){ last LOOP2; } } Shell-POSIX-Select-0.09/Test_Progs/argv_heading0000755000175000000000000000033714454516447017113 0ustar root#! /usr/bin/perl -w my $VERSION = 1.03; use blib; use Shell::POSIX::Select( '$Heading', # debug => 9, # logging => 1, ); BEGIN { @ARGV or @ARGV=qw(A B C) } $Heading='MENU CITY'; select $var (@ARGV) { print "$var\n"; } Shell-POSIX-Select-0.09/Test_Progs/options1.bogus0000755000175000000000000000026514454516447017367 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select( style => 'bogus', style => 'Bash', prompt => 'bogus' ); select $var ( localtime ){ print "$var\n"; } Shell-POSIX-Select-0.09/Test_Progs/loop_variable_names0000755000175000000000000000126214454516447020474 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; # Restrictions on Loop-variable Names # # Due to a bug in most versions of Text::Balanced, # loop-variable names that look like Perl operators, # including $m, $a, $s, $y, $tr, $qq, $qw, $qr, $qx # and possibly others, cause syntax errors. # are these restrictions fixed ? use Shell::POSIX::Select ; select $m (@ARGV) { print "$m\n"; } select $a (@ARGV) { print "$a\n"; } select $s (@ARGV) { print "$s\n"; } select $y (@ARGV) { print "$y\n"; } select $tr (@ARGV) { print "$tr\n"; } select $qq (@ARGV) { print "$qq\n"; } select $qw (@ARGV) { print "$qw\n"; } select $qr (@ARGV) { print "$qr\n"; } select $qx (@ARGV) { print "$qx\n"; } Shell-POSIX-Select-0.09/Test_Progs/nested2b0000755000175000000000000000050414454516447016177 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select qw($Prompt); $Prompt='Outer'; select my $var (1) { warn "inside Outer loop\n"; $Prompt='Inner'; select my $var2 (qw (a b) ) { warn "inside Inner loop\n"; print "$var$var2\n"; } warn "outside Inner loop\n"; } warn "outside all loops\n"; Shell-POSIX-Select-0.09/Test_Progs/localvar0000755000175000000000000000017514454516447016300 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select ; select local $var (1) { print "/$var/\n"; } Shell-POSIX-Select-0.09/Test_Progs/HIDE/0000755000175000000000000000000014454517773015260 5ustar rootShell-POSIX-Select-0.09/Test_Progs/HIDE/stderr0000755000175000000000000000011214454516447016500 0ustar root#! /usr/bin/perl -w use Shell::POSIX::Select; print STDERR "STDERR\n"; Shell-POSIX-Select-0.09/Test_Progs/HIDE/stdout0000755000175000000000000000011214454516447016517 0ustar root#! /usr/bin/perl -w use Shell::POSIX::Select; print STDOUT "STDOUT\n"; Shell-POSIX-Select-0.09/Test_Progs/HIDE/other_select20000755000175000000000000000062514454516447017750 0ustar root#! /usr/bin/perl -w use Shell::POSIX::Select; # Make sure that file-descriptor monitoring version of select # doesn't get identified as loopy one $rout= $timeleft= $nfound= $wout= $eout= $timeout = 0; $rin = $win = $ein = ''; vec($rin,fileno(STDIN),1) = 1; vec($win,fileno(STDOUT),1) = 1; $ein = $rin | $win; ($nfound,$timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout); Shell-POSIX-Select-0.09/Test_Progs/HIDE/other_select10000755000175000000000000000070414454516447017745 0ustar root#! /usr/bin/perl -w use Shell::POSIX::Select; # Make sure that filehandle version of select doesn't get parsed as loopy one # select ('^d to exit') { } $old_fh = select (STDERR); $|=1; select ($old_fh); # select ('^d to exit') { } print STDOUT "STDOUT\n"; # Found during testing that I can't actually print output to both channels # and know the order in which the words will appear! Linux differs # from Solaris! # print STDERR "STDERR\n"; Shell-POSIX-Select-0.09/Test_Progs/stderr0000755000175000000000000000015214454516447015773 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; print STDERR "STDERR\n"; Shell-POSIX-Select-0.09/Test_Progs/no_decl_var0000755000175000000000000000015714454516447016750 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.09/Test_Progs/badvar0000755000175000000000000000015714454516447015734 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.09/Test_Progs/failure_to_identify_loops0000755000175000000000000000252214454516447021733 0ustar root#! /usr/bin/perl -w # Failure to Identify select Loops # # When a properly formed select loop appears in certain contexts, # such as before a line containing certain patterns of dollar signs # or quotes, # it will not be properly identified and translated into standard Perl. # # The following is such an example: # # use Shell::POSIX::Select; # select (@names) { print ; } # # $X$ # # The failure of the filtering routine to rewrite the loop causes the # compiler to issue the following fatal error when it sees the # { following the (LIST): # # syntax error at filename line X, near ") {" # # This of course prevents the program from running. # # The problem is either a bug in Filter::Simple, or one of the modules on # which it depends. # Until this is resolved, you may be able to # handle such cases by explicitly turning filtering off before the offending # code is encountered, using the no directive: # # use Shell::POSIX::Select; # filtering ON # select (@names) { print ; } # # no Shell::POSIX::Select; # filtering OFF # # $X$ # Is this resolved? my $VERSION = 1.02; use blib; # case 1: use Shell::POSIX::Select; select (@names) { print ; } # $X$ # case 2: use Shell::POSIX::Select; # filtering ON select (@names) { print ; } no Shell::POSIX::Select; # filtering OFF # $X$ Shell-POSIX-Select-0.09/Test_Progs/stdout0000755000175000000000000000015214454516447016012 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; print STDOUT "STDOUT\n"; Shell-POSIX-Select-0.09/Test_Progs/novar0000755000175000000000000000015714454516447015622 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.09/Test_Progs/refvar0000755000175000000000000000030314454516447015753 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select ; $var = '$loopvar'; select $$var (1,2) { print "$$var\n"; last; } print "After loop, loopvar contains: $$var\n"; Shell-POSIX-Select-0.09/Test_Progs/other_select20000755000175000000000000000066514454516447017243 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; # Make sure that file-descriptor monitoring version of select # doesn't get identified as loopy one $rout= $timeleft= $nfound= $wout= $eout= $timeout = 0; $rin = $win = $ein = ''; vec($rin,fileno(STDIN),1) = 1; vec($win,fileno(STDOUT),1) = 1; $ein = $rin | $win; ($nfound,$timeleft) = select($rout=$rin, $wout=$win, $eout=$ein, $timeout); Shell-POSIX-Select-0.09/Test_Progs/nested_heading_prompt0000755000175000000000000000073214454516447021036 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select qw($Prompt $Heading); $Heading="\n\nQuantity Menu:"; $Prompt="Choose Quantity:"; OUTER: select my $quantity (1..4) { # warn "inside Outer loop\n"; $Heading="\nSize Menu:"; $Prompt='Choose Size:'; select my $size ( qw (L XL) ) { # warn "inside Inner loop\n"; print "You chose $quantity units of size $size\n"; last OUTER; } # warn "outside Inner loop\n"; } #warn "outside all loops\n"; Shell-POSIX-Select-0.09/Test_Progs/sub20000755000175000000000000000026114454516447015344 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select ; sub select_in_sub { select $var () { print "$var\n"; } } @ARGV=1..3; select_in_sub qw(a b) ; Shell-POSIX-Select-0.09/Test_Progs/eslect_fixed0000755000175000000000000000035514454516447017133 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select qw($Heading); BEGIN { @ARGV or @ARGV=qw(A B C) ; } # select $var[2] ( ) { print "$var[2]\n" } $Heading='MENU CITY'; select $var (@ARGV) { print "$var\n"; } Shell-POSIX-Select-0.09/Test_Progs/ourvar0000755000175000000000000000023514454516447016010 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; select our $var (1) { print "$var\n"; } print "Outside loop, var is $var\n"; Shell-POSIX-Select-0.09/Test_Progs/other_select10000755000175000000000000000074414454516447017240 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; # Make sure that filehandle version of select doesn't get parsed as loopy one # select ('^d to exit') { } $old_fh = select (STDERR); $|=1; select ($old_fh); # select ('^d to exit') { } print STDOUT "STDOUT\n"; # Found during testing that I can't actually print output to both channels # and know the order in which the words will appear! Linux differs # from Solaris! # print STDERR "STDERR\n"; Shell-POSIX-Select-0.09/Test_Progs/eslect0000755000175000000000000000035514454516447015754 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select qw($Heading); BEGIN { @ARGV or @ARGV=qw(A B C) ; } # eslect $var[2] ( ) { print "$var[2]\n" } $Heading='MENU CITY'; select $var (@ARGV) { print "$var\n"; } Shell-POSIX-Select-0.09/Test_Progs/nested2a0000755000175000000000000000015614454516447016201 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select; select (1) { select (2) { } } Shell-POSIX-Select-0.09/Test_Progs/nested2c0000755000175000000000000000053614454516447016205 0ustar root#! /usr/bin/perl -w my $VERSION = 1.02; use blib; use Shell::POSIX::Select qw($Heading $Reply $Prompt); $Prompt='Menu 1'; select my $var (1) { warn "inside Outer loop\n"; $Prompt='Menu 2'; select my $var2 (qw (a b) ) { warn "inside Inner loop\n"; print "$var$var2\n"; last; } warn "outside Inner loop\n"; } warn "outside all loops\n"; Shell-POSIX-Select-0.09/lc_filename.00000755000175000000000000000143214454516447014775 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( '$Eof' , prompt => 'Enter number (^D to exit):' , style => 'Korn' # for automatic prompting ); # Rename selected files from current dir to lowercase while ( @files=<*[A-Z]*> ) { # restarts select to get updated menu select ( @files ) { # skip fully lower-case names if (rename $_, "\L$_") { last ; } else { warn "$0: rename failed for $_: $!\n"; } } $Eof and last ; # Handle <^D> to menu prompt } Shell-POSIX-Select-0.09/pick.00000755000175000000000000000132014454516447013461 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ; BEGIN { if (@ARGV) { @choices=@ARGV ; } else { # if no args, get choices from input @choices= or die "$0: No data\n"; chomp @choices ; # STDIN already returned EOF, # so must reopen for terminal before menu interaction open STDIN, "/dev/tty" or die ; # UNIX example } } select ( @choices ) { } # prints selections to output Shell-POSIX-Select-0.09/inc/0000755000175000000000000000000014454517773013227 5ustar rootShell-POSIX-Select-0.09/inc/Module/0000755000175000000000000000000014454517773014454 5ustar rootShell-POSIX-Select-0.09/inc/Module/Install.pm0000755000175000000000000002714514454517272016426 0ustar root#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.21'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $base_path = VMS::Filespec::unixify($base_path) if $^O eq 'VMS'; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( {no_chdir => 1, wanted => sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($File::Find::name); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }}, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Shell-POSIX-Select-0.09/inc/Module/Install/0000755000175000000000000000000014454517773016062 5ustar rootShell-POSIX-Select-0.09/inc/Module/Install/Can.pm0000755000175000000000000000640514454517272017123 0ustar root#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; if ($^O eq 'VMS') { require ExtUtils::CBuilder; my $builder = ExtUtils::CBuilder->new( quiet => 1, ); return $builder->have_compiler; } my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 245 Shell-POSIX-Select-0.09/inc/Module/Install/Win32.pm0000755000175000000000000000340314454517272017317 0ustar root#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Shell-POSIX-Select-0.09/inc/Module/Install/Base.pm0000755000175000000000000000214714454517272017273 0ustar root#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.21'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Shell-POSIX-Select-0.09/inc/Module/Install/WriteAll.pm0000755000175000000000000000237614454517272020150 0ustar root#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Shell-POSIX-Select-0.09/inc/Module/Install/Fetch.pm0000755000175000000000000000462714454517272017457 0ustar root#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Shell-POSIX-Select-0.09/inc/Module/Install/Makefile.pm0000755000175000000000000002743714454517272020147 0ustar root#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Shell-POSIX-Select-0.09/inc/Module/Install/Metadata.pm0000755000175000000000000004343714454517272020150 0ustar root#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.21'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', artistic => 'http://opensource.org/licenses/artistic-license.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, # these are not actually allowed in meta-spec v1.4 but are left here for compatibility: apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Shell-POSIX-Select-0.09/pick_file.plx.PL0000755000175000000000000000144714454516447015450 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/max_columns_1.00000755000175000000000000000276214454516447015313 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select qw($Heading $Prompt $Eof $MaxColumns) ; # following avoids used-only once warning my ($type, $format) ; # Would be more Perlish to associate choices with options # using a Hash, but this approach demonstrates $Reply variable @formats = ( 'regular', 'long' ) ; @fmt_opt = ( '', '-l' ) ; @types = ( 'only non-hidden', 'all files' ) ; @typ_opt = ( '', '-a' , ) ; print "** LS-Command Composer **\n\n" ; $Heading="\n**** Style Menu ****" ; $Prompt= "Choose listing style:" ; $MaxColumns = 1; OUTER: select $format ( @formats ) { $user_format=$fmt_opt[ $Reply - 1 ] ; $Heading="\n**** File Menu ****" ; $Prompt="Choose files to list:" ; $MaxColumns = 1; select $type ( @types ) { # ^D restarts OUTER $user_type=$typ_opt[ $Reply - 1 ] ; last OUTER ; # leave loops once final choice obtained } } $Eof and exit ; # handle ^D to OUTER # Now construct user's command $command="ls $user_format $user_type" ; # Show command, for educational value warn "\nPress to execute \"$command\"\n" ; # Now wait for input, then run command defined <> or print "\n" and exit ; system $command ; # finally, run the command Shell-POSIX-Select-0.09/menu_ls.00000755000175000000000000000270014454516447014200 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select qw($Heading $Prompt $Eof) ; # following avoids used-only once warning my ($type, $format) ; # Would be more Perlish to associate choices with options # using a Hash, but this approach demonstrates $Reply variable @formats = ( 'regular', 'long' ) ; @fmt_opt = ( '', '-l' ) ; @types = ( 'only non-hidden', 'all files' ) ; @typ_opt = ( '', '-a' , ) ; print "** LS-Command Composer **\n\n" ; $Heading="\n**** Style Menu ****" ; $Prompt= "Choose listing style:" ; OUTER: select $format ( @formats ) { $user_format=$fmt_opt[ $Reply - 1 ] ; $Heading="\n**** File Menu ****" ; $Prompt="Choose files to list:" ; select $type ( @types ) { # ^D restarts OUTER $user_type=$typ_opt[ $Reply - 1 ] ; last OUTER ; # leave loops once final choice obtained } } $Eof and exit ; # handle ^D to OUTER # Now construct user's command $command="ls $user_format $user_type" ; # Show command, for educational value warn "\nPress to execute \"$command\"\n" ; # Now wait for input, then run command defined <> or print "\n" and exit ; system $command ; # finally, run the command Shell-POSIX-Select-0.09/Scripts/0000755000175000000000000000000014454517773014105 5ustar rootShell-POSIX-Select-0.09/Scripts/lc_filename.plx0000755000175000000000000000145514454517306017070 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( '$Eof' , prompt => 'Enter number (^D to exit):' , style => 'Korn' # for automatic prompting ); # Rename selected files from current dir to lowercase while ( @files=<*[A-Z]*> ) { # restarts select to get updated menu select ( @files ) { # skip fully lower-case names if (rename $_, "\L$_") { last ; } else { warn "$0: rename failed for $_: $!\n"; } } $Eof and last ; # Handle <^D> to menu prompt } Shell-POSIX-Select-0.09/Scripts/perl_man.plx0000755000175000000000000000101014454517307016413 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ; # Extract man-page names from the TOC portion of the output of "perldoc perl" select $manpage ( sort ( `perldoc perl` =~ /^\s+(perl\w+)\s/mg) ) { system "perldoc '$manpage'" ; } Shell-POSIX-Select-0.09/Scripts/menu_ls.plx0000755000175000000000000000272314454517306016273 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select qw($Heading $Prompt $Eof) ; # following avoids used-only once warning my ($type, $format) ; # Would be more Perlish to associate choices with options # using a Hash, but this approach demonstrates $Reply variable @formats = ( 'regular', 'long' ) ; @fmt_opt = ( '', '-l' ) ; @types = ( 'only non-hidden', 'all files' ) ; @typ_opt = ( '', '-a' , ) ; print "** LS-Command Composer **\n\n" ; $Heading="\n**** Style Menu ****" ; $Prompt= "Choose listing style:" ; OUTER: select $format ( @formats ) { $user_format=$fmt_opt[ $Reply - 1 ] ; $Heading="\n**** File Menu ****" ; $Prompt="Choose files to list:" ; select $type ( @types ) { # ^D restarts OUTER $user_type=$typ_opt[ $Reply - 1 ] ; last OUTER ; # leave loops once final choice obtained } } $Eof and exit ; # handle ^D to OUTER # Now construct user's command $command="ls $user_format $user_type" ; # Show command, for educational value warn "\nPress to execute \"$command\"\n" ; # Now wait for input, then run command defined <> or print "\n" and exit ; system $command ; # finally, run the command Shell-POSIX-Select-0.09/Scripts/order.plx0000755000175000000000000000120314454517307015735 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select qw($Prompt $Heading); $Heading="\n\nQuantity Menu:"; $Prompt="Choose Quantity:"; OUTER: select my $quantity (1..4) { $Heading="\nSize Menu:" ; $Prompt='Choose Size:' ; select my $size ( qw (L XL) ) { print "You chose $quantity units of size $size\n" ; last OUTER ; # Order is complete } } Shell-POSIX-Select-0.09/Scripts/SCRIPTS.rme0000755000175000000000000000145214454516447015743 0ustar rootThis directory contains the sample programs shown in the documentation for the Shell::POSIX::Select module. The module's installation routine does not install them in any system command directory, but you should be able to find them where the module was installed. And I guess you did, if you're reading this! Note that some of these programs won't do anything at all if they're invoked without arguments, so please examine the documentation or the scripts themselves to learn how to run them. These programs are provided for their educational value, and I believe they work correctly, but they do not come with a warranty of any kind. I hope you find them useful! I am the copyright holder, so for any questions about fair use, please contact me. Tim Maher, CEO Consultix, Inc. tim@teachmeperl.com Shell-POSIX-Select-0.09/Scripts/pick.plx0000755000175000000000000000134314454517307015555 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ; BEGIN { if (@ARGV) { @choices=@ARGV ; } else { # if no args, get choices from input @choices= or die "$0: No data\n"; chomp @choices ; # STDIN already returned EOF, # so must reopen for terminal before menu interaction open STDIN, "/dev/tty" or die ; # UNIX example } } select ( @choices ) { } # prints selections to output Shell-POSIX-Select-0.09/Scripts/file1.py0000755000175000000000000000000014454516447015445 0ustar rootShell-POSIX-Select-0.09/Scripts/delete_file.plx0000755000175000000000000000133414454517306017067 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( '$Eof', # for ^D detection prompt => 'Choose file for deletion:' ) ; # Eradicate serpents, like St. Patrick! 8-} OUTER: while ( @files=<*.py> ) { select ( @files ) { print STDERR "Really delete $_? [y/n]: " ; my $answer = ; # ^D sets $Eof below defined $answer or last OUTER ; # exit on ^D $answer eq "y\n" and unlink and last ; } $Eof and last; } Shell-POSIX-Select-0.09/Scripts/max_columns_1.plx0000755000175000000000000000300514454517306017370 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select qw($Heading $Prompt $Eof $MaxColumns) ; # following avoids used-only once warning my ($type, $format) ; # Would be more Perlish to associate choices with options # using a Hash, but this approach demonstrates $Reply variable @formats = ( 'regular', 'long' ) ; @fmt_opt = ( '', '-l' ) ; @types = ( 'only non-hidden', 'all files' ) ; @typ_opt = ( '', '-a' , ) ; print "** LS-Command Composer **\n\n" ; $Heading="\n**** Style Menu ****" ; $Prompt= "Choose listing style:" ; $MaxColumns = 1; OUTER: select $format ( @formats ) { $user_format=$fmt_opt[ $Reply - 1 ] ; $Heading="\n**** File Menu ****" ; $Prompt="Choose files to list:" ; $MaxColumns = 1; select $type ( @types ) { # ^D restarts OUTER $user_type=$typ_opt[ $Reply - 1 ] ; last OUTER ; # leave loops once final choice obtained } } $Eof and exit ; # handle ^D to OUTER # Now construct user's command $command="ls $user_format $user_type" ; # Show command, for educational value warn "\nPress to execute \"$command\"\n" ; # Now wait for input, then run command defined <> or print "\n" and exit ; system $command ; # finally, run the command Shell-POSIX-Select-0.09/Scripts/browse_images.plx0000755000175000000000000000076114454517306017457 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ; $viewer='/usr/X11R6/bin/xv'; # Popular Linux viewer select ( grep /\.(jpg|gif|tif|png)$/i, <*> ) { system "$viewer $_ &" ; # run viewer in background } Shell-POSIX-Select-0.09/Scripts/README0000755000175000000000000000145214454516447014767 0ustar rootThis directory contains the sample programs shown in the documentation for the Shell::POSIX::Select module. The module's installation routine does not install them in any system command directory, but you should be able to find them where the module was installed. And I guess you did, if you're reading this! Note that some of these programs won't do anything at all if they're invoked without arguments, so please examine the documentation or the scripts themselves to learn how to run them. These programs are provided for their educational value, and I believe they work correctly, but they do not come with a warranty of any kind. I hope you find them useful! I am the copyright holder, so for any questions about fair use, please contact me. Tim Maher, CEO Consultix, Inc. tim@teachmeperl.com Shell-POSIX-Select-0.09/Scripts/pick_file.plx0000755000175000000000000000067114454517307016557 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( prompt => 'Pick File(s):' , style => 'Korn' # for automatic prompting ); select ( <*> ) { } Shell-POSIX-Select-0.09/Scripts/file2.py0000755000175000000000000000000014454516447015446 0ustar rootShell-POSIX-Select-0.09/Scripts/browse_records.plx0000755000175000000000000000164514454517306017655 0ustar root#!/usr/bin/perl -w ######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( style => 'Korn' ); if (@ARGV != 2 and @ARGV != 3) { # Could also use Getopt:* module for option parsing die "Usage: $0 fieldnum filename [delimiter]" ; } ( $field, $file, $delim) = @ARGV ; if ( ! defined $delim ) { $delim='[\040\t]+' # SP/TAB sequences } $field-- ; # 2->1, 1->0, etc., for 0-based indexing foreach ( `cat "$file"` ) { # field is the key in the hash, value is entire record $f2r{ (split /$delim/, $_)[ $field ] } = $_ ; } # Show specified fields in menu, and display associated records select $record ( sort keys %f2r ) { print "$f2r{$record}" ; } Shell-POSIX-Select-0.09/max_columns_1.plx.PL0000755000175000000000000000144714454516447016270 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/MANIFEST0000755000175000000000000000466414454517612013614 0ustar rootbrowse_images.0 browse_images.plx.PL browse_records.0 browse_records.plx.PL Changes Compile_Bugs/dual_select Compile_Bugs/require Compile_Bugs/rt53556.pl delete_file.0 delete_file.plx.PL inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lc_filename.0 lc_filename.plx.PL lib/Shell/POSIX/Select.pm long_listem.0 Makefile.PL MANIFEST This list of files max_columns_1.0 max_columns_1.plx.PL menu_ls.0 menu_ls.plx.PL META.yml order.0 order.plx.PL perl_man.0 perl_man.plx.PL pick.0 pick.plx.PL pick_file.0 pick_file.plx.PL README Ref_Data/alldefaults.cdump_ref Ref_Data/argv_heading.cdump_ref Ref_Data/arrayvar.cdump_ref Ref_Data/badvar.cdump_ref Ref_Data/eslect.cdump_ref Ref_Data/eslect_fixed.cdump_ref Ref_Data/failure_to_identify_loops.cdump_ref Ref_Data/localvar.cdump_ref Ref_Data/loop_variable_names.cdump_ref Ref_Data/myvar.cdump_ref Ref_Data/nested2a.cdump_ref Ref_Data/nested2b.cdump_ref Ref_Data/nested2c.cdump_ref Ref_Data/nested_heading_prompt.cdump_ref Ref_Data/no_decl_var.cdump_ref Ref_Data/novar.cdump_ref Ref_Data/other_select1.cdump_ref Ref_Data/other_select2.cdump_ref Ref_Data/ourvar.cdump_ref Ref_Data/prompt.nested.cdump_ref Ref_Data/refvar.cdump_ref Ref_Data/reply.cdump_ref Ref_Data/select2foreach.cdump_ref Ref_Data/stderr.cdump_ref Ref_Data/stdout.cdump_ref Ref_Data/sub2.cdump_ref Scripts/browse_images.plx Scripts/browse_records.plx Scripts/delete_file.plx Scripts/file1.py Scripts/file2.py Scripts/lc_filename.plx Scripts/max_columns_1.plx Scripts/menu_ls.plx Scripts/order.plx Scripts/perl_man.plx Scripts/pick.plx Scripts/pick_file.plx Scripts/README Scripts/SCRIPTS.rme test.pl Test_Progs/alldefaults Test_Progs/argv_heading Test_Progs/arrayvar Test_Progs/badvar Test_Progs/eslect Test_Progs/eslect_fixed Test_Progs/failure_to_identify_loops Test_Progs/HIDE/other_select1 Test_Progs/HIDE/other_select2 Test_Progs/HIDE/stderr Test_Progs/HIDE/stdout Test_Progs/localvar Test_Progs/loop_variable_names Test_Progs/myvar Test_Progs/nested2a Test_Progs/nested2b Test_Progs/nested2c Test_Progs/nested_heading_prompt Test_Progs/no_decl_var Test_Progs/novar Test_Progs/options1.bogus Test_Progs/other_select1 Test_Progs/other_select2 Test_Progs/ourvar Test_Progs/prompt.nested Test_Progs/refvar Test_Progs/reply Test_Progs/select2foreach Test_Progs/stderr Test_Progs/stdout Test_Progs/sub2 Shell-POSIX-Select-0.09/test.pl0000755000175000000000000002125414454516447013776 0ustar root#!perl -w my $VERSION = 1.03; use blib; ######################################################### # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### sub get_T_files { return grep 1, get_R_files(); } sub get_R_files { chdir 'Test_Progs' or die "$0: Cannot cd to Test_Progs, $!"; @list=grep { -f and ! /^\.|\.bak$|dump$|_ref$|bogus$/ } <*>; chdir( updir() ) or die "Cannot cd to updir, $!"; # print "R-files Returning @list"; return @list; } # test.pl for # Shell::POSIX::Select # Tim Maher, tim@teachmeperl.com # Sun May 4 00:30:52 PDT 2003 # Mon May 5 18:40:33 PDT 2003 use File::Spec::Functions; use Test::Simple tests => 26 ; use Config; # Was using Test::More, but it always exited at end with 255, # causing "make test" to look like it failed # two extra for the use/require_ok() tests # NOTE: Reference-data generation is triggered through an ENV var # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' BEGIN { my $MODULEVERSION='0.08'; # use Shell::POSIX::Select; # use-ing modifies file handles, so avoid here # require Shell::POSIX::Select; # modifies file handles if "reference" set # Was only require-ing module to get VERSION number; decided to hard-code $DEBUG = 4; # Should only be set >2 on UNIX-like OS $DEBUG = 1; # Should only be set >2 on UNIX-like OS $DEBUG = 0; print "\tShell::POSIX::Select v$MODULEVERSION Test Script\n"; $SCREENS = 1; # NOTE: Only 0 and 1 allowed, due to $num_tests $SCREENS = 0; # NOTE: Only 0 and 1 allowed, due to $num_tests # sub get_R_files; # Advance declarations; did not work! # sub get_T_files; $author='yumpy@cpan.org' ; $test_compile = 1; # fails due to control-char "placeholders" in source $test_compile = 0; $ref_dir='Ref_Data'; my $cbugs_dir='Compile_Bugs'; my $rbugs_dir='Run_Bugs'; my $test_dir='Test_Progs'; @testfiles=get_R_files(); # restrict to one file, if testing the testing script # $DEBUG > 2 and @testfiles = $testfiles[0]; # @testfiles = 'arrayvar'; # FOR TESTING ONLY chomp @testfiles; # Ignore Emacs backup files: @testfiles = grep { $_ !~ m/~/ } @testfiles; if (! -d $ref_dir or ! -r _ or ! -w _ or ! -x _ ) { mkdir $ref_dir or chmod 0755, $ref_dir or die "$0: Failed to make $ref_dir\n"; } } # end BEGIN # MAKE THE REFERENCE FILES? if ( $ENV{Shell_POSIX_Select_reference} ) { # This branch is only run by author, so it can be UNIX/Linux-specific print "\nMAKING REFERENCE DATA\n"; $ENV{PERL5LIB}="/Select"; # needed for test programs # system 'echo PERL5LIB is: $PERL5LIB'; # system 'show_pmod_locus Shell::POSIX::Select'; # $? and die "$0: Couldn't locate module\n"; # system "/local/timbin/show_pmod_version Shell::POSIX::Select\n"; system "rm -f $ref_dir/*" ; # create source-code and screen-dump reference databases # If module generates same data on user's platform, test passes $counter=0; foreach (@testfiles) { ++$counter; print STDERR "$counter $_\n"; # Need screen names for all cases, even if $SCREENS $screen="$_.sdump" ; $screenR=catfile ($ref_dir, "${screen}_ref"); $code="$_.cdump" ; $codeR=catfile ($ref_dir, "${code}_ref"); $ENV{Shell_POSIX_Select_testmode}='make' ; $ENV{Shell_POSIX_Select_reference}=1 ; # Or maybe just eval the code? $script = catfile( 'Test_Progs', $_ ); system "set -x ; perl '$script'" ; $err=$?>>8; # print "\t\t\t$script yielded $err\n"; if (!$SCREENS) { unlink $screenR; # don't distribute! } else { ! -f $screenR and die "Sdump missing!"; } if ( $err and $err ne 222 ) { # code 222 is good exit warn "$0: Reference code-dump of $_ failed with code $err\n"; system "ls -ld '$script' $codeR"; $DEBUG >2 and system "ls -ld $script $codeR"; $DEBUG > 2 and $SCREENS and system "ls -ld '$script' screenR"; chmod 0644, $script; # just eliminate it from testing die "$0: Fatal Error\n"; } elsif ($SCREENS) { $error=`egrep 'syntax | aborted|illegal ' $screenR `; $err = $?>>8; if ( ! $err ) { die "$0: Compilation failed, code $err, for '$screenR'\n\n$error\n"; chmod 0644, $script; } else { chmod 0755, $script; } } # Screen file can be empty, so just check existence and perms if ($SCREENS) { check_file ($screenR) or die "$screenR is bad\n"; } check_file ($codeR) and -s $codeR or die "$codeR is bad\n" ; if ( $test_compile ) { system "perl -wc '$codeR' 2>/tmp/$_.diag" ; if ($?) { print STDERR "$0: Reference code-dump of $_ ", print STDERR "failed to compile, code $?\n"; $DEBUG >2 and system "ls -ld $_ $codeR $screenR"; die "$0: Compilation test for $codeR failed\n"; } } $DEBUG >2 and system "ls -l $codeR"; $DEBUG >2 and $SCREENS and system "ls -l $screenR"; } $ENV{Shell_POSIX_Select_reference} = undef; print "\n\n"; # exit 0; } print "TESTING GENERATED CODE AGAINST REFERENCE DATA\n\n"; # Configure ENV vars so module dumps the required data $ENV{Shell_POSIX_Select_reference}=""; $ENV{Shell_POSIX_Select_testmode}='make' ; @testfiles = get_T_files(); $num_tests = @testfiles; $DEBUG and warn "There are $num_tests test scripts, and 2 tests on each\n"; # Always shows FALSE exit code, after last test, unlike Test::Simple! # plan tests => ( $num_tests * ($SCREENS + 1) ) + 2; #use_ok('Shell::POSIX::Select') or # die "$0: Cannot load module under test\n"; #require_ok('Shell::POSIX::Select'); # Skip file-size tests if current IO layer # has newlines that differ from the reference files $is_crlf=PerlIO::get_layers(STDOUT)=~/crlf/i; foreach (@testfiles) { $DEBUG and warn "\nDumping data for $_\n"; if ($SCREENS) { $screen="$_.sdump" ; $screenR=catfile ($ref_dir, "${screen}_ref"); } $code="$_.cdump" ; $codeR=catfile ($ref_dir, "${code}_ref"); unless ( -f $codeR ) { warn "$0: Reference file $codeR is missing; skipping\n"; next; } $script = catfile( 'Test_Progs', $_ ); # Later on, insert check for "*bogus" scripts to return error system "perl $script" ; $err=$?>>8; # print "\t\t\t$script yielded $err\n"; $DEBUG >2 and system "echo; ls -rlt . | tail -4 "; if ( $err ) { $DEBUG and warn "Module returned $? for $_, $!"; } if ( ! -e $code or ! -f _ or ! -r _ or ! -s _ ) { warn "$code is bad\n"; # system "ls -ld '$code'"; next; } elsif ( $SCREENS and ( ! -e $screen or ! -f _ or ! -r _) ) { # empty could be legit warn "Screen dump for $_ failed: $!\n"; # Keep the evidence for investigation next; } # Do cheap file-size comp first; string comparison later if needed if (!$is_crlf and -s $code != -s $codeR) { warn "\t** Code dumps unequally sized for $_: ", -s $code, " vs. ", -s $codeR, "\n"; push @email_list, "$code\n", "$codeR\n"; $DEBUG >2 and system "ls -li $code $codeR"; # fail ($code); # force test to report failure } if (!$is_crlf and $SCREENS and -s $screen != -s $screenR) { warn "\t** Screen dumps unequally sized for $_: ", -s $screen, " vs. ", -s $screenR, "\n"; push @email_list, "$screen\n", "$screenR\n"; $DEBUG >2 and system "ls -li $screen $screenR"; # fail ($screen); # force tests to report failure } else { # Files don't obviously differ, so next step is to compare bytes open C, "$code" or die "$0: Failed to open ${code}, $!\n"; open C_REF, "$codeR" or die "$0: Failed to open ${code}_ref, $!\n"; if ($SCREENS) { open S, "$screen" or die "$0: Failed to open ${screen}, $!\n"; open S_REF, "$screenR" or die "$0: Failed to open ${screen}_ref, $!\n"; } undef $/; # file-slurping mode defined ($NEW=) or die "$0: Failed to read $code, $!\n"; defined ($REF=) or die "$0: Failed to read $codeR, $!\n"; # if ($_ =~ /bug$/) { warn "BUG FILE: $_\n"; } $ret = ok ($NEW eq $REF, $code); # logical and doesn't work! $DEBUG >2 and system ( "ls -ld $code $codeR" ) ; $ret or warn "Check $code for clues\n"; $ret and !$DEBUG and unlink $code; if ($SCREENS) { defined ($NEW=) or die "$0: Failed to read $screen, $!\n"; defined ($REF=) or die "$0: Failed to read $screenR, $!\n"; $ret = ok ($NEW eq $REF, $screen); $DEBUG >2 and system ( "ls -ld $screen $screenR" ) ; $ret or warn "Check $screen for clues\n" and exit; $ret and !$DEBUG and unlink $screen; } } } @email_list and do { warn "\n** Please email the following files to $author **\n\n", @email_list; warn "\n** Please email the above files to $author **\n"; }; warn "Test Finished\n"; exit 0; sub check_file { my $file=shift || die "check_file: No argument supplied\n"; unless (-e $file and -f _ and -r _ ) { warn "$0: Reference file $codeR is bad\n"; return 0; } else { return 1; } } # vi:sw=2 ts=2: Shell-POSIX-Select-0.09/menu_ls.plx.PL0000755000175000000000000000144714454516447015165 0ustar root# Tim Maher # This script, script.pl.PL, is called by the Make system, with the name of the # script to be created, script.pl as its arg # the contents of script.pl, except for its shebang line, is in script.0, # which is inserted into script.pl by this script, script.pl.PL # NOTE: In this version, the *.0 an *.PL files are in the top-level # distribution directory, but the generated scripts appear under ./Scripts. # Sun May 4 17:01:10 PDT 2003 use Config; $pl_file = shift; ( $basename = $pl_file ) =~ s/\.plx$// or die "$0: Bad scriptname argument; no .plx ending!\n"; $file0="$basename.0"; open IN, "< $file0" or die "Can't open $file0: $!"; open OUT, "> Scripts/$pl_file" or die "Can't create $pl_file: $!"; chmod (0755, "Scripts/$pl_file"); print OUT $Config{startperl}, " -w\n", ; Shell-POSIX-Select-0.09/README0000755000175000000000000000766014454516447013347 0ustar root Shell/POSIX/Select version 0.07 =============================== INSTALLATION To install this module type the following: perl Makefile.PL make test make install DEPENDENCIES This module requires these other modules and libraries: File::Spec::Functions Text::Balanced Filter::Simple ================================================================== NAME Shell::POSIX::Select - The POSIX Shell's "select" loop for Perl PURPOSE This module implements the "select" loop of the "POSIX" shells (Bash, Korn, and derivatives) for Perl. That loop is unique in two ways: it's by far the friendliest feature of any UNIX shell, and it's the *only* UNIX shell loop that's missing from the Perl language. Until now! SYNOPSIS NOTE: In the following, the enclosing square brackets (not typed) identify optional elements, and vertical bars indicate mutually-exclusive choices: select [[my|local|our<]> scalar_var] ( [LIST] ) { [CODE] } The required elements are the keyword "select", the *parentheses*, and the *curly braces*. See "SYNTAX" for details. ELEMENTARY EXAMPLE ship2me2.plx use Shell::POSIX::Select qw($Heading $Prompt); $Heading='Select a Shipper' ; $Prompt='Enter Vendor Number: ' ; select $shipper ( 'UPS', 'FedEx' ) { print "\nYou chose: $shipper\n"; last; } ship ($shipper, $ARGV[0]); # prints confirmation message OUTPUT ship2me2.plx '42 hemp toothbrushes' *Select a Shipper* 1) UPS 2) FedEx Enter Vendor Number: 2 You chose: FedEx Your order has been processed. Thanks for your business! BENEFITS What's so great about this loop? It automates the generation of a numbered menu of choices, prompts for a choice, proofreads that choice and complains if it's invalid (at least in this enhanced implementation), and executes a code-block with a variable set to the chosen value. That saves a lot of coding for interactive programs -- especially if the menu consists of many values! The benefit of bringing this loop to Perl is that it obviates the need for future programmers to reinvent the *Choose-From-A-Menu* wheel. EXPORTS: Default $Reply This variable is "local"ized to each "select" loop, and provides the menu-number of the most recent valid selection. EXPORTS: Optional $Heading $Prompt $Eof SCRIPTS browse_images browse_jpeg browse_records delete_file lc_filename long_listem menu_ls order perl_man pick pick_file AUTHOR Tim Maher MAINTAINER Martin Thurn mthurn@cpan.org ACKNOWLEDGEMENTS I probably never would have even attempted to write this module if it weren't for the provision of Filter::Simple by Damian Conway, which I ruthlessly exploited to make a hard job easy. *The Damian* also gave useful tips during the module's development, for which I'm grateful. I *definitely* wouldn't have ever written this module, if I hadn't found myself writing a chapter on *Looping* for my upcoming Manning Publications book, and once again lamenting the fact that the most friendly Shell loop was missing from Perl. In a fit of zeal, I decided to rectify that oversight! 8-} For more examples of how this loop can be used in Perl programs, watch for my upcoming book, *Minimal Perl: for Shell Users and Programmers* (see ) in early fall, 2003. SEE ALSO man ksh # on UNIX or UNIX-like systems man bash # on UNIX or UNIX-like systems DON'T SEE ALSO perldoc -f select, which has nothing to do with this module (the names just happen to match up). LICENSE Copyright (C) 2002-2003, Timothy F. Maher. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Shell-POSIX-Select-0.09/browse_images.00000755000175000000000000000073614454516447015373 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ; $viewer='/usr/X11R6/bin/xv'; # Popular Linux viewer select ( grep /\.(jpg|gif|tif|png)$/i, <*> ) { system "$viewer $_ &" ; # run viewer in background } Shell-POSIX-Select-0.09/delete_file.00000755000175000000000000000131114454516447014774 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( '$Eof', # for ^D detection prompt => 'Choose file for deletion:' ) ; # Eradicate serpents, like St. Patrick! 8-} OUTER: while ( @files=<*.py> ) { select ( @files ) { print STDERR "Really delete $_? [y/n]: " ; my $answer = ; # ^D sets $Eof below defined $answer or last OUTER ; # exit on ^D $answer eq "y\n" and unlink and last ; } $Eof and last; } Shell-POSIX-Select-0.09/browse_records.00000755000175000000000000000162214454516447015562 0ustar root######################################################### # Sample Program for Perl Module "Shell::POSIX::Select" # # tim@TeachMePerl.com (888) DOC-PERL (888) DOC-UNIX # # Copyright 2002-2003, Tim Maher. All Rights Reserved # ######################################################### use Shell::POSIX::Select ( style => 'Korn' ); if (@ARGV != 2 and @ARGV != 3) { # Could also use Getopt:* module for option parsing die "Usage: $0 fieldnum filename [delimiter]" ; } ( $field, $file, $delim) = @ARGV ; if ( ! defined $delim ) { $delim='[\040\t]+' # SP/TAB sequences } $field-- ; # 2->1, 1->0, etc., for 0-based indexing foreach ( `cat "$file"` ) { # field is the key in the hash, value is entire record $f2r{ (split /$delim/, $_)[ $field ] } = $_ ; } # Show specified fields in menu, and display associated records select $record ( sort keys %f2r ) { print "$f2r{$record}" ; } Shell-POSIX-Select-0.09/Makefile.PL0000755000175000000000000000047314454516447014434 0ustar root#!perl -w use warnings; use strict; # Version number just of this Makefile.PL: our $VERSION = 1.03; use inc::Module::Install; all_from('lib/Shell/POSIX/Select.pm'); requires('Carp'); requires('File::Spec::Functions'); requires('Filter::Simple' => 0.84); requires('Text::Balanced' => 1.97); WriteAll; __END__ Shell-POSIX-Select-0.09/lib/0000755000175000000000000000000014454517773013224 5ustar rootShell-POSIX-Select-0.09/lib/Shell/0000755000175000000000000000000014454517773014273 5ustar rootShell-POSIX-Select-0.09/lib/Shell/POSIX/0000755000175000000000000000000014454517773015175 5ustar rootShell-POSIX-Select-0.09/lib/Shell/POSIX/Select.pm0000755000175000000000000022263514454517257016764 0ustar rootpackage Shell::POSIX::Select; our $VERSION = '0.09'; # TODO: Portable-ize tput stuff # TODO: Dump user's code-block with same line numbers shown in error # messages for debugging ease # TODO: Add option to embolden menu numbers, to distinguish them from # choices that are also numbers # See documentation and copyright notice below =pod section below # Not using Exporter.pm; doing typeglob-based exporting, # using adapted code from Damian's Switch.pm our ( @EXPORT_OK ); our ($Reply, $Heading, $Prompt); @EXPORT_OK = qw( $Heading $Prompt $Reply $Eof ); our ( $U_WARN, $REPORT, $DEBUG, $DEBUG_default, $_DEBUG, ); our ( $U_WARN_default, $_import_called, $U_DEBUG, $DEBUG_FILT ); our ( $sdump, $cdump, $script ); # our ( @ISA, @EXPORT, $PRODUCTION, $LOGGING, $PKG, $INSTALL_TESTING,$ON,$OFF, $BOLD, $SGR0, $COLS ); # What is the maximum number of columns that the user wants to see # on-screen? By default, no maximum -- the number of columns will be # determined by the width of the terminal and the length of the meny # item strings. our $MaxColumns = 99; push @EXPORT_OK, '$MaxColumns'; BEGIN { $PKG = __PACKAGE__ ; $LOGGING = 0; $SIG{TERM}=$SIG{QUIT}=$SIG{INT}= sub { $DEBUG and warn caller(1), "\n"; # must disable reverse-video, if it was turned on defined $ON and $ON ne "" and do { my $reset=($SGR0 || $OFF); defined $reset and warn "$reset\n"; }; $DEBUG and warn "$0: killed by signal\n"; exit 111; # means, killed by signal }; ! defined $_import_called and $_import_called = 0; ( $script = $0 ) =~ s|^.*/||; } sub import ; # advance declaration use File::Spec::Functions (':ALL'); use File::Spec::Functions 0.7; use Filter::Simple 0.84; # Damian's been fixing bugs as I report them, so best to have recent version # This is the oldest version that I know works pretty well use Text::Balanced 1.97 qw(extract_variable extract_bracketed); use Carp; $U_DEBUG=1; $U_DEBUG=0; $DEBUG_FILT=4; # $DEBUG_FILT=0; # $DEBUG=1; # force verbosity level for debugging messages $DEBUG=0; # force verbosity level for debugging messages $REPORT=1; # report subroutines when entered # $REPORT=0; # report subroutines when entered $DEBUG > 0 and warn "Logging is $LOGGING\n"; # controls messages and carp vs. warn (but that doesn't do much) $PRODUCTION=1; $PRODUCTION and $REPORT=$DEBUG_FILT=$DEBUG=0; $DEBUG and disable_buffering(); sub _WARN; sub _DIE; local $_; # avoid clobbering user's by accident $Shell::POSIX::Select::_default_style='K'; # default loop-style is Kornish $Shell::POSIX::Select::_default_prompt= "\nEnter number of choice:"; # I detest the shell's default prompt! $Shell::POSIX::Select::_bash_prompt ='#?'; $Shell::POSIX::Select::_korn_prompt='#?'; $Shell::POSIX::Select::_generic ='#?'; $Shell::POSIX::Select::_arrows_prompt='>>'; $U_WARN_default = 1; # for enabling user-warnings for bad interactive input # $_import_called > 0 or import(); # ensure initialization of defaults my $subname=__PACKAGE__ ; # for identifying messages from outside sub's my $select2foreach; $select2foreach=1; # just translate select into foreach, for debugging $select2foreach=0; # warn "Setting up video modes\n"; # I know about Term::Cap, but this seems more direct and sufficient $Shell::POSIX::Select::_FILTER_CALLS= $Shell::POSIX::Select::_ENLOOP_CALL_COUNT= $Shell::POSIX::Select::_LOOP_COUNT=0; # Number of select loops detected $DEBUG > 3 and $LOGGING and warn "About to call log_files\n"; $LOGGING and log_files(); # open logfiles, depending on DEBUG setting $DEBUG >2 and warn "Import_called initially set to: $_import_called\n"; FILTER_ONLY code_no_comments => \&filter, all => sub { $LOGGING and print SOURCE }; $DEBUG >2 and warn "Import_called set to: $_import_called\n"; $DEBUG >2 and $Shell::POSIX::Select::_testmode and warn "testmode is $Shell::POSIX::Select::_testmode"; use re 'eval'; # Scope for declaration of pre-compiled REs: { my $RE_kw1 = qr^ (\bselect\b) ^x; # extended-syntax, allowing comments, etc. my $RE_kw2 = qr^ \G(\bselect\b) ^x; # extended-syntax, allowing comments, etc. my $RE_decl = qr^ (\s* # grab declarator if there (?: \b my \b| \b local \b| \b our \b ) \s*) ^x; # extended-syntax, allowing comments, etc. my $RE_kw_and_decl = qr^ \bselect\b \s* ( # Next, grab optional declarator and varname if there (?: \b my \b| \b local \b| \b our \b )? \s* )? ^x; # extended-syntax, allowing comments, etc. my $RE_list = qr^ \s* ( # $RE{balanced}{-parens=>'()'} ) ^x; # extended-syntax, allowing comments, etc. my $RE_block = qr^ \s* # Is following really beneficial/necessary? I think I needed it in one case - tfm (?= { ) # ensure opposite of } comes next ( # now find the code-block # $RE{balanced}{-parens=>'{}'} ) ^x; # extended-syntax, allowing comments, etc. sub matches2fields; sub enloop_codeblock; sub filter { my $subname = sub_name(); my $last_call = 0; my $orig_string=$_; my $detect_msg=''; ++$::_FILTER_CALLS; $orig_string ne $_ and die "$_ got trashed"; #/(..)/ and warn "Matched chars: '$1'\n"; # prime the pos marker my $loopnum; # Probably looping out of control if we get this many: my $maxloops = 25; my $first_celador; if ( $last_call = ($_ eq "") ) { return undef ; } else { # TIMJI: Revisit; why is following the default? $detect_msg="SELECT LOOP DETECTED"; $orig_string ne $_ and die "$_ got trashed"; $DEBUG > 1 and show_subs("****** Pre-Pre-WHILE ****** \n",""); $DEBUG > 1 and $LOGGING and print LOG "\$_ is '$_'\n"; $loopnum=0; $DEBUG > 1 and show_subs("****** Pre-WHILE ****** \n",""); while (++$loopnum <= $maxloops) { # keep looping until we can't find any more select loops $loopnum == 2 and $first_celador=$_; $DEBUG > 1 and show_subs("****** LOOKING FOR LOOP ****** #$loopnum\n",""); $loopnum > 25 and warn "$subname: Might be stuck in loop\n"; $loopnum > 100 and die "$subname: Probably was stuck in loop\n"; $DEBUG > 3 and pos() and warn "pos is currently: ", pos(), "\n"; pos()=0; /\S/ or $LOGGING and print LOG "\$_ is all white space or else empty\n"; # /(..)/ and warn "Matched chars: '$1'\n"; # prime the pos marker my ($matched, $can_rewrite) = 0; if ($select2foreach) { # simple conversion, for debugging basic ops # change one word, and select loops with all pieces # present are magically rendered syntactically acceptable # NOTE: will break select() usage! s/\bselect\b/foreach /g and $matched = -1; # All these can be handled in one pass, so exit loop goto FILTER_EXIT; } else { my $pos; my ($match, $start_match); my ($got_kw,$got_decl, $got_loop_var, $got_list, $got_codeblock); my $iteration=0; FIND_LOOP: my ($loop_var, $loop_decl, $loop_list, $loop_block)= ("" x 3); $DEBUG_FILT > 0 and warn "Pos initially at ", pos($_), "\n"; !defined pos() and warn "AT FIND_LOOP, POS IS UNDEF\n"; $match=$got_kw=$got_decl=$got_loop_var=$got_list=$got_codeblock=""; my $matched=0; # means, currently no detected loops that still need replacement # my $RE = ( $loopnum == 1 ? $RE_kw1 : $RE_kw2 ) ; # second version uses \G my $RE = $RE_kw1 ; # always restart from the beginning, of incrementally modified program # Same pattern good now, since pos() will have been reset by mod # my $RE = ( $loopnum == 1 ? $RE_kw1 : $RE_kw1 ) ; # second version uses \G if ( m/$RE/g ) { # try to match keyword, "select" ++$matched ; $match=$1; $start_match=pos() - length $1; $got_kw=1; $DEBUG_FILT > 1 and show_progress($match, pos(), $_); } else { # no more select keywords to process! # LOOP EXIT #1 goto FILTER_EXIT; } $pos=pos(); # remember position if (/\G$RE_decl/g) { ++$matched ; $loop_decl=$1; $match.=" $1"; $got_decl=1; } else { pos()=$pos; # reset to where we left off } $DEBUG_FILT > 1 and show_progress($match, pos(), $_); my @rest; $DEBUG_FILT > 0 and warn "POS before ext-var is now ", pos(), "\n"; ( $loop_var, @rest ) = extract_variable( $_ ); $DEBUG_FILT > 0 and show_subs( "POST- ext-var string is: ", $_, pos(),19); $DEBUG_FILT > 0 and warn "POS after ext-var is now ", pos(), "\n"; if (defined $loop_var and $loop_var ne "" ) { $got_loop_var=1; $DEBUG_FILT > 0 and warn "Got_Loop_Var matched '$loop_var'\n"; $match.=" $loop_var"; } else { pos()=$pos; # reset to where we left off $DEBUG_FILT > 0 and warn "extract_variable failed to match\n"; } $DEBUG_FILT > 1 and show_progress($match, pos(), $_); gobble_spaces(); # $DEBUG_FILT > 0 and warn "Pre-extract_bracketed ()\n"; ( $loop_list, @rest ) = extract_bracketed($_, '()'); if (defined $loop_list and $loop_list ne "") { ++$matched; $got_list=1; $match.=" $loop_list"; $DEBUG_FILT > 1 and show_progress($match, pos(), $_); } else { # no loop list; not our kind of select # warn "extract_bracketed failed to match\n"; # If we didn't find loop var, they're probably using # select() function or syscall, not select loop if ($got_loop_var) { $DEBUG_FILT > 3 and warn "$PKG: Found keyword and loop variable, but no ( LIST )!\n", ; # "If { } really there, try placing 'no $PKG;' after loop to fix.\n"; } else { $DEBUG_FILT > 3 and warn "$PKG: Found keyword, but no ( LIST )\n", "Must be some other use of the word\n"; } $DEBUG_FILT > 0 and warn "giving up on this match; scanning for next keyword (1)"; if (++$iteration < $maxloops) { goto FIND_LOOP; } else { _DIE "$PKG: Maximum iterations reached while looking for select loop #$loopnum"; } } # else gobble_spaces(); # $DEBUG > 1 and warn " DDD sending to extract_bracketed() ===$_===\n"; ( $loop_block, @rest ) = extract_bracketed($_, '{}'); # $DEBUG > 1 and warn " DDD extract_bracketed returned ===$loop_block===\n"; if (defined $loop_block and $loop_block ne "") { ++$matched; $got_codeblock=1; $match.=" $loop_block"; $DEBUG_FILT > 1 and show_progress($match, pos(), $_); } else { # if $var there, can't possibly be select syscall or function use, # so 100% sure there's a problem if ($got_loop_var) { warn "$PKG: Found loop variable and list, but no code-block!\n", ; # "If { } really there, try placing 'no $PKG;' after loop to fix.\n"; } else { $DEBUG_FILT > 3 and warn "$PKG: Found keyword and list,", " but no code-block\n", "Must be some other use of the word\n"; } $DEBUG_FILT > 0 and warn "giving up on this match; scanning for next keyword (2)"; goto FIND_LOOP; } # and print "list_and_block matched '$&'\n"; # defined $& and $match.=$&; # defined $& and $match.="$1 $2"; #defined $& and ($loop_list, $loop_block) = ($1, $2); my $end_match; if ( $matched == 0 ) { die" Can it ever get here?"; goto FILTER_EXIT; } else { $end_match=pos(); $detect_msg=''; if ( $matched == 1 ) { # means "select" keyword only ; } if ( $matched == 2 ) { # means "select" plus decl, var, list, or block $detect_msg="select loop incomplete; "; $got_list or $detect_msg.= "no (LIST) detected\n"; $got_codeblock or $detect_msg.= "no {CODE} detected\n"; } elsif ( $matched >= 3 ) { } } # print "Entire match: $match\n"; # print "Matched Text: ", # substr $_, $start_match, # $end_match-$start_match; if ( $matched > 1 ) { # 1 just means select->foreach conversion $::_LOOP_COUNT++; # counts # detected select-loops $DEBUG > 0 and warn "$PKG: Set debug to: $Shell::POSIX::Select::DEBUG\n"; } # $can_rewrite indicates whether we matched the crucial # parts that allow replacement of the input -- the list and codeblock # If we got both, the $can_rewrite var shows true now $can_rewrite = $matched >= 2 ? 1 : 0; # $DEBUG > 1 and warn "Calling MATCHES2FIELDS with \$loop_list of $loop_list\n"; # $DEBUG > 1 and warn "Calling MATCHES2FIELDS with \$loop_block of ===$loop_block===\n"; if ($can_rewrite) { my $replacer = enloop_codeblock matches2fields ( $loop_decl, $loop_var, $loop_list, $loop_block ), $::_LOOP_COUNT; substr($_, $start_match, ($end_match-$start_match), $replacer ); # print "\n\nModified \$_ is: \n$_\n"; } } } # end while continue { $DEBUG_FILT > 2 and warn "CONTINUING FIND_LOOP\n" ; } #warn "Leaving $subname 1 \n"; } # else FILTER_EXIT: # $Shell::POSIX::Select::filter_output="PRE-LOADING DUMP VAR, loopnum was $loopnum"; if ( 0 # and $DEBUG or $Shell::POSIX::Select::dump_data ) { # print TTY "$detect_msg\nCode 222\n" ; # print TTY "Code 222\n" ; if ($loopnum == 1 and $detect_msg !~ /SELECT LOOP DETECTED/ ) { # $DEBUG and print STDERR "copacetic\n"; # exit 222; # We still need to run the program! } else { $DEBUG >2 and print TTY "LOOP DETECTED: $detect_msg\n"; exit 222; } } # if 0 $loopnum > 0 and $Shell::POSIX::Select::filter_output=$_; # Restore original string-like parts of the code: $Shell::POSIX::Select::filter_output =~ s/$Filter::Simple::placeholder/${$Filter::Simple::components[unpack('N',$1)]}/ge; $LOGGING and print USERPROG $_; # $_ unset 2nd call; label starts below $DEBUG_FILT > 2 and _WARN "Leaving $subname on call #$::_FILTER_CALLS\n"; } # end sub filter } # Scope for declaration of filters' REs sub show_progress { my $subname = sub_name(); my ($match, $pos, $string) = @_; ! defined $match or $match eq "" and warn "$subname: \$match is empty\n"; show_subs( "Match so far: ", $match, 0, 99); defined $pos and warn "POS is now $pos\n"; show_subs( "Remaining string: ", $string, $pos, 19); } # show_progress sub show_context { my $subname = sub_name(); my ($left, $match, $right) = @_; $DEBUG > 0 and warn "left/match/right: $left/$match/$right"; show_subs( "Left is", $left, -10); show_subs( "Right is", $right, 0, 10); } # show_context # Following sub converts matched elements of users source into the # fields we need: declaration (optional), loop_varname (optional), codeblock sub matches2fields { my $subname = sub_name(); my $default_loopvar = 0; my ( $debugging_code, $codeblock2, ); my ( $decl, $loop_var, $values, $codeblock, $fullmatch ) = @_; $debugging_code = ""; if ($U_DEBUG > 3) { $debugging_code = "\n# USER-MODE DEBUGGING CODE STARTS HERE\n"; $debugging_code .= '; $,="/"; warn "Caller is now: ", (caller 0), "\n";'; $debugging_code .= 'warn "Caller 3 is now: ", ((caller 0)[3]), "\n";'; $debugging_code .= 'warn "\@_ is: @_\n";'; $debugging_code .= 'warn "\@ARGV is: @ARGV\n";'; # $debugging_code .= # 'warn "\@looplist is : @Shell::POSIX::Select::looplist\n"'; $debugging_code .= "# USER-MODE DEBUGGING CODE ENDS HERE\n\n"; $debugging_code .= ""; } if ( !defined $values or $values =~ /^\s*\(\s*\)\s*$/ ) { # ( ) is legit syntax # warn "values is undef or vacant"; # Code to let user prog figure out if select loop is in sub, # and if so, selects @_ for default LIST $values = # supply appropriate default list, depending on programmer's context 'defined ((( caller 0 )[3]) and ' . ' (( caller 0 )[3]) ne "") ? @_ : @ARGV ' ; } if ( defined $decl and $decl ne "" and defined $loop_var and $loop_var ne "" ) { $LOGGING and print LOG "LOOP: Two-part declaration,", " scoper is: $decl, varname is $loop_var\n"; } elsif ( defined $decl and $decl ne "" and (! defined $loop_var or $loop_var eq "") ) { $LOGGING and print LOG "LOOP: Declaration without variable name: $decl" ; warn "$PKG: variable declarator ($decl) provided without variable name\n"; warn "giving up on this match; scanning for next keyword (3)"; goto FIND_LOOP; } elsif ( defined $loop_var and $loop_var ne "" and (! defined $decl or $decl eq "") ) { $LOGGING and print LOG "LOOP: Variable without declaration (okay): $loop_var" } else { $LOGGING and print LOG "LOOP: zero-word declaration\n"; my $default_loopvar = 1; ($decl, $loop_var) = qw (local $_); # default loop var; package scope } if ( !defined $codeblock or $codeblock =~ /^\s*{\s*}\s*$/ ) { # default codeblock prints the selection; good for grep()-like filtering # NOTE: Following string must start/end with {} $codeblock = "{ print \"$loop_var\\n\" ; # ** USING DEFAULT CODEBLOCK ** }"; } # I've already extracted what could be a valid variable name, # but the regex was kinda sleazy, so it's time to validate # it using TEXT::BALANCED::extract_variable() # But I found a bug, it rejects $::var*, so exempt that form from check unless ($default_loopvar or $loop_var =~ /^\$::\w+/) { # don't check if I inserted it myself, or is in form $::stuff, # which extract_variable() doesn't properly extract $DEBUG > 1 and warn "Pre-extract_variable 3\n"; # Now let's see if Damian likes it: my ( $loop_var2, @rest ) = extract_variable($loop_var); if ( $loop_var2 ne $loop_var ) { $DEBUG > 1 and warn "$PKG: extracted var diff from parsed var: ", $DEBUG > 0 and warn "$PKG: varname for select loop failed validation", " #$::_LOOP_COUNT: $loop_var\n"; } } else { ; } !defined $decl and $decl = ""; # okay for this to be empty string; means user wants it global, or # declared it before loop # make version of \$codeblock without curlies at either end ( $codeblock2 = $codeblock ) =~ s/\A\s*\{\s*|\s*\}\s*\z//g; defined $decl and $decl eq 'unset' and undef $decl; # pass as undef # $DEBUG > 1 and warn " DDD matches2fields() is returning codeblock2 ===$codeblock2===\n"; return ( $decl, $loop_var, $values, $codeblock2, $debugging_code ); } # matches2fields sub enloop_codeblock { # Wraps code implementing select-loop around user-supplied codeblock my $subname = sub_name(); $Shell::POSIX::Select::_ENLOOP_CALL_COUNT++; my ( $decl, $loop_var, $values, $codestring, $dcode, $loopnum ) = @_; (defined $values and $values ne "") or do { $DEBUG > 1 and _WARN "NO VALUES! Using dummy ones"; $values = '( dummy1, dummy2 )'; }; my $declaration = ( defined $decl and $decl ne "" ) ? "$decl $loop_var; " . ' # LOOP-VAR DECLARATION REQUESTED (perhaps by default)' : " ; # NO DECLARATION OF LOOP-VAR REQUESTED"; my $arrayname = $PKG . '::looplist'; my $NL = '\n'; # Now build the code for the user-prog to run my @parts; # Start new scope first, so if user has LOOP: label before select, # it applies to the whole encapsulated loop # wrapper scope needed so user can LABEL: select(), and not *my* label push @parts, qq( # Code generated by $PKG v$VERSION, by tim(AT)TeachMePerl.com # NOTA BENE: Line 1 of this segment must start with {, so user can LABEL it { # **** NEW WRAPPER SCOPE FOR SELECTLOOP #$loopnum **** \$${PKG}::DEBUG > 1 and $loopnum == 1 and warn "LINE NUMBER FOR START OF USER CODE_BLOCK IS: ", __LINE__, "\\n"; _SEL_LOOP$loopnum: { # **** NEW SCOPE FOR SELECTLOOP #$loopnum **** ); # warn " DDD LOGGING is now $LOGGING\n"; $LOGGING and (print PART1 $parts[0] or _DIE "failed to write to PART1\n"); $DEBUG > 4 and warn "SETTING $arrayname to $values\n"; push @parts, qq( # critical for values's contents to be resolved in user's scope local \@$arrayname=$values; local \$${PKG}::num_values=\@$arrayname; \$${PKG}::DEBUG > 4 and do { warn "ARRAY VALUES ARE: \@$arrayname\\n"; warn "NUM VALUES is \$${PKG}::num_values\\n"; warn "user-program debug level is \$${PKG}::U_WARN\\n"; }; $declaration # loop-var declaration appears here ); $LOGGING and (print PART2 $parts[1] or _DIE "failed to write to PART1\n"); $DEBUG > 4 and do { warn "\$codestring is: $codestring\n"; warn "\$dcode is: '$dcode'\n"; warn "\$arrayname is: $arrayname\n"; !defined $Shell::POSIX::Select::_autoprompt and warn "autoprompt is unset"; !defined $codestring and warn "codestring is unset"; }; { # local scope for $^W mod # getting one pesky "uninit var" warnings I can't resolve local $^W=0; push @parts, qq( $dcode; local ( \$${PKG}::Prompt[$loopnum], \$${PKG}::menu ) = ${PKG}::make_menu( \$${PKG}::Heading || "", \$${PKG}::Prompt || "" , # Might be overridden in make_menu \@$arrayname ); # no point in prompting a pipe! local \$${PKG}::do_prompt[$loopnum] = (-t) ? 1 : 0 ; $DEBUG > 2 and warn "do_prompt is \$${PKG}::do_prompt[$loopnum]\\n"; if ( defined \$${PKG}::menu ) { # No list, no iterations! while (1) { # for repeating prompt for selections # localize, so I don't have to reset $Reply for # outer loop on exit from inner local (\$Reply); while (1) { # for validating user's input local \$${PKG}::bad = 0; # local decl suppresses newline on prompt when -l switch turned on { local \$\\; if (\$${PKG}::do_prompt[$loopnum]) { # When transferring from INNER to OUTER loop, # extra NL before prompt is visually desirable if ( \$${PKG}::_extra_nl) { print STDERR "\\n\\n"; \$${PKG}::_extra_nl=0; } print STDERR "\$${PKG}::menu$NL$ON\$${PKG}::Prompt[$loopnum]$OFF$BOLD "; } } # \$${PKG}::do_prompt=$Shell::POSIX::Select::_autoprompt; # constant prompting depends on style \$${PKG}::do_prompt[$loopnum]= 0; if ( \$${PKG}::dump_data ) { \$Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic\n"; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } else { # \$^W=0; # warn "Waiting for input"; \$Eof=0; \$Reply = ; # warn "Got input"; # \$^W=1; if ( !defined( \$Reply ) ) { defined "$BOLD" and "$BOLD" ne "" and print STDERR "$SGR0"; # need to undef loop var; user may check it! undef $loop_var; # last ${PKG}::_SEL_LOOP$loopnum; # Syntax error! # If returning to outer loop, show the prompt for it # warn "User hit ^D"; if ( $loopnum > 1 and -t ) { # reset prompting for outer loop \$${PKG}::do_prompt[$loopnum-1] = 1; \$${PKG}::_extra_nl=1; } $DEBUG > 2 and warn "Lasting out of _SEL_LOOP$loopnum\\n"; \$Eof=1; last _SEL_LOOP$loopnum; } !defined \$Reply and die "REPLY accessed, while undefined"; chomp \$Reply; # undo emboldening of user input defined "$BOLD" and "$BOLD" ne "" and print STDERR "$SGR0"; #print STDERR "\$${PKG}::menu$NL$ON\$${PKG}::Prompt$OFF$BOLD "; if ( \$Reply eq "" ) { # interpreted as re-print menu request # Empty input is legit, means redisplay menu \$${PKG}::U_WARN > 1 and warn "\\tINPUT IS: empty\\n"; \$${PKG}::bad = \$${PKG}::do_prompt[$loopnum] = 1; } elsif ( \$Reply =~ /\\D/ ) { # shouldn't be any non-digit! \$${PKG}::U_WARN > 0 and warn "\\tINPUT CONTAINS NON-DIGIT: '\$Reply'\\n"; \$${PKG}::bad = 1; # Korn and Bash shell just ignore this case } elsif ( \$Reply < 1 or \$Reply > \$${PKG}::num_values ) { \$${PKG}::U_WARN > 0 and warn "\\t'\$Reply' IS NOT IN RANGE: 1 - \$${PKG}::num_values\\n"; \$${PKG}::bad = 1; # Korn and Bash shell just ignore this case } # warn "BAD is now: \$${PKG}::bad"; \$${PKG}::bad or $DEBUG > 2 and warn "About to last out of Reply Validator Loop\n"; \$${PKG}::bad or last; # REPLY VALIDATOR EXITED HERE } # if for validating user input } # infinite while for validating user input $loop_var = \$$arrayname\[\$Reply - 1]; # set users' variable # USER'S LOOP-BLOCK BELOW $codestring; # USER'S LOOP-BLOCK ABOVE # Making sure there's colon (maybe # even two) after codestring above, # in case user omitted after last # statement in block. I might add # another statement below it someday! $DEBUG > 2 and warn "At end of prompt-repeating loop \n"; } # infinite while for repeating collection of selections $DEBUG and warn "BEYOND end of prompt-repeating loop \n"; } # endif (defined \$${PKG}::menu) else { \$${PKG}::DEBUG > 0 and warn "$PKG: Select Loop #$loopnum has no list, so no iterations\\n"; if ( \$${PKG}::dump_data ) { \$Reply = undef; # dump filtered source for comparison against expected print STDERR "copacetic\n"; # ensure some output, and flush pending exit 222; # code for graceful, expected, early exit } } # return omitted above, to get last expression's value # returned automatically, just like shell's version ); # push onto parts ender } # local scope for $^W mod $LOGGING and (print PART3 $parts[2] or _DIE "failed to write to PART3\n"); push @parts, qq( } # **** END NEW SCOPE FOR SELECTLOOP #$loopnum **** } # **** END WRAPPER SCOPE FOR SELECTLOOP #$loopnum **** # vi:ts=2 sw=2: ); $LOGGING and (print PART4 $parts[3] or _DIE "failed to write to PART4\n"); # Following is portable PART-divider, used to isolate chunk # with unitialized value causing warning # ); push @parts, qq( return ( join "", @parts ); # return assembled code, for user to run } # enloop_codeblock sub make_menu { my $subname = sub_name(); # Replacement of empty list by @_ or @ARGV happens in matches2fields # Here we check to see if we got arguments from somewhere # Note that it's not necesssarily an error if there are no values, # that just means we won't do any iterations my ($heading) = shift; my ($prompt) = shift; my (@values) = @_; unless (@values) { return ( undef, undef ); # can't make menu out of nothing! } my ( $l, $l_length ) = 0; my $count = 5; my ( $sep, $padding ) = "" x 2; my $choice = ""; # Find longest string value in selection list my $v_length = 0; for ( my $i = 0 ; $i < @values ; $i++ ) { ( $l = length $values[$i] ) > $v_length and $v_length = $l; } $DEBUG > 3 and $LOGGING and print LOG "Longest value is $v_length chars\n"; # Figure out lengths of labels (numbers on menu selections) $DEBUG > 3 and $LOGGING and print LOG "Number of values is ", scalar @values, "\n"; @values >= 10_000 ? $l_length = 5 : @values >= 1_000 ? $l_length = 4 : @values >= 100 ? $l_length = 3 : @values >= 10 ? $l_length = 2 : @values > 0 ? $l_length = 1 : undef $l_length; $DEBUG > 3 and $LOGGING and print LOG "Label length is $l_length\n"; if ( !defined $l_length ) { return undef; } $sep = "\040\040"; my $l_sep = length $sep; # separator 'tween pieces # Figure out how many columns per line we can print # 2 is for : after label # TIMJI: Convert to using YUMPY's Term::Size::Heuristic here, later on my $one_label = ( $l_length + 2 ) + $v_length + $l_sep; my $columns = int( $COLS / $one_label ); $columns < 1 and $columns = 1; # Do not let the number of columns grow beyond the maximum: if ($MaxColumns < $columns) { $columns = $MaxColumns; } # if # $DEBUG > 3 and #HERE $LOGGING and print LOG "T-Cols, Columns, label: $COLS, $columns, $one_label\n"; # Prompt may have been set in import() according to a submitted option; # if so, keep it. If not, use shell's default $prompt = (defined $Shell::POSIX::Select::Prompt and $Shell::POSIX::Select::Prompt ne "") ? $Shell::POSIX::Select::Prompt : defined $ENV{Select_POSIX_Shell_Prompt} ? $ENV{Select_POSIX_Shell_Prompt} : $Shell::POSIX::Select::_default_prompt; ; $DEBUG > 3 and $LOGGING and print LOG "Making menu\n"; { local $, = "\n"; } my $menu; $menu = defined $heading ? "${ON}$heading$OFF" : "" ; $menu.="\n"; # $columns == 0 and die "Columns is zero!"; for ( my $i = 0, my $j = 1 ; $i < @values ; $i++, $j++ ) { $menu .= sprintf "%${l_length}d) %-${v_length}s$sep", $j, $values[$i]; $j % $columns or $menu .= sprintf "\n"; # format $count items per line # For 385 line list: # Illegal modulus zero at /pmods/yumpy/Select/Shell/POSIX/Select.pm line 764. } return ( $prompt, $menu ); } # make_menu sub log_files { my $subname = sub_name(); my ($dir, $sep); if ( $LOGGING == 1 ) { $dir = tmpdir(); # # USERPROG shows my changes, with control-chars # filling in as placeholders for some pieces. For # debugging purposes, I find it helpful to print that # out ASAP so I have something to look at if the # program bombs out before SOURCE gets written out, # which is the same apart from placeholders being # converted to original data. # $DEBUG > 1 and $LOGGING > 0 and warn "Opening log files\n"; open LOG, '>', catfile($dir, 'SELECT_log') or _DIE "Open LOG failed, $!\n"; open SOURCE, '>', catfile($dir, 'SELECT_source') or _DIE "Open SOURCE failed, $!\n"; open USERPROG, '>', catfile($dir, 'SELECT_user_program') or _DIE "Open USERPROG failed, $!\n"; open PART1, '>', catfile($dir, 'SELECT_part1') or _DIE "Open PART1 failed, $!\n"; open PART2, '>', catfile($dir, 'SELECT_part2') or _DIE "Open PART2 failed, $!\n"; open PART3, '>', catfile($dir, 'SELECT_part3') or _DIE "Open PART3 failed, $!\n"; open PART4, '>', catfile($dir, 'SELECT_part4') or _DIE "Open PART4 failed, $!\n"; $LOGGING++; # to avoid 2nd invocation $DEBUG > 1 and $LOGGING > 0 and warn "Finished with log files\n"; } elsif ($LOGGING > 1) { $DEBUG > 0 and warn "$subname: Logfiles opened previously\n"; } else { $DEBUG > 0 and warn "$subname: Logfiles not opened\n"; } } # log_files sub sub_name { my $callers_name = (caller 1)[3] ; if ( ! defined $callers_name ) { $callers_name='Main_program'; # must be call from main } else { $callers_name =~ s/^.*:://; # strip package name $callers_name .= '()'; # sub_name -> sub_name() } return $callers_name; } # sub_name sub _WARN { my $subname = sub_name(); $PRODUCTION ? carp(@_) : warn (@_); } sub _DIE { my $subname = sub_name(); $DEBUG and warn "$0: In _DIE, with PRODUCTION of $PRODUCTION, arg of @_\n"; $PRODUCTION ? croak(@_) : die (@_); } sub ignoring_case { lc $a cmp lc $b } sub import { local $_; my $subname = sub_name(); my %import; $_import_called++; shift; # discard package name $Shell::POSIX::Select::U_WARN = $Shell::POSIX::Select::U_WARN_default; $Shell::POSIX::Select::_style = $Shell::POSIX::Select::_default_style; # $Shell::POSIX::Select::_prompt = # Prompt is now established in make_menu, during run-time $Shell::POSIX::Select::_autoprompt=0; # First, peel off symbols to import, if any # warn "Caller of $subname is ", scalar caller, "\n"; my $user_pkg=caller; # $DEBUG > 2 and for (my $i=0; $i<@_; $i++) { my $found=0; foreach (@EXPORT_OK) { # Handle $Headings, etc. if ($_[$i] eq $_) { $import{$_} = $i; $found++; last; } } # stop as soon as first non-symbol encountered, so as not to # accidentally mess with following hash-style options $found==0 and last; } %import and export($user_pkg, keys %import); # create aliases for user # following gets "attempt to delete unreferenced scalar"! # %import and delete @_[values %import]; # Delete from @_ each map { delete $_[$_] } values %import; # but this works # warn "Numvals in array is ", scalar @_, "\n"; @_= grep defined, @_; # reset, to eliminate extracted imports # warn "Numvals in array is now ", scalar @_, "\n"; # warnings sets user-program debugging level # debug sets module's debuging level my @legal_options = qw( style prompt testmode warnings debug logging ); my %options = hash_options(\@legal_options, @_ ); # style => Korn, etc. my @styles=qw( bash korn ); my @prompts=qw( generic korn bash arrows ); my @testmodes=qw( make foreach ); my $bad; # timji: Loopify this section later, once it gets stable # "logging" enables/disables logging of filter output to file $_ = $ENV{Shell_POSIX_Select_logging} || $options{logging}; if (defined) { # unless ( is_unix() ) { # warn "$PKG\::$subname: logging is only for UNIX-like OSs\n"; # } if (/^(\d)$/ and 0 <= $1 and $1 <=1 ) { $LOGGING = $_; $DEBUG > 0 and warn "$PKG: Set logging to: $LOGGING\n"; } else { _WARN "$PKG\::$subname: Invalid logging level '$_'\n"; $DEBUG > 1 and _DIE; } } # "debug" enables/disables informational messages while running user program $_ = $ENV{Shell_POSIX_Select_warnings} || $options{warnings}; $select2foreach=0; if (defined) { if (/^\d+$/) { $Shell::POSIX::Select::U_WARN = $_; warn "$PKG: Set warnings to: $Shell::POSIX::Select::U_WARN\n"; } else { _WARN "$PKG\::$subname: Invalid warnings level '$_'\n"; $DEBUG > 1 and _DIE; } } # "debug" enables/disables informational messages while running user program $_ = $ENV{Shell_POSIX_Select_debug} || $options{debug}; if (defined) { if (/^\d+$/) { $Shell::POSIX::Select::DEBUG = $_; } else { _WARN "$PKG\::$subname: Invalid debug option '$_'\n"; $DEBUG > 1 and _DIE; } } $_=$ENV{Shell_POSIX_Select_style} || $options{style}; if (defined) { my $found=0; foreach my $style (@styles) { if ($_ =~ /^$style$/i ) { # korn, bash,etc. # code as K, B, etc. $Shell::POSIX::Select::_style = uc substr($_,0,1); $found++; # last one wins } } if (! $found) { _WARN "$PKG\::$subname: Invalid style option '$_'\n"; $DEBUG > 1 and _DIE; } } # Bash automatically shows prompt every time, # Ksh only does if user enters input of only my $autoprompt=0; if ( $Shell::POSIX::Select::_style eq 'K' ) { $autoprompt=0; } elsif ( $Shell::POSIX::Select::_style eq 'B' ) { $autoprompt=1; } $Shell::POSIX::Select::_autoprompt = $autoprompt; $_ = $ENV{Shell_POSIX_Select_prompt} || $options{prompt} ; if (defined) { $_=lc $_; my $found=0; foreach my $prompt (sort @prompts) { # sorting, so "generic" choice beats shell-specific ones if ($_ =~ /^$prompt$/i ) { $_ eq 'generic' and do { $DEBUG > 0 and warn "Set generic prompt"; $Shell::POSIX::Select::_prompt = $Shell::POSIX::Select::_generic; ++$found and last; die 33; }; $_ eq "korn" and do { $Shell::POSIX::Select::_prompt = $Shell::POSIX::Select::_korn_prompt; $found++; last; }; $_ eq "bash" and do { $Shell::POSIX::Select::_prompt = $Shell::POSIX::Select::_bash_prompt; $found++; last; }; $_ eq "arrows" and do { $Shell::POSIX::Select::_prompt = $Shell::POSIX::Select::_arrows_prompt; $found++; last; }; } # If not a prompt keyword, must be literal prompt do { $Shell::POSIX::Select::_prompt = $_; $found++; last; }; } if (! $found) { _WARN "$PKG\::$subname: Invalid prompt option '$_'\n"; $DEBUG > 1 and _DIE; } } $Shell::POSIX::Select::dump_data=0; $_= $ENV{Shell_POSIX_Select_testmode} || $options{testmode} ; if (defined) { my $found=0; #foreach my $mode ( @testmodes ) { if ($_ =~ /^make$/i ) { $Shell::POSIX::Select::_testmode= 'make'; $Shell::POSIX::Select::dump_data=1; $found++; } elsif ($_ =~ /^foreach$/i ) { $Shell::POSIX::Select::_testmode= 'foreach'; $select2foreach=1; $found++; } else { $Shell::POSIX::Select::_testmode= ''; $DEBUG > 2 and _WARN "Unrecognized testmode: $_\n"; } #} if (! $found) { _WARN "$PKG\::$subname: Invalid testmode option '$_'\n"; $DEBUG > 1 and _DIE; } } # ENV variable overrides program spec ( ! defined $Shell::POSIX::Select::_testmode or $Shell::POSIX::Select::_testmode eq "" ) and $Shell::POSIX::Select::_testmode = ""; $DEBUG > 2 and warn "37 Testmode set to $Shell::POSIX::Select::_testmode\n"; $LOGGING and log_files(); $ENV{Shell_POSIX_Select_reference} and $Shell::POSIX::Select::dump_data = 'Ref_Data'; # Don't assume /dev/tty will work on user's platform! if ( $Shell::POSIX::Select::dump_data ) { # must ensure all output gets flushed to dumpfile before exiting disable_buffering(); #if ( ! $PRODUCTION ) { $Shell::POSIX::Select::_TTY=0; # What's the OS-portable equivalent of "/dev/tty" in the above? if ( -c '/dev/tty' ) { if ( open TTY, '> /dev/tty' ) { $Shell::POSIX::Select::_TTY=1; } else { _WARN "Open of /dev/tty failed, $!\n"; } } #} $sdump = qq/$script.sdump/; if ($Shell::POSIX::Select::dump_data =~ /[a-z]/i) { $sdump = catfile($Shell::POSIX::Select::dump_data, $sdump .'_ref'); } else { # TODO: probably should put it in the same # folder as the original program being # analyzed, rather than '.': $sdump = catfile('.', $sdump); } ($cdump = $sdump) =~ s/$script\.sdump/$script.cdump/; # make code-dump name too # HERE next two lines squelch # Make reference copies of dumps for distribution, or test copies, # depending on ENV{reference} set or testmode=make close STDERR or die "$PKG-END(): Failed to close 'STDERR', $!\n"; open STDERR, "> $sdump" or die "$PKG-END(): Failed to open '$sdump' for writing, $!\n"; open STDOUT, ">&STDERR" or die "$PKG-END(): Failed to dup STDOUT to STDERR, $!\n"; } ( $ON , $OFF , $BOLD , $SGR0 , $COLS ) = display_control ($Shell::POSIX::Select::dump_data); 1; } # import sub export { # appropriated from Switch.pm my $subname = sub_name(); # $offset = (caller)[2]+1; my $pkg = shift; no strict 'refs'; # All exports are scalard vars, so strip sigils and poke in package name foreach ( map { s/^\$//; $_ } @_ ) { # must change $Reply to Reply, etc. *{"${pkg}::$_"} = \${ "Shell::POSIX::Select::$_" }; # "Shell::POSIX::Select::$_"; } # *{"${pkg}::__"} = \&__ if grep /__/, @_; 1; } sub hash_options { my $ref_legal_keys = shift; my %options = @_ ; my $num_options=keys %options; my %options2 ; my $subname = sub_name(); if ($num_options) { my @legit_options = grep { "@$ref_legal_keys" =~ /\b $_ \b/x } sort ignoring_case keys %options; my @illegit_options = grep { "@$ref_legal_keys" !~ /\b $_ \b/x } sort ignoring_case keys %options; @options2{sort ignoring_case @legit_options} = @options{sort ignoring_case @legit_options } ; { # scope for local change to $, local $,=' '; if ($num_options > keys %options2) { # options filtered out? my $msg= "$PKG\::$subname:\n Invalid options: " ; $msg .= "@illegit_options\n"; _DIE; # Can't be conditional on DEBUG setting, # because that comes after this sub returns! } } } return %options2; } sub show_subs { # show sub-string in reverse video, primarily for debugging my $subname = sub_name(); @_ >= 1 or die "${PKG}\::subname: no arguments\n" ; my $msg=shift || ''; my $string=(shift || ''); my $start=(shift || 0); my $length=(shift || 9999); $string =~ s/[^[[:alpha:]\d\s]]/-/g; # control-chars screw up printing # warn "Calling substr for parms $string/$start/$length\n"; warn "$msg", $ON, substr ($string, $start, $length), $OFF, "\n"; } sub gobble_spaces { my $subname = sub_name(); my $pos=pos(); # remember current position if (/\G\s+/g) { $DEBUG_FILT > 1 and warn "$subname: space gobbler matched '$&' of length ", length $&, "\n" ; } else { $DEBUG_FILT > 1 and warn "$subname: space gobbler matched nothing\n"; pos()=$pos; # reset to prior position } $pos=pos(); # identify current position } sub display_control { my $subname = sub_name(); my $flag=shift; my ( $on , $off , $bold , $sgr0 , $cols ) ; # in "make" or "reference" testmodes, mustn't clutter output with coloration # Disable screen manips for reference source-code dumps unless ( $flag ) { if ( is_unix() and defined $ENV{TERM} and ! system 'tput -V >/dev/null 2>&1' ) { # Always need column count # for menu sizing $cols=`tput cols`; defined $COLS and chomp ($COLS) ; if ($flag ne 'make') { $on=`tput smso`; $off=`tput rmso` || `tput sgr0`; $bold=`tput bold`; # for prettifying screen captures $sgr0=`tput sgr0`; # for prettifying screen captures } } else { } $DEBUG > 2 and warn "Returning $on , $off , $bold , sgr0 , $cols \n"; } return ($on || "", $off || "", $bold || "", $sgr0 || "", $cols || 80); } END { # END block # sdump means screen-dump, cdump means code-dump if ( $Shell::POSIX::Select::dump_data ) { if ( $ENV{Shell_POSIX_Select_reference} ) { } else { } my $pwd=curdir(); # $Shell::POSIX::Select::_TTY and # dump filtered source, for reference or analysis unless (open SOURCE, "> $cdump") { $Shell::POSIX::Select::_TTY and print TTY "$PKG-END(): Failed to open '$cdump' for writing, $!\n" and warn "$PKG-END(): Failed to open '$cdump' for writing, $!\n" ; die; } defined $Shell::POSIX::Select::filter_output and (print SOURCE $Shell::POSIX::Select::filter_output or die "$PKG-END(): Failed to write to '$cdump', $!\n"); # system "ls -li $cdump $sdump"; } # Screen dumping now arranged in sub import() # open SCREEN, "> $script.sdump" or # die "$PKG-END(): Failed to open '$script.sdump' for writing, $!\n"; else { defined $SGR0 and $SGR0 ne "" and print STDERR "$SGR0"; # ensure turned off $DEBUG > 1 and $LOGGING and print LOG "\n$PKG finished\n"; print STDERR "\n"; # ensure shell prompt starts on fresh line } exit 0; } sub is_unix { if ( # I'm using the $^O from File::Spec, which oughta know # and guessing at others; help! $^O =~ /^(MacOS|MSWin32|os2|VMS|epoc|NetWare|dos|cygwin)$/ix ) { $DEBUG > 2 and warn "Operating System not UNIX;", $^O, "\n"; } else { $DEBUG > 2 and warn "Operating System reported as ", $^O, "\n"; } return defined $1 ? 0 : 1 ; } sub disable_buffering { my $old_fh = select (STDERR); $|=1; select ($old_fh); return 0; } =pod =head1 NAME Shell::POSIX::Select - The POSIX Shell's "select" loop for Perl =head1 PURPOSE This module implements the C [ [ my | local | our ] scalar_var ] B<(> [LIST] B<)> B<{> [CODE] B<}> select [ [my|local|our] scalar_var ] ( [LIST] ) { [CODE] } In the above, the enclosing square brackets I<(not typed)> identify optional elements, and vertical bars separate mutually-exclusive choices: The required elements are the keyword C loop's prompt with a valid input (i.e., a number in the correct range), the variable C<$Reply> is set within the loop to that number. Of course, the actual item selected is usually of great interest than its number in the menu, but there are cases in which access to this number is useful (see L<"menu_ls.plx"> for an example). =head1 OVERVIEW This loop is syntactically similar to Perl's C loop, and functionally related, so we'll describe it in those terms. foreach $var ( LIST ) { CODE } The job of C is to run one iteration of CODE for each LIST-item, with the current item's value placed in Cized C<$var> (or if the variable is missing, Cized C<$_>). select $var ( LIST ) { CODE } In contrast, the C is like an interactive, multiple-choice version of a C loop. And that's cool! What's I so cool is that C loop of the Korn and Bash ("POSIX") shells for Perl. It accomplishes this through Filter::Simple's I service, allowing the programmer to blithely proceed as if this control feature existed natively in Perl. The Bash and Korn shells differ slightly in their handling of C loop uses Cized C<$_> by default (as does the native C loop). See L<"SYNTAX"> for details. The interface and behavior of the Shell versions has been retained where deemed desirable, and sensibly modified along Perlish lines elsewhere. Accordingly, the (primary) default LIST is B<@ARGV> (paralleling the Shell's B<"$@">), menu prompts can be customized by having the script import and set B<$Prompt> (paralleling the Shell's B<$PS3>), and the user's response to the prompt appears in the variable B<$Reply> (paralleling the Shell's B<$REPLY>), Cized to the loop. A deficiency of the shell implementation is the inability of the user to provide a I for each C loop. See L<"IMPORTS AND OPTIONS"> for details. Headings and prompts are displayed in reverse video on the terminal, if possible, to make them more visually distinct. Some shell versions simply ignore bad input, such as the entry of a number outside the menu's valid range, or alphabetic input. I can't imagine any argument in favor of this behavior being desirable when input is coming from a terminal, so this implementation gives clear warning messages for such cases by default (see L<"Warnings"> for details). After a menu's initial prompt is issued, some shell versions don't show it again unless the user enters an empty line. This is desirable in cases where the menu is sufficiently large as to cause preceding output to scroll off the screen, and undesirable otherwise. Accordingly, an option is provided to enable or disable automatic prompting (see L<"Prompts">). This implementation always issues a fresh prompt when a terminal user submits EOF as input to a nested C behaves differently than the native C loop, which nowadays employs automatic localization. foreach $othervar ( ) { } # variable localized automatically print "$othervar DOES NOT RETAIN last value from loop here\n"; select $othervar ( ) { } # variable in scope, or global print "$othervar RETAINS last value from loop here\n"; This difference in the treatment of variables is intentional, and appropriate. That's because the whole point of C loop's variable as C. Another deficiency of the Shell versions is that it's difficult for the programmer to differentiate between a C loop (see L<"Eof Detection">). =head1 IMPORTS AND OPTIONS =head2 Syntax use Shell::POSIX::Select ( '$Prompt', # to customize per-menu prompt '$Heading', # to customize per-menu heading '$MaxColumns', # to limit visual number of columns of choices '$Eof', # T/F for Eof detection # Variables must come first, then key/value options prompt => 'Enter number of choice:', # or 'whatever:' style => 'Bash', # or 'Korn' warnings => 1, # or 0 debug => 0, # or 1-5 logging => 0, # or 1 testmode => , # or 'make', or 'foreach' ); I The values shown for options are the defaults, except for C, which doesn't have one. =head2 Prompts There are two ways to customize the prompt used to solicit choices from C loop, or are content to use the same prompt for every loop. It allows a custom interactive prompt to be set in the B statement. The prompt string should not end in a whitespace character, because that doesn't look nice when the prompt is highlighted for display (usually in I). To offset the cursor from the prompt's end, I is inserted automatically after display highlighting has been turned off. If the environment variable C<$ENV{Shell_POSIX_Select_prompt}> is present, its value overrides the one in the B statement. The default prompt is "Enter number of choice:". To get the same prompt as provided by the Korn or Bash shell, use C<< prompt =>> Korn >> or C<< prompt => Bash >>. =head3 The $Prompt variable The programmer may also modify the prompt during execution, which may be desirable with nested loops that require different user instructions. This is accomplished by importing the $Prompt variable, and setting it to the desired prompt string before entering the loop. Note that imported variables have to be listed as the initial arguments to the C directive, and properly quoted. See L<"order.plx"> for an example. NOTE: If the program's input channel is not connected to a terminal, prompting is automatically disabled (since there's no point in soliciting input from a I!). =head2 $Heading The programmer has the option of binding a heading to each loop's menu, by importing C<$Heading> and setting it just before entering the associated loop. See L<"order.plx"> for an example. =head2 $Eof A common concern with the Shell's C loop. See L<"lc_filename.plx"> for a programming example. =head2 Number of Columns By default, the visual length of each option is examined, and the list is spread across as many columns as will reasonably fit in the terminal. You can override this behavior by importing and setting C<$MaxColumns> to the maximum number of columns you wish to display. See Scripts/max_columns_1.plx in the distribution as an example. =head2 Styles The C