I am new to perl, and am trying out code which uses a simple switch. The school server runs only Perl 5.12.4, so I am coding accordingly.
The issue I am having is that the variable controlling the switch will not throw any of the cases, no matter how I describe them, and is always falling through to the default case.
Ignore the contents of each case switch, I am just trying to get it to throw the print command at least so I know that the switch is operating.
# I have tried: case "1", case 1, case [1], case '1', and other variations.
#!/usr/bin/perl
# script name: phonebook.pl
while ( 1 ) {
print "Welcome to the Registry Searcher!\n";
print "Please enter a command matching one of the options below.\n";
print "1) List records alphabetically\n";
print "2) List records reverse alphabetically\n";
print "3) Search the Registry by Name\n";
print "4) Search the Registry by Birthday\n";
print "5) Exit\n";
print "Choice: ";
$in = <>;
# user enters "1".
use Switch;
switch ($in) {
case 1 {
print "Please choose either first or last name (f/l): ";
$type = <>;
if ( $type == f ) {
sort list.txt;
} elsif ( $type == "l" ) {
sort -k2 list.txt;
} else {
print "Choice not recognized.\n";
}
print "Please press enter to continue...";
$cont = <>;
}
case 2 {
print "Please choose either first or last name (f/l): ";
$type = <>;
if ( $type == "f" ) {
sort -r list.txt
} elsif ( $type == "l" ) {
sort -rk2 list.txt
} else {
print "Choice not recognized.\n";
}
print "Please press enter to continue...";
$cont = <>;
}
case 3 {
print "Please enter a last name to search for: ";
$name = <>;
# awk '/^[A-Z][a-z]+ '$name'/{print}' list.txt;
print "Please press enter to continue...";
$cont = <>;
}
else {
print "not found\n";
}
}
}
You must add chomp($in); before the switch to remove the newline.
<> read a line in a stream and include the linefeed, the behaviour is different from a scanf-like function.
You really don't want to be using Switch; that's a very old source-filter module that's unreliable, and in any case was removed from Perl a long time ago.
For better modern alternatives see Switch::Plain, or the given/when built-in operators, though beware of the latter's behaviour with "experimental" warnings.
Related
While using IO::Prompter I'm asking only numbers as input. This works. However I can't seem to find an elegant way to move away from the subroutine if I enter something like 'quit'.
In the documents it said something like:
while (my $cmd = prompt '>', -fail=>'quit') {
...
}
But I haven't been able to implement that and tried the following that doesn't function properly (I can't quit).
#!/usr/bin/perl
use strict;
use warnings;
use IO::Prompter;
my $ask = prompt "Do you want to show numbers?", -yn;
print "You entered: $ask\n";
if ( $ask eq 'y' ) {
showNumbers();
}
else {
print "You said: no\n";
}
sub showNumbers {
while ( prompt -num, 'Enter a number'){
print "$_\n";
}
}
-DEF can be used to provide a default that's not a valid response, allowing us to distinguish between a valid a response and just pressing Enter.
sub showNumbers {
while (1) {
my $num = prompt 'Enter a number', -num, -DEF => "";
# $num is a weird value that true even for an empty string, so
# we must separately check for false (meaning EOF) and empty string.
last if !$num || $num eq "";
print "$num\n";
}
}
Thanks for the help I have found on this site by searching the web when looking for problems.
It seams that I am unable to figure out just what the problem with this code is. I was told that Perl was easier than Bash but now that I have tried it I am not sure that is true at all. Anyway...I have been over this code and searched but have not been able to discover just what is wrong with it. Part of the problem is that my old brain does not learn new things so easy as it once did. The code
#!/usr/bin/perl
use warnings;
use strict;
my $target = 12;
my $guess=0;
print "Guess my number!\n";
print "Enter your guess: ";
$guess = <STDIN>;
while ($guess != $target) {
if ($target == $guess) {
print "That's it! You guessed correctly!\n";
exit;
}
elsif ($guess > $target) {
print "Your number is bigger than my number\n";
print "Try agin";
print "Enter a lower guess: ";
$guess = <STDIN>;
}
else ($guess < $target) { # syntax error at , near "else ("
print "Your number is less than my number\n";
print "Try agin";
print "Enter a higher guess: ";
$guess = <STDIN>;
}
} # syntax error at , near "}"
I am getting errors at the lines marked above. Yet the code is identical to the code in the elsif just above it.
The syntax is else {, since there is no condition for else, whereas elsif does have a condition. The syntax is:
if (condition) {
...
}
elsif (condition) {
...
}
else {
...
}
This one really has me confused and I don't know how to accurately title it.
I am writing a program, the purpose is irrelevant, but some of you may know as I've been asking a few questions about it recently.
I'm going to post the entire program but I don't think that's necessary. The part you need to look at is the nested loops where it says "beginning search algorithm."
The program takes a long time to complete, so after every iteration of the outermost loop, I print a '.'. after every 7 dots a new line is printed.
for some reason, however no dots will get printed, until a newline is printed.
heres the code:
#!/usr/bin/perl
use v5.14;
use warnings;
# this is a cgi implementation of a theorum proover.
# the program uses resolution refutation, using a breadth-first and set of support strategy
# to generate a proof(if possible) and relay the results to the user.
########################################################################################
#Algorithm:
#1.) Get size(i) of knowledge base
#2.) untill you have i clauses
# 3.) get the clause, add to knowledge base
#4.) get the conclusion variable(conjecture)
#5.) add the negation of the conjecture to the knowledge base
#6.) add the negation of the conjecture to the SOS set.
#7.) compare the SOS set to ever other clause
# 8.) if resolution is possible, add the new clause to the knowledge base if it does not already exist.
# 9.) add the new clause to the SOS set.
#10.) repeat 7-9 untill the null clause is generated or no more resolution is possible.
########################################################################################
my $conclusion;
my $conclusion2;
my #conclusion;
my #SOS;
my #clauses;
my $found=0;
#batch mode
if($ARGV[0])
{
my $filename = $ARGV[0];
open(IN, "<", $filename);
chomp(#clauses=<IN>);
close(IN);
for(#clauses)
{
$_ =~ s/[^A-Za-z~,]//g;
}
#negate the negation to get the desired conclusion for later
$conclusion2=$clauses[$#clauses];
print "$conclusion2";
#conclusion = split("", $conclusion2);
if($conclusion[0] eq '~')
{
splice(#conclusion, 0, 1);
$found=1;
}
if (!$found)
{
$conclusion = "~$conclusion2";
}
else
{
$conclusion = join("", #conclusion);
}
#now break up each line and make #clauses 2d
$_ = [split /,/ ] for #clauses;
}
#interactive mode
else
{
my $count=0;
say "Welcome to my Theorum Proover!";
say "How many clauses are in your knowledge base?";
say "(this does not include the conclusion)";
print "Amount: ";
my $amt = <>;
say "Enter your clauses: ";
say "Negations can be indicated with a '~'.";
say "Variable names must contain only letters.";
say "Separate each literal with a ','<br>";
my $clauses;
while($count < $amt)
{
print "clause $count:";
$clauses .= <>;
$clauses =~ s/[^A-Za-z~,]//g;
$clauses .= ";";
$count++;
print "\n";
}
print "\n \n \n Enter the conclusion, your conclusion should be a literal:";
$conclusion = <>;
$conclusion =~ s/[^A-Za-z~]//g;
print "\n";
#negate the conclusion and add it to the set of clauses.
#conclusion = split("", $conclusion);
if($conclusion[0] eq '~')
{
splice(#conclusion, 0, 1);
$found=1;
}
if (!$found)
{
$conclusion2 = "~$conclusion";
}
else
{
$conclusion2 = join("", #conclusion);
}
# split up the contents of the clause string and add them to a 2d array.
#then, add the negated conclusion to the list.
my #PartClauses= split(';', $clauses);
my $last=#PartClauses;
for my $i (0 .. $#PartClauses)
{
my #tmp=split(',', $PartClauses[$i]);
for my $j (0 .. #tmp)
{
$clauses[$i][$j] = $tmp[$j];
}
}
$clauses[$last][0] = $conclusion2;
}
open(RESULTS, ">", 'results.txt');
for my $i (0 .. $#clauses)
{
print RESULTS "clause $i: {";
for my $j (0 .. $#{ $clauses[$i] })
{
print RESULTS "$clauses[$i][$j]";
if($j != $#{ $clauses[$i] })
{
print RESULTS ",";
}
}
print RESULTS "}\n";
}
print RESULTS "_____________________________\n";
print "Beginning search ....";
##################################################
#begin breadthfirst/sos search/add algorithm
$SOS[0][0]=$conclusion2;
my $cSize=$#clauses;
say "\nworking......";
my $sAdd=0;
my $cAdd=0;
my $res=0;
my $flag=0;
my $dots=0;
SOSROW:
for (my $a=0; $a<=$#SOS; $a++)
{
&update;
CLAUSEROW:
for (my $i=0; $i<=$#clauses; $i++)
{
SOSCOL:
for (my $b=0; $b<=$#{ $SOS[$a] }; $b++)
{
CLAUSECOL:
for my $j (0 .. $#{ $clauses[$i] })
{
if($SOS[$a][$b] eq "~$clauses[$i][$j]"
|| $clauses[$i][$j] eq "~$SOS[$a][$b]")
{
my #tmp;
#found a resolution, so add all other literals from
#both clauses to each set as a single clause
#start with the SOS literals(use a hash to keep track of duplicates)
my %seen;
for my $x (0 .. $#{ $SOS[$a] })
{
if($x != $b)
{
$seen{$SOS[$a][$x]}=1;
push #tmp, "$SOS[$a][$x]";
}
}
#now add the literals from the non-SOS clause
for my $y (0 .. $#{ $clauses[$i] })
{
if($y != $j)
{
if(! $seen{ $clauses[$i][$y] })
{
push(#tmp, "$clauses[$i][$y]");
}
}
}
#check to see if the clause is already listed
my $dupl = 0;
my #a1 = sort(#tmp);
my $s1 = join("", #a1);
MATCH:
for my $i (0 .. $#clauses)
{
my #a2= sort(#{ $clauses[$i] });
my $s2= join("", #a2);
if($s1 eq $s2 )
{
$dupl = 1;
last MATCH;
}
}
#if it isn't, go ahead and add it in
if(! $dupl)
{
$res++;
$sAdd++;
$cAdd++;
my $s = $cSize + $cAdd;
push(#SOS, \#tmp);
push(#clauses, \#tmp);
#print out the new clauses.
print RESULTS"clause $s: ";
my $clause = $cSize+$a;
print RESULTS "{";
if($SOS[$sAdd][0])
{
for my $j(0 .. $#{ $clauses[$s] })
{
if($clauses[$s][$j])
{
print RESULTS "$clauses[$s][$j]";
}
if($j!= $#{ $clauses[$s] })
{
print RESULTS ",";
}
}
print RESULTS "} ($i,$clause)\n";
}
#if you found a new res, but there was nothing to push, you found
# the contradiction, so signal and break.
else
{
print RESULTS "} ($i,$clause)\n";
$flag=1;
last SOSROW;
}
}
}
}
}
}
}
close(RESULTS);
if($flag)
{
say "After $res resolutions, a resolvent was found and the empty set was generated.";
say "This indicates that when '$conclusion' is false, the entire knowledge base is false.";
say "Because we know that the clauses in the knowledge base are actually true, we can soundly conclude that '$conclusion must also be true.";
say "The clauses generated by each resolution can be found below.\n\n";
}
else
{
say "We were not able to generate the empty clause.";
say "this means that adding the negation of the desired conclusion does not render the theorum false.";
say "Therefore, we can not safely conclude that '$conclusion' is true.";
say "Any clauses that we were able to generate through a resoluton can be viewed below.\n\n";
}
print `more results.txt`;
sub update
{
if((($dots % 7) == 0))
{
print "\n";
}
if($dots==14)
{
print "You might want to get some coffee.\n";
}
if($dots==35)
{
print "I'm being VERY Thorough.\n";
}
if($dots==63 || $dots==140)
{
print "Hows that coffee?\n";
}
if($dots==105)
{
print "I think it might be time for a second cup of coffee\n"
}
if($dots==210)
{
print "Like I said, VERY thorough\n";
}
if($dots==630)
{
print "My O is bigger than you can imagine\n"
}
$dots++;
print ".";
}
I can't figure out why this is happening. could it have something to do with buffering?
If instead of calling the subroutine, i just say print "."; nothing will be printed until, the prog finishes execution.
Yes, filehandles are buffered by default. If STDOUT points to a terminal it will be line-buffered (nothing is output until a newline is printed), otherwise it will be block-buffered (nothing is output until a certain number of bytes is printed). The easiest way to change that is to set $|=1, which will make the current output filehandle (usually STDOUT unbuffered), so it will flush after every print.
This is my code which has switch statement works fine but if user enters greater than 3 or blank text then it should stay in first sub routine how can i do this in perl
use strict;
use warnings;
use Switch;
my $input = "Enter the number:";
sub input(){
print "Choose You Input Method"."\n";
print "1.UPC"."\n";
print "2.URL"."\n";
print "3.Elastic Search"."\n";
print $input;
$input = <>;
chomp($input);
switch($input){
case 1 {print "UPC"."\n"}
case 2 {print "URL"."\n"}
case 3 {print "Elastic Search"."\n"}
else {print "Enter the correct value"."\n"}
}
}
input();
my $pinput = "Enter the number:";
sub pinput(){
print "Choose Your Process Method"."\n";
print "1.API"."\n";
print "2.Mongo"."\n";
print $pinput;
$pinput = <>;
chomp($pinput);
switch($pinput){
case 1 {print "API"."\n"}
case 2 {print "MONGO"."\n"}
else {print "Enter the correct value"."\n"}
}
}
pinput();
if user enters something like 4 or blank data it should not pass to another sub routine it should stay on the same sub routine how can i do this?
Wrap the prompt code into a block with redo:
#!/usr/bin/perl
use warnings;
use strict;
use Switch::Plain;
PROMPT: {
chomp(my $input = <>);
nswitch ($input) {
case 1 : { print "UPC\n" }
case 2 : { print "URL\n" }
case 3 : { print "Elastic Search\n" }
default : { print "Enter the correct value\n" ; redo PROMPT }
}
}
I used Switch::Plain instead of Switch, as it is much safer (it doesn't use a source filter) and sufficient for your case.
perlfaq7 - How do I create a switch or case statement?
Using the builtin function since 5.10
use 5.010;
use strict;
use warnings;
PROMPT: {
chomp(my $input = <>);
given ( $input ) {
when( '1' ) { say "UPC" }
when( '2' ) { say "URL" }
when( '3' ) { say "Elastic Search" }
default { print "Enter the correct value"; redo PROMPT }
};
}
How to make script very interactive?
Script purpose:
Get user entered number and find mod via get_mod_val function; if it returns 1 then say "good" and exit the script; if it returns 0, then ask user to enter odd number.
Validation:
accept only numbers, no character, decimal, special characters.
do not end the script until user has entered the odd number.
The following code works fine; it follows above validation point 1 rules, but it is not very interactive as per our requirement law. When above rules fails, script exits and we need to execute the script again.
How can we make the following code very interactive?
$ip_no = $ARGV[0];
if ($ip_no!="") {
$get_mod_op = get_mod_val($ip_no);
if ($ip_no =~ /\D/){
print "Entered number only.....";
exit;
}else{
if ($get_mod_op==1) {
print "Good odd number(${get_mod_op}): ${ip_no} ";
exit;
}else{
print "Good even number(${get_mod_op}): ${ip_no} ";
exit;
}
}
}else{
print "Enter number.";
exit;
}
Thank to all, finally i have done the code with your suggestions, Following snippet reached my requirement, review the code and advise for optimization.
if ($ARGV[0] != "") {
$user_ip = $ARGV[0];
}elsif (($ARGV[0] =~ /\D/ ) || ($ARGV[0] eq "") ){
print "Enter odd number only: ";
$user_ip = <STDIN>;
}else{
$user_ip = <STDIN>;
}
do{ #get mod value, if mod_off is 1 then entered number is odd otherwise ask user to enter the odd number
$mod_off = find_mod_val($user_ip);
if (($user_ip == "") || ($user_ip eq "") || ($user_ip eq "") || ($mod_off == 0)) {
print "Enter odd number only: ";
$user_ip = <STDIN>;
}
}until($mod_off == 1);
print "Good odd number ${user_ip}";
sub find_mod_val($user_ip){
return $user_ip%2;
}
__END__
TIMTOWTDI, this time with recursion! The benefit is that you can reuse the function to validate other inputs too. I guess you could make a sub that wraps a loop, but c'mon this is fun!
sub get_input {
my ($message, $valid) = #_;
print "$message: ";
chomp(my $response = <>);
unless( $response =~ $valid ) {
print "Invalid response!\n";
$response = get_input($message, $valid);
}
return $response;
}
my $response = get_input("Enter a number", qr/^\d+$/);
print "Got: $response\n";
Don't use ARGV[0] and read from STDIN (so you need to run your script and type the word you want). I have rewritten your code:
my $finish = 0;
while( ! $finish ) {
print "Enter number.";
my $ip_no = <STDIN>;
chomp($ip_no);
$get_mod_op = get_mod_val($ip_no);
if( $ip_no =~ /\D/ ){
print "Entered number only.....";
}
elsif( $get_mod_op == 1 ) {
print "Good odd number(${get_mod_op}): ${ip_no} ";
$finish = 1;
}
else {
print "Good even number(${get_mod_op}): ${ip_no} ";
$finish = 1;
}
}
Are you sure you want it to be interactive; doing that makes it much less useful in other scripts.
If you must, then put the testing code into a sub, then use the sub to validate $ARGV[0], and if that fails, go into a loop that requests input and runs the validation.
Check out the Perl IO::Prompt module.
my $val;
for (;;) {
print "Some prompt: ";
$val = <STDIN>;
chomp $val;
last if is_valid($val);
print "Bad input. Valid inputs are ...\n";
}