Can't invoke submit queries in PERL CGI - perl

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.

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.

WWW::Mechanize::Firefox looping though links

I am using a foreach to loop through links. Do I need a $mech->back(); to continue the loop or is that implicit.
Furthermore do I need a separate $mech2 object for nested for each loops?
The code I currently have gets stuck (it does not complete) and ends on the first page where td#tabcolor3 is not found.
foreach my $sector ($mech->selector('a.link2'))
{
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
$mech->back();
}
else
{
$mech->back();
}
}
You cannot access information from a page when it is no longer on display. However, the way foreach works is to build the list first before it is iterated through, so the code you have written should be fine.
There is no need for the call to back as the links are absolute. If you had used click then there must be a link in the page to click on, but with follow_link all you are doing is going to a new URL.
There is also no need to check the number of links to follow, as a for loop over an empty list will simply not be executed.
To make things clearer I suggest that you assign the results of selector to an array before the loop.
Like this
my #sectors = $mech->selector('a.link2');
for my $sector (#sectors) {
$mech->follow_link($sector);
my #places = $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->follow_link($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Update
My apologies. It seems that follow_link is finicky and needs to follow a link on the current page.
I suggest that you extract the href attribute from each link and use get instead of follow_link.
my #selectors = map $_->{href}, $mech->selector('a.link2');
for my $selector (#selectors) {
$mech->get($selector);
my #places = map $_->{href}, $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->get($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Please let me know whether this works on the site you are connecting to.
I recommend to use separate $mech object for this:
foreach my $sector ($mech->selector('a.link2'))
{
my $mech = $mech->clone();
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
my $mech = $mech->clone();
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
#$mech->back();
}
# else
# {
# $mech->back();
# }
}
I am using WWW:Mechanize::Firefox to loop over a bunch of URLs with loads of Javascript. The page does not render immediately so need test if a particular page element is visible (similar to suggestion in Mechanize::Firefox documentation except 2 xpaths in the test) before deciding next action.
The page eventually renders a xpath to 'no info' or some wanted stuff after about 2-3 seconds. If no info we go to next URL. I think there is some sort of race condition with both xpaths not existing at once causing the MozRepl::RemoteObject: TypeError: can't access dead object error intermittently (at the sleep 1 in the loop oddly enough).
My solution that seems to work/improve reliability is to enclose all the $mech->getand$mech->is_visible in an eval{}; like this:
eval{
$mech->get("$url");
$retries = 15; #test to see if element visible = page complete
while ($retries-- and ! $mech->is_visible( xpath => $xpath_btn ) and ! $mech->is_visible( xpath => $xpath_no_info )){
sleep 1;
};
last if($mech->is_visible( xpath => $xpath_no_info) ); #skip rest if no info page
};
Others might suggest improvements on this.

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

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

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.

Why does `print` not work in this wxPerl program?

In my frame constructor I have a function that easily makes a menu bar for me.
package Routines;
#This function will set up a menu
#REQUIRED: entries
#RETURNS: id, menu
sub SetupMenu {
$menuItemCount = 0; #Element number under the same menu
$subMenuCount = 0; #Number of menus
$mbar = Wx::MenuBar->new(); #Menu bar constructor
for ($totalCount = 0; $totalCount < scalar($_[1]); $totalCount++) { #Loop for each entry
if ($menuItemCount == 0) { #If this is the first entry in the menu
$menuList[$subMenuCount] = Wx::Menu->new($_[$totalCount]); #Construct a menu and make this the title
} elsif ($_[$totalCount] == "---") { #If the entry is ---
#Treat it as a separator, skip ID
} elsif ($_[$totalCount] == "***") { #If the entry is ***
$mbar->Append($menuList[$subMenuCount]); #Add the menu to the bar
$menuItemCount = 0; #Reset the number of elements
$subMenuCount++; #Increment the number of menus
} else { #On normal operation
$menuList[$subMenuCount]->Append($id[$totalCount], $_[$totalCount]); #Add the element to the menu and assign it an ID
}
}
#print $mbar;
return (#id, $mbar);
}
#This package puts crap in the main window
package mehFrame;
use base qw(Wx::Frame);
sub new {
#Preparation
$class = shift;
$self = $class->SUPER::new(#_);
#Place the panel
$pan = Wx::Panel->new($self, -1);
#Set up menus
(#mehId, $mehBar) = Routines::SetupMenu("File", "Open ROM", "Save ROM", "Save ROM As", "---", "Close ROM", "Exit");
#Return
return $self;
}
[...]
Unfortunately, it doesn't work. After putting in a print in the SetupMenu() function, it did not print. On the other hand, when I put it a warn, it warned.
What's worse is that even if I put in a print in the new() function, it still doesn't print. What is going on?
Yakov, I'll take a stab at this in the absence of other answers, but take this with a grain of salt since I'm not a wxPerl expert.
Your description sounds like printing to STDERR works, since that's where warn goes, whereas printing to STDOUT does not.
Try doing print STDERR $mbar instead - I'm fairly sure it will work.
UPDATE: As per daotoad's excellent suggestion, this could also be attributed to lack of flush - if so, then setting autoflush on STDOUT would solve it. Whether it's one or the other, depends on what the OP tries. I added it to my answer since daotoad only posted a comment and didn't add his own separate answer yet - I will remove once he does that.
print works under Wx sometimes async undless you add an "\n"