Shell-POSIX-Select-0.05/0040755000032600001470000000000007657571716013720 5ustar contixguruShell-POSIX-Select-0.05/Ref_Data/0040755000032600001470000000000007657571716015365 5ustar contixguruShell-POSIX-Select-0.05/Ref_Data/arrayvar.cdump_ref0100644000032600001470000001427207657570051021074 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/no_decl_var.cdump_ref0100644000032600001470000001430507657570057021523 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/refvar.cdump_ref0100644000032600001470000001433107657570062020530 0ustar contixguru $var = ; # Code generated by Shell::POSIX::Select v0.05, 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 ; 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 ; Shell-POSIX-Select-0.05/Ref_Data/alldefaults.cdump_ref0100644000032600001470000001445607657570050021550 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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.05/Ref_Data/badvar.cdump_ref0100644000032600001470000001430507657570052020502 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/argv_heading.cdump_ref0100644000032600001470000001434607657570051021665 0ustar contixguru BEGIN { @ARGV or @ARGV= } $Heading=; # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/sub2.cdump_ref0100644000032600001470000001446107657570064020124 0ustar contixguru sub select_in_sub { # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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  ; Shell-POSIX-Select-0.05/Ref_Data/myvar.cdump_ref0100644000032600001470000001431207657570054020401 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/localvar.cdump_ref0100644000032600001470000001431307657570053021046 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/novar.cdump_ref0100644000032600001470000001430507657570060020367 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/nested2b.cdump_ref0100644000032600001470000003074707657570055020764 0ustar contixguru $Prompt=; # Code generated by Shell::POSIX::Select v0.05, 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 ; $Prompt=; # Code generated by Shell::POSIX::Select v0.05, 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=( ); 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 ; print ; ; # 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 ; ; # 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 ; Shell-POSIX-Select-0.05/Ref_Data/nested2c.cdump_ref0100644000032600001470000003075707657570056020767 0ustar contixguru $Prompt=; # Code generated by Shell::POSIX::Select v0.05, 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 ; $Prompt=; # Code generated by Shell::POSIX::Select v0.05, 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=( ); 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 ; print ; 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 ; ; # 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 ; Shell-POSIX-Select-0.05/Ref_Data/reply.cdump_ref0100644000032600001470000003103707657570063020401 0ustar contixguru $Heading=; # Code generated by Shell::POSIX::Select v0.05, 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 ; warn ; $Heading=; # Code generated by Shell::POSIX::Select v0.05, 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=( ); 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 ; warn ; print ; 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 ; warn  ; ; # 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  ; Shell-POSIX-Select-0.05/Ref_Data/ourvar.cdump_ref0100644000032600001470000001432707657570061020565 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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 ; Shell-POSIX-Select-0.05/Ref_Data/prompt.nested.cdump_ref0100644000032600001470000003064307657570061022050 0ustar contixguru $Prompt=; # Code generated by Shell::POSIX::Select v0.05, 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=; LOOP2: # Code generated by Shell::POSIX::Select v0.05, 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.05/Ref_Data/eslect.cdump_ref0100644000032600001470000001441707657570053020527 0ustar contixguru BEGIN { @ARGV or @ARGV= ; } # eslect $var[2] ( ) { print  } $Heading=; # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/nested2a.cdump_ref0100644000032600001470000003063507657570055020757 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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.05, 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.05/Ref_Data/select2foreach.cdump_ref0100644000032600001470000001430507657570063022136 0ustar contixguru # Code generated by Shell::POSIX::Select v0.05, 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 ; ; # 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.05/Ref_Data/nested_heading_prompt.cdump_ref0100644000032600001470000003106707657570057023616 0ustar contixguru $Heading=; $Prompt=; OUTER: # Code generated by Shell::POSIX::Select v0.05, 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 ; $Heading=; $Prompt=; # Code generated by Shell::POSIX::Select v0.05, 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=(  ); 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 ; print ; 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 ; ; # 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  ; Shell-POSIX-Select-0.05/Test_Progs/0040755000032600001470000000000007657571716016011 5ustar contixguruShell-POSIX-Select-0.05/Test_Progs/sub20100755000032600001470000000022107655135557016577 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/HIDE/0040755000032600001470000000000007657571716016522 5ustar contixguruShell-POSIX-Select-0.05/Test_Progs/HIDE/other_select10100644000032600001470000000070407655340366021175 0ustar contixguru#! /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.05/Test_Progs/HIDE/stderr0100644000032600001470000000011207656033137017724 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; print STDERR "STDERR\n"; Shell-POSIX-Select-0.05/Test_Progs/HIDE/other_select20100644000032600001470000000062507655252074021176 0ustar contixguru#! /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.05/Test_Progs/HIDE/stdout0100644000032600001470000000011207656033161017740 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; print STDOUT "STDOUT\n"; Shell-POSIX-Select-0.05/Test_Progs/no_decl_var0100755000032600001470000000011707655135260020172 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.05/Test_Progs/localvar0100644000032600001470000000013507655135165017523 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select ; select local $var (1) { print "/$var/\n"; } Shell-POSIX-Select-0.05/Test_Progs/reply0100755000032600001470000000060707654611120017047 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/refvar0100755000032600001470000000024307655135416017207 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/badvar0100644000032600001470000000011707655134771017161 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.05/Test_Progs/alldefaults0100644000032600001470000000007707655250670020224 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select ; select () { } Shell-POSIX-Select-0.05/Test_Progs/nested2a0100755000032600001470000000011607655134042017420 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; select (1) { select (2) { } } Shell-POSIX-Select-0.05/Test_Progs/other_select1.sdump0100755000032600001470000000001607655267707021621 0ustar contixguruSTDERR STDERR Shell-POSIX-Select-0.05/Test_Progs/select2foreach0100755000032600001470000000012407655272043020607 0ustar contixguruuse Shell::POSIX::Select ( testmode => 'foreach' ); select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.05/Test_Progs/nested2b0100644000032600001470000000044407654515502017425 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/argv_heading0100644000032600001470000000023707655134577020347 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select qw($Heading); BEGIN { @ARGV or @ARGV=qw(A B C) } $Heading='MENU CITY'; select $var (@ARGV) { print "$var\n"; } Shell-POSIX-Select-0.05/Test_Progs/options1.bogus0100755000032600001470000000022507655253446020620 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select( style => 'bogus', style => 'Bash', prompt => 'bogus' ); select $var ( localtime ){ print "$var\n"; } Shell-POSIX-Select-0.05/Test_Progs/nested2c0100644000032600001470000000047607655134116017432 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/ourvar0100755000032600001470000000017507655135331017240 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; select our $var (1) { print "$var\n"; } print "Outside loop, var is $var\n"; Shell-POSIX-Select-0.05/Test_Progs/prompt.nested0100755000032600001470000000027207655127733020531 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/other_select1.cdump0100755000032600001470000000004307655267707021601 0ustar contixguruPRE-LOADING DUMP VAR, loopnum was 1Shell-POSIX-Select-0.05/Test_Progs/nested_heading_prompt0100755000032600001470000000067207655127733022275 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/eslect0100644000032600001470000000031507655134477017204 0ustar contixguru#! /usr/bin/perl -w 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.05/Test_Progs/myvar0100644000032600001470000000013207655135201017042 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select ; select my $var (1,2) { print "$var\n"; } Shell-POSIX-Select-0.05/Test_Progs/novar0100644000032600001470000000011707655135020017033 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; select (1,2) { print "$_\n"; } Shell-POSIX-Select-0.05/Test_Progs/arrayvar0100644000032600001470000000013607655515646017556 0ustar contixguru#! /usr/bin/perl -w use Shell::POSIX::Select; select $var[0] (@ARGV) { print "$var[0]\n"; } Shell-POSIX-Select-0.05/Changes0100644000032600001470000000234307657554065015210 0ustar contixguruRevision 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. Shell-POSIX-Select-0.05/MANIFEST0100644000032600001470000000306607657570103015040 0ustar contixguruChanges Makefile.PL MANIFEST README test.pl Select.pm Makefile.PL browse_images.0 browse_images.plx.PL browse_records.0 browse_records.plx.PL delete_file.0 delete_file.plx.PL lc_filename.0 lc_filename.plx.PL long_listem.0 menu_ls.0 menu_ls.plx.PL order.0 order.plx.PL perl_man.0 perl_man.plx.PL pick.0 pick.plx.PL pick_file.0 pick_file.plx.PL Compile_Bugs/dual_select Compile_Bugs/require 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/localvar.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/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/sub2.cdump_ref Scripts/README Scripts/SCRIPTS.rme Scripts/file1.py Scripts/file2.py Test_Progs/HIDE/other_select1 Test_Progs/HIDE/other_select2 Test_Progs/HIDE/stderr Test_Progs/HIDE/stdout Test_Progs/alldefaults Test_Progs/argv_heading Test_Progs/arrayvar Test_Progs/badvar Test_Progs/eslect Test_Progs/localvar 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.cdump Test_Progs/other_select1.sdump Test_Progs/ourvar Test_Progs/prompt.nested Test_Progs/refvar Test_Progs/reply Test_Progs/select2foreach Test_Progs/sub2 Shell-POSIX-Select-0.05/browse_records.00100644000032600001470000000162207655333546017014 0ustar contixguru######################################################### # 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.05/perl_man.plx.PL0100644000032600001470000000144707655324710016543 0ustar contixguru# 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.05/browse_images.plx.PL0100644000032600001470000000000007655324710026153 1Shell-POSIX-Select-0.05/perl_man.plx.PLustar contixguruShell-POSIX-Select-0.05/delete_file.00100644000032600001470000000131107655406011016212 0ustar contixguru######################################################### # 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.05/Scripts/0040755000032600001470000000000007657571716015347 5ustar contixguruShell-POSIX-Select-0.05/Scripts/file2.py0100644000032600001470000000000007657553730016701 0ustar contixguruShell-POSIX-Select-0.05/Scripts/SCRIPTS.rme0100644000032600001470000000145207657552115017172 0ustar contixguruThis 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.05/Scripts/file1.py0100644000032600001470000000000007657553730016700 0ustar contixguruShell-POSIX-Select-0.05/Scripts/README0100644000032600001470000000000007657552115025230 1Shell-POSIX-Select-0.05/Scripts/SCRIPTS.rmeustar contixguruShell-POSIX-Select-0.05/Compile_Bugs/0040755000032600001470000000000007657571716016270 5ustar contixguruShell-POSIX-Select-0.05/Compile_Bugs/require0100644000032600001470000000005707655271601017652 0ustar contixgururequire Shell::POSIX::Select; select (1) {; } Shell-POSIX-Select-0.05/Compile_Bugs/dual_select0100644000032600001470000000065607655551537020500 0ustar contixguru#! /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.05/perl_man.00100644000032600001470000000076507655333135015570 0ustar contixguru######################################################### # 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.05/order.00100644000032600001470000000116007655333041015070 0ustar contixguru######################################################### # 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.05/test.pl0100755000032600001470000002133507657551352015232 0ustar contixguru#! /usr/bin/perl # test.pl ######################################################### # 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 => 19 ; # 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 { $VERSION='0.05'; # 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$VERSION 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' ; # must tell it where to find module, before it's installed unshift @INC, 'blib/lib', 'blib/arch' ; # needed for my pre-distro testing $test_compile = 1; # fails due to control-char "placeholders" in source $test_compile = 0; $ref_dir='Ref_Data'; $cbugs_dir='Compile_Bugs'; $rbugs_dir='Run_Bugs'; $test_dir='Test_Progs'; # @Testdirs=( $test_dir, $ref_dir, $cbugs_dir, $rbugs_dir ); @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; 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"; `uname -n` eq "guru\n" or die "Hey! Generating reference data is the author's domain\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"; $ENV{PERL5LIB}="blib/lib:blib/arch:$PERL5LIB"; # needed for test programs # 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'); 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 (-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 ($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 > 0 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 > 0 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.05/menu_ls.plx.PL0100644000032600001470000000000007655324710024767 1Shell-POSIX-Select-0.05/perl_man.plx.PLustar contixguruShell-POSIX-Select-0.05/README0100644000032600001470000000771007656570714014576 0ustar contixguru Shell/POSIX/Select version 0.05 =============================== INSTALLATION To install this module type the following: perl Makefile.PL make 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 Consultix yumpy@cpan.org http://www.teachmeperl.com 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.05/Select.pm0100644000032600001470000022332607657570103015467 0ustar contixgurupackage Shell::POSIX::Select; our $VERSION = '0.05'; # Tim Maher, tim@teachmeperl.com, yumpy@cpan.org # Fri May 2 10:29:25 PDT 2003 # Mon May 5 10:51:49 PDT 2003 # TO DO: portable-ize tput stuff # dump user's code-block with same line numbers shown in # error messages for debugging ease # Add option to embolden menu numbers, to distinguish 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 ( $DIRSEP, $sdump, $cdump, $script ); # our ( @ISA, @EXPORT, $PRODUCTION, $LOGGING, $PKG, $INSTALL_TESTING,$ON,$OFF, $BOLD, $SGR0, $COLS ); 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 strict; # no strict 'refs'; # no problem now use File::Spec::Functions 0.7; # some bugs in F::S or its relatives, that can cause compilation errors here use Filter::Simple; # 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.89 qw(extract_variable extract_bracketed); # I've done most testing with this as yet unrelased version # use Text::Balanced 1.90 qw(extract_variable extract_bracketed); use Carp; # Why doesn't File:Spec just hand me the dir-separator char? # Sheesh, this should be a lot easier. ( $DIRSEP = catfile ( 1,2 ) ) =~ s/^1(.*)2$/$1/; $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 => \&filter, all => sub { $LOGGING and print SOURCE; }; $DEBUG >2 and warn "Import_called set to: $_import_called\n"; $DEBUG >2 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 $maxloops = 10; # Probably looping out of control if we get this many my $loopnum; 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 > 5 and warn "$subname: Might be stuck in loop\n"; $loopnum > 10 and die "$subname: Probably was stuck in loop\n"; $DEBUG > 3 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 ( /$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"; } } gobble_spaces(); ( $loop_block, @rest ) = extract_bracketed($_, '{}'); 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; # warn "Calling MATCHES2FIELDS with \$loop_list of $loop_list\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"; } 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; } } $loopnum > 1 and $Shell::POSIX::Select::filter_output=$_; $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); } 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); } # 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 = ""; $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 # Now let's see if Damian likes it: $DEBUG > 1 and show_subs ("Pre-extract_variable 3\n"); 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/^\s*\{|\}\s*$//g; defined $decl and $decl eq 'unset' and undef $decl; # pass as undef return ( $decl, $loop_var, $values, $codeblock2, $debugging_code ); } 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 "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"; warn "Dcode is unset"; warn "arrayname is unset"; !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 } 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; # $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 ); } 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, "> $dir${DIRSEP}SELECT_log" or _DIE "Open LOG failed, $!\n"; open SOURCE, "> $dir${DIRSEP}SELECT_source" or _DIE "Open SOURCE failed, $!\n"; open USERPROG, "> $dir${DIRSEP}SELECT_user_program" or _DIE "Open USERPROG failed, $!\n"; open PART1, "> $dir${DIRSEP}SELECT_part1" or _DIE "Open PART1 failed, $!\n"; open PART2, "> $dir${DIRSEP}SELECT_part2" or _DIE "Open PART2 failed, $!\n"; open PART3, "> $dir${DIRSEP}SELECT_part3" or _DIE "Open PART3 failed, $!\n"; open PART4, "> $dir${DIRSEP}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"; } } 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 _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 = ($Shell::POSIX::Select::dump_data =~ /[a-z]/i ? # Dir prefix, or nothing $Shell::POSIX::Select::dump_data : '.') . $DIRSEP . "$script.sdump" . ($Shell::POSIX::Select::dump_data =~ /[a-z]/i ? # Dir prefix, or nothing '_ref' : '') ; ($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; } 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 '$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 Styles The C