Perl Ending loops/code blocks based on user input (!die/exit) - perl

just have a general question that came up while I was playing around with some stuff I coded. I was wondering if there is any way to terminate a specific part of the program based on user feedback (I apologize if I am misusing terminology here) other than die(); since that ends the entire program.
here's the code:
if ($choice eq 'y'){
print "\nHit diagnostics: \n";
{
my $hitList=#hitList;
for (my $i=0; $i<$hitList; $i++){
print $hitList[$i]."\n";
#segmented listout of misses with interrupt
if(($i%4) eq 0){
print "CONTINUE or Q to end\n";
my $next=<>;
chomp($next);
if(lc($next) eq 'q'){
**die "Killing request...\n";**
}
}
}
}
So basically I just want for the user to be able to end the modulus if loop if they decide at some point that they don't actually want to see the entire list but still be able to continue (there is a miss prompt afterwards as well) with the program.
Is the best way to do this just to use a variable as a 'switch' to determine whether or not the hit list should continue? Just wondering if there is a more acceptable/elegant solution.

for my $i (0..$hitList-1) {
...
if (...) {
last;
}
...
}
last

Related

Exiting a secondary Perl script and returning to the main program

I am running a Perl script to control two other scripts. The user of the main program can call the two secondary scripts with the following line.
do 'Task_A.pl';
The script then runs Task_A.pl but I would like to find a way of then exiting Task_A.pl and return to the main program. If possible I would like to return to the function where I last called the secondary script. I am not sure as to what this is called but I appreciate any input for a possible solution.
This is the whole main program, not much to it at the moment.
my $selecion;
#Looping variables.
my $program_loop = 1;
while ($program_loop == 1)
{
print "Please choose one of the programs listed in the menu.\n";
#Program menu where the user chooses from the presented options.
print "[1] - Script A.\n";
print "[2] - Script B.\n";
print "[3] - Exit program.\n";
my $user_input = <>;
if ($user_input == 1) # <-- Scrip_A.pl
{
do 'Task_A.pl';
}
elsif ($user_input == 2) # <-- Scrip_B.pl
{
do 'Task_B.pl';
}
elsif ($user_input == 3) # <-- Exit Program
{
#The user can choose to exit from the menu.
print "The program will now exit.\n";
exit;
}
}
do does not start another process. If that's what you want, use "system()".
If you want do, then it's probably best to just put everything into a function in the file to be evaluated and call the function at the end of the file.
Use "return" to leave the function and return to next instruction after do.

(m/regexp/) or {multiple ; commands; after; or; }

I like very much this syntax:
try_something() or warn "Cant do it";
How can I add more commands after or?
For example it would be useful in this code:
foreach (#array)
{
m/regex/ or {warn "Does not match"; next;} # this syntax is wrong
...
}
One way I found is
try_something() or eval {warn "Can't do it"; next;};
but I think it is bad idea.
BEST ANSWERS:
do is better than eval.
The comma operator is even better: do_smth() or warn("Does not match"), next; Nota bene: parentheses are mandatory for warn so that next does not parse as one of its arguments.
I think that will end up being pretty unreadable pretty fast, but you can do:
foo() or do { bar(); baz(); };
sub foo {
return $_[0] == 2;
}
for (1..3) {
print $_;
foo($_) or do { print " !foo\n"; next; };
print " foo!\n";
}
For the case in your question, I would use unless.
for (#array) {
unless (/regex/) {
warn "Does not match";
next;
}
...
}
You can sometimes get away with using the comma operator. It evaluates its left-hand argument, throws away the result, evaluates the right-hand argument and returns that result. Applied to your situation it looks like
for (#array) {
/regex/ or warn("Does not match"), next;
...
}
Note the extra parentheses. You have to be a bit more careful about parentheses and grouping this way. Be judicious in your use of this technique: it can get ugly quickly.
In a comment below, Zaid suggests
warn('Does not match'), next unless /regex/;
The choice is a matter of style. Perl was created by a linguist. Natural languages allow us to express the same thought in different ways depending on which part we want to emphasize. In your case, do you want to emphasize the warning or the pattern match? Place the more important code out front.
I figured out (and tested) that you can also use 'and':
try_something() or warn "Cant do it" and print "Hmm." and next;
If try_something() is success then it doesn't do anything after or.
If try_something() fails then it warns and prints and next.

Can't invoke submit queries in PERL CGI

Hey so I am trying to make a simple 'dating website' however I'm struggling with CGI aspect :( Mainly I'm having trouble with forms(I think I'm not too sure what I'm struggling with).
I have this statement
print header, start_html("EngCupid"), h2("EngCupid"), start_form;
if (!param() || param("home")) {
show_welcome();
} elsif (param("browse")) {
browse_page();
} elsif (param("search")) {
search_users();
} elsif (param("username")) {
search_results();
} else {
print "fail";
}
print end_form, end_html;
exit 0;
To Handle the general navigation of the website. However, I'm struggling when it comes to submit buttons etc inside these functions. So my browse_page() function is
sub browse_page {
print h2("Browse Page");
print p;
if (param("next")) {
$hidden_variable = param("x") + 1;
}
param('x', $hidden_variable);
$hidden_variable = 0;
print hidden('x');
print submit("next", "Next");
print submit("home", "Home"), " ", submit("search", "Search Users");
}
Which is supposed to increment a variable that I need to use for further functions every time I press the next key. However, whenever I press the next key it just prints fail as in the form isn't being passed?
Do I need a new form inside each function I am printing? I tried it but it still didn't work. Just a little lost in forms in general.
I am not sure what you are trying to achieve. Maybe the problem is that the x is not being sent back from client to server, maybe you wanted
print hidden('x', param('x'));
Also, why do you set $hidden_variable to 0? After submitting, the script will run again, the old value of the variable will not be accessible anymore.

program exhibiting bizarre behavior when reading words out from a file

So I have two files, one that contains my text, and another which I want to contain filter words. The one shown here is supposed to be the one with the curse words. Basically, what I'm doing is iterating through each of the words in the text file, and trying to compare them against the curse words.
sub filter {
$word_to_check = $_;
open ( FILE2, $ARGV[1]) || die "Something went wrong. \n";
while(<FILE2>) {
#cursewords = split;
foreach $curse (#cursewords) {
print $curse."\n";
if($word_to_check eq $curse) { return "BAD!";}
}
}
close ( FILE2 );
}
Here are the "curse words":
what is
Here is the text file:
hey dude what is up
But here's what's going wrong. As you can see, I've put a print statement to see if the curse words are getting checked correctly.
hey what
is
dude what
is
what what
is
is what
is
up what
is
I literally have no idea why this could be happening. Please let me know if I should post more code.
EDIT:
AHA! thanks evil otto. It seems I was getting confused with another print statement I had put in before. Now the problem remains: I think I'm not checking for string equality correctly. Here's where filter is getting called:
foreach $w( #text_file_words )
{
if(filter($w) eq "BAD!")
{
#do something here
}
else { print "good!"; }
}
EDIT 2: Nevermind, more stupidity on my part. I need to get some sleep, thanks evil otto.
change
$word_to_check = $_;
to
$word_to_check = shift;
You needed to collect arguments as an array in perl...
sub myFunction{
($wordToCheck) = #_; #this is the arg array, if you have more than one arg you just separate what's between the parenthesis with commas.
}

Perl do...while and last command

I've just encountered some very weird behavior that I really can't explain:
do {
my $qry = $self->getHTMLQuery(undef, $mech->content());
next if (!defined($qry));
push(
#prods,
map { 'http://www.XXXXYYYX.com'.$_->attr('href') }
$qry->query('div.prodInfo div.prodInfoBox a.prodLink.GridItemLink')
);
$qry->delete();
$TEST++;
last if ($TEST >= 10);
} while(eval { $mech->follow_link(class => 'jump next') });
print "WHILE ENDED\n";
The code above never prints "WHILE ENDED" even though it does seem to go out of the while loop when $TEST >= 10.
But the following code does print "WHILE ENDED":
do {
my $qry = $self->getHTMLQuery(undef, $mech->content());
next if (!defined($qry));
push(
#prods,
map { 'http://www.XXXXYYYX.com'.$_->attr('href') }
$qry->query('div.prodInfo div.prodInfoBox a.prodLink.GridItemLink')
);
$qry->delete();
$TEST++;
} while(eval { $mech->follow_link(class => 'jump next') } && $TEST <= 10);
print "WHILE ENDED\n";
In both tests, the initial value of $TEST is 0.
Is the behavior of last in do...while different than in for and while {...}?
A do block with a looping modifier doesn't count as a real loop as far as next, last, and redo are concerned. This is mentioned in perlsyn, where you'll find the tip Schwern mentioned about surrounding it with a bare block to make last work. But that won't work with next, because a bare block is only executed once, so next acts like last. To make next work, you can put the bare block inside the do, but then last will act like next.
If you need both next and last to work with a do ... while, the easiest way is to use an infinite loop with the real condition in a continue block. These 2 loops are equivalent, except that the second is a real loop, so it works with next & last:
do { ... } while condition;
while (1) { ... } continue { last unless condition };
From perldoc -f last:
"last" cannot be used to exit a block that returns a value such as
"eval {}", "sub {}" or "do {}"
TLP is right. The standard work around for this (I just hit it myself) is to wrap the do/while in a bare block which, counter-intuitively, does respect loop controls.
{ do {
last;
} while 1; }
The block outside will catch last. If you want to handle next you have to put the bloc inside.
do {{
next;
}} while 1;
The block inside will catch next.
Unfortunately you can't do both.