Is it possible to have more than one flash message at a time under Mojolicious?
I have a case where a form can have multiple errors, and I want to be able to list all the error messages at once, instead of finding one error, displaying one error, having the user fix one error, repeat for the other errors.
In this example where messages are set in one page, and then displayed in another, only the last message added is shown.
get '/' => sub {
my ($c) = #_;
$c->flash(msg => "This is message one.");
$c->flash(msg => "This is message two.");
$c->flash(msg => "This is message three.");
$c->flash(msg => "This is message four.");
$c->flash(msg => "This is message five.");
return $c->redirect_to('/second');
};
get '/second' => sub {
my ($c) = #_;
return $c->render(template => 'second');
};
app->secrets(["aren't important here"]);
app->start;
__DATA__
## second.html.ep
<!doctype html><html><head><title>Messages</title></head>
<body>
These are the flash messages:
<ul>
% if (my $msg = flash('msg')) {
<li><%= $msg %></li>
% }
</ul>
</body></html>
The output is
These are the flash messages:
This is message five.
I have also tried fetching the messages in list context, but still only the last message is displayed.
__DATA__
## second.html.ep
<!doctype html><html><head><title>Messages</title></head>
<body>
These are the flash messages:
<ul>
% if (my #msg = flash('msg')) {
% foreach my $m (#msg) {
<li><%= $m %></li>
% }
% }
</ul>
</body></html>
Thank you.
Flash data is stored in a hash. You are overwriting the value for key 'msg' each time you call flash().
You can use flash to store a data structure instead of a scalar value:
use Mojolicious::Lite -signatures;
get '/' => sub {
my ($c) = #_;
my #messages = map ("This is message $_", qw/one two three four/);
$c->flash(msg =>\#messages);
return $c->redirect_to('/second');
};
get '/second' => sub {
my ($c) = #_;
return $c->render(template => 'second');
};
app->secrets(["aren't important here"]);
app->start;
__DATA__
## second.html.ep
<!doctype html><html><head><title>Messages</title></head>
<body>
These are the flash messages:
<ul>
% for my $msg (#{flash('msg')//[]}) {
<li><%= $msg %></li>
% }
</ul>
</body></html>
Related
I want to process a number of files with http://2struc.cryst.bbk.ac.uk/twostruc; to automate this I wrote a perl script using perl's HTML::Form.
This server has a two step submit process: first, upload a file or enter an id; second, select the methods to be used and the output (by chosing one of five submits).
The first step works, but for the second step I seem to be unable to chose any submit button other than the first, even though my script output confirms that I selected the one I want (different from the first).
The two core parts of the code are below, the request function:
sub create_submit_request
{
my $form_arrayref = shift;
my $form_action = shift;
my $value_hashref = shift;
my $submit_name = shift;
my $submit_index = shift;
my $found_form = 0;
my $form;
foreach my $this_form( #$form_arrayref)
{
printf( "# Found form with action=%s\n", $this_form->action);
if( $this_form->action eq $form_action)
{
$found_form = 1;
$form = $this_form;
}
}
die( "# Error: No form with action $form_action") if( $found_form == 0);
my #inputs = $form->inputs;
my $inputs_string;
foreach my $input( #inputs)
{
my $input_name = defined( $input->name) ? $input->name : "<unnamed_input>";
my $input_value = defined( $input->value) ? $input->value : "";
$inputs_string .= $input_name.( length( $input_value) > 0 ? "=".$input_value : "")." (".$input->type."); ";
}
printf( "# Available input names: %s\n", $inputs_string);
printf( "# Filling in form data\n");
while( my( $key, $value) = each( %$value_hashref))
{
$form->value( $key, $value);
}
my #submit_buttons = $form->find_input( $submit_name, "submit", $submit_index); # 1-based counting for the index
die( "# Error: Can only handle a single submit, but found ".scalar( #submit_buttons)) if( scalar( #submit_buttons) != 1);
my %submit_hash = %{ $submit_buttons[ 0]};
# DEBUG
printf( "# Use submit: %s\n", Data::Dumper->Dump( [ \%submit_hash ]));
return $form->click( %submit_hash);
}
and the code using it:
my $request = HTTP::Request->new( GET => $url_server);
my $response = $useragent->request( $request);
# the first page contains the pdb id input and file upload inputs
my #forms = HTML::Form->parse( $response);
my %value_hash = ( "file" => $pdb_file);
# the submit buttons have no name, use undef; chose the first one (w/o javascript)
$request = create_submit_request( \#forms, $form_action1, \%value_hash, undef, 1);
printf( "# Submitting to server\n");
$response = $useragent->request( $request);
# the first page contains the pdb id input and file upload inputs
#forms = HTML::Form->parse( $response);
%value_hash =( "dsspcont" => "on", "stride" => "on");
# this form has 5 submit buttons; select the 5th
$request = create_submit_request( \#forms, $form_action2, \%value_hash, undef, 5);
printf( "# Submitting to server\n");
$response = $useragent->request( $request);
my $response_content = $response->content;
printf( "# Response content: %s\n", $response_content);
Even though the script prints
# Use submit: $VAR1 = {
'name' => 'function_sequenceStructureAlignment',
'onclick' => 'this.form.target=\'_blank\';return true;',
'type' => 'submit',
'value' => 'Sequence Structure Alignments',
'value_name' => ''
};
which is the 5th submit button in the second step, the response is equivalent to pressing the first submit button.
To test the server itself, the file 1UBI.pdb can be downloaded from http://www.rcsb.org/pdb/files/1UBI.pdb and uploaded to the server. The full script is at http://pastebin.com/bSJLvNfc and can be run with
perl 2struc.pl --pdb 1UBI.pdb
Why is the server returning a different output/submit that I seem to select in the script?
(It seems it's not dependend on cookies, because I can clear them after the first step, and still get the correct result for the second step in a web browser.)
You gave a hash as selector for click, which is wrong (see documentation how to specify the selector). But because you have already found the correct submit element you could simply call click directly on it:
--- orig.pl
+++ fixed.pl
## -87,7 +87,7 ##
# DEBUG
printf( "# Use submit: %s\n", Data::Dumper->Dump( [ \%submit_hash ]));
- return $form->click( %submit_hash);
+ return $submit_buttons[0]->click($form);
}
sub predict_pdb
Imagine an HTML page that is a report with repetitive structure:
<html>
<body>
<h1>Big Hairy Report Page</h1>
<div class="customer">
<div class="customer_id">001</div>
<div class="customer_name">Joe Blough</div>
<div class="customer_addr">123 That Road</div>
<div class="customer_city">Smallville</div>
<div class="customer_state">Nebraska</div>
<div class="order_info">
<div class="shipping_details">
<ul>
<li>Large crate</li>
<li>Fragile</li>
<li>Express</li>
</ul>
</div>
<div class="order_item">Deluxe Hoodie</div>
<div class="payment">35.95</div>
<div class="order_id">000123456789</div>
</div>
<div class="comment">StackOverflow rocks!</div>
</div>
<div class="customer">
<div class="customer_id">002</div>
.... and so forth for a list of 150 customers
This kind of report page appears often. My goal is to extract each customer's related information into some reasonable data structure using HTML::TreeBuilder::XPath.
I know to do the basics and get the file read into $tree. But how can one concisely loop through that tree and get associated clusters of information per each customer? How, for example, would I create a list of address labels sorted by customer number based on this information? What if I want to sort all my customer information by state?
I'm not asking for the whole perl (I can read my file, output to file, etc). I just need help understanding how to ask HTML::TreeBuilder::XPath for those bundles of related data, and then how to dereference them. If it's easier to express this in terms of an output statement (i.e., Joe Blough ordered 1 Deluxe Hoodie and left 1 comment) then that's cool, too.
Thank you very much for those of you who tackle this one, it seems a bit overwhelming to me.
This will do what you need.
It starts by pulling all the <div class="customer"> elements into array #customers and extracting the information from there.
I have taken your example of the address label, sorted by the customer number (by which I assume you mean the field with class="customer_id"). All of the address values are pulled from the array into the hash %customers, keyed by the customer ID and the name of the element class. The information is then printed in the order of the ID.
use strict;
use warnings;
use HTML::TreeBuilder::XPath;
my $tree = HTML::TreeBuilder::XPath->new_from_file('html.html');
my #customers = $tree->findnodes('/html/body/div[#class="customer"');
my %customers;
for my $cust (#customers) {
my $id = $cust->findvalue('div[#class="customer_id"]');
for my $field (qw/ customer_name customer_addr customer_city customer_state /) {
my $xpath = "div[\#class='$field']";
my $val = $cust->findvalue($xpath);
$customers{$id}{$field} = $val;
}
}
for my $id (sort keys %customers) {
my $info = $customers{$id};
print "Customer ID $id\n";
print $info->{customer_name}, "\n";
print $info->{customer_addr}, "\n";
print $info->{customer_city}, "\n";
print $info->{customer_state}, "\n";
print "\n";
}
output
Customer ID 001
Joe Blough
123 That Road
Smallville
Nebraska
use HTML::TreeBuilder::XPath;
...
my #customers;
my $tree = HTML::TreeBuilder::XPath->new_from_content( $mech->content() );
foreach my $customer_section_node ( $tree->findnodes('//div[ #class = "customer" ]') ) {
my $customer = {};
$customer->{id} = find_customer_id($customer_section_node);
$customer->{name} = find_customer_name($customer_section_node);
...
push #customers, $customer;
}
$tree->delete();
sub find_customer_id {
my $node = shift;
my ($id) = $node->findvalues('.//div[ #class = "customer_id" ]');
return $id
}
I'll use XML::LibXML since it's faster and I'm familiar with it, but it should be pretty straightforward to convert what I post to from XML::LibXML to HTML::TreeBuilder::XPath if you so desire.
use XML::LibXML qw( );
sub get_text { defined($_[0]) ? $_[0]->textContent() : undef }
my $doc = XML::LibXML->load_html(...);
my #customers;
for my $cust_node ($doc->findnodes('/html/body/div[#class="customer"]')) {
my $id = get_text( $cust_node->findnodes('div[#class="customer_id"]') );
my $name = get_text( $cust_node->findnodes('div[#class="customer_name"]') );
...
push #customers, {
id => $id,
name => $name,
...
};
}
Actually, given the regularity of the data, you don't have to hardcode the field names.
use XML::LibXML qw( );
sub parse_list {
my ($node) = #_;
return [
map parse_field($_),
$node->findnodes('li')
];
}
sub parse_field {
my ($node) = #_;
my #children = $node->findnodes('*');
return $node->textContent() if !#children;
return parse_list($children[0]) if $children[0]->nodeName() eq 'ul';
return {
map { $_->getAttribute('class') => parse_field($_) }
#children
};
}
{
my $doc = XML::LibXML->load_html( ... );
my #customers =
map parse_field($_),
$doc->findnodes('/html/body/div[#class="customer"]');
...
}
I'm using formmail.pl to handle a form I'm using on my site. There are several fields which are sent to the script including name, email, phone and some text in a text area.
As it stands, the successful submission prints the phone and textarea data correctly but doesn't print the name and email which were entered. In the email it sends the name and email in the 'from' header and as with the success page only shows the phone and textarea data are shown in the email body.
I would like to show all data in both cases however I can't seem to find the section of code that handles this. I'd post up the formmail.pl script except its over 3000 lines of code so I'll just post the places I think are responsible and hopefully somebody can point me in the right direction. I'm fairly new to Perl and its a bit overwhelming reading and understanding a script of this size.
sub success_page {
my ($self, $date) = #_;
if ($self->{FormConfig}{'redirect'}) {
print $self->cgi_object->redirect( $self->{FormConfig}{'redirect'} );
}
elsif ( $self->{CFG}{'no_content'}) {
print $self->cgi_object->header(Status => 204);
}
else {
$self->output_cgi_html_header;
$self->success_page_html_preamble($date);
$self->success_page_fields;
$self->success_page_footer;
}
}
sub success_page_html_preamble {
my ($self, $date) = #_;
my $title = $self->escape_html( $self->{FormConfig}{'title'} || 'Success' );
my $torecipient = 'to ' . $self->escape_html($self->{FormConfig}{'recipient'});
$torecipient = '' if $self->{Hide_Recipient};
my $attr = $self->body_attributes;
print <<END;
<head>
<title>$title</title>
END
$self->output_style_element;
print <<END;
<link type="text/css" href="css/stylesheet.css" rel="stylesheet" /></script>
</head>
<body>
<p>Below is what you submitted $torecipient on $date</p>
END
}
sub success_page_fields {
my ($self) = #_;
foreach my $f (#{ $self->{Field_Order} }) {
my $val = (defined $self->{Form}{$f} ? $self->{Form}{$f} : '');
$self->success_page_field( $self->escape_html($f), $self->escape_html($val) );
}
}
sub success_page_field {
my ($self, $name, $value) = #_;
print "<p><b>$name:</b> $value</p>\n";
}
Okay that's getting a bit long. That stuff is mostly for the success page and not much to do with the email side of things but maybe if somebody can find what I need there I can apply it to the email section also.
If any further information is needed let me know
Thanks in Advance
I haven't really used NMS FormMail myself, but looking at the source, it seems that you should be able to achieve something like what you want by setting the following extra configuration options:
$more_config{include_config_email} = 1;
$more_config{include_config_realname} = 1;
This should cause FormMail.pl to treat the email and realname fields as normal form fields, in addition to their special meaning.
I am building a HTML parser in Perl. I would like to know if the HTML element is an element without any sibilings.
Here is the HTML, I would like to parse :
<span class="bold1">A:</span> ELementA<br />
<span class="bold1">B:</span> mailto:admin<br />
<span class="bold1">C </span> 01/12<br />
<span class="bold1">D:</span> ELementC<br />
<span class="bold1">E:</span> ElementD<br />
<span class="bold1">F:</span> ElementE<br />
How to check if the element is the end element.
I am getting the error :
Can't call method "as_text" without a package or object reference at
Any idea what could be wrong ?
Here is the code snippet in Perl,
my $mech = WWW::Mechanize->new( autocheck => 1 );
eval
{
$mech->get($url);
};
if ($#)
{
print "Error connecting to URL $url \n";
exit(0);
}
my $root = HTML::TreeBuilder->new_from_content(decode_utf8($mech->content));
my #PageSections = $root->look_down(
sub {
return (
($_[0]->tag() eq 'span' ) and
($_[0]->attr('class') =~ m/bold1/i) )
});
my $temp2;
my $temp3;
for my $ps (#PageSections)
{
# my $temp1= $ps->right()->as_text;
$temp2= $ps->as_text;
my $temp3=ref $ps->right();
#
print defined $temp3 ? "defined \n" : "not defined\n";
}
Thanks
It's hard to tell without knowing more of your code, but I'm guessing #PageSections contains objects of some home brewed module, and that something happens there to make $_ point to something completely different. I'd go with
for my $ps (#PageSections)
{
my $temp1= $ps->right()->as_text;
my $temp2= $ps->as_text;
print "$temp2 " . $temp1 . " \n";
}
instead.
I have the following script that scrapes my schools CS department to get a list of all the courses. I want to be able to extract the CRN (course number) and other important information to put into a database which I can let users browse through a web app.
Here is an example URL:
http://courses.illinois.edu/cis/2011/spring/schedule/CS/411.html
I would like to extract info from pages like this. The first level of the scraper just constructs the individual sites from a list of all of the courses. Once I'm at a course specific catalog page, I use the second scraper to attempt to get all of this info i want. For some reason, although the CRN's and Course Instructors are all 'td' elements. My scraper seems to be returning nothing when scraping. I tried to scrape specifically for 'div' instead and I get a bunch of info for each relevant page. So somehow I'm failing to get the 'td' element, but I'm scraping from the right page.
my $tweets = scraper {
# Parse all LIs with the class "status", store them into a resulting
# array 'tweets'. We embed another scraper for each tweet.
# process "h4.ws-ds-name.detail-title", "array[]" => 'TEXT';
process "div.ws-row", "array[]" => 'TEXT';
};
my $res = $tweets->scrape( URI- >new("http://courses.illinois.edu/cis/2011/spring/schedule/CS/index.html?skinId=2169") );
foreach my $elem (#{$res->{array}}){
my $coursenum = substr($elem,2,4);
my $secondLevel = scraper{
process "td.ws-row", "array2[]" => 'TEXT';
};
my $res2 = $secondLevel->scrape(URI- >new("http://courses.illinois.edu/cis/2011/spring/schedule/CS/$coursenum.html"));
my $num = #{$res2->{array2}};
print $num;
print "---------------------", "\n";
my #curr = #{$res2->{array2}};
foreach my $elem2 (#curr){
$num++;
print $elem2, " ", "\n";
}
print "---------------------", "\n";
}
Any ideas?
Thanks
Looks to me like
my $coursenum = substr($elem,2,4)
should be
my $coursenum = substr($elem,3,3)
The easiest way to go in this case is use
HTML::TableExtract
In case you are looking for data from the table only.
I played a bit with your problem. You can get course id, title and link to individual course page within initial scraper:
my $courses = scraper {
process 'div.ws-row',
'course[]' => scraper {
process 'div.ws-course-number', 'id' => 'TEXT';
process 'div.ws-course-title', 'title' => 'TEXT';
process 'div.ws-course-title a', 'link' => '#href';
};
result 'course';
};
The result of scraping is arrayref with hashrefs like this:
{ id => "CS 103",
title => "Introduction to Programming",
link => bless(do{\(my $o = "http://courses.illinois.edu/cis/2011/spring/schedule/CS/103.html?skinId=2169")}, "URI::http"),
},
....
Then you can do additional scraping for each course from their individual pages and add such information into original structure:
for my $course (#$res) {
my $crs_scraper = scraper {
process 'div.ws-description', 'desc' => 'TEXT';
# ... add more items here
};
my $additional_data = $crs_scraper->scrape(URI->new($course->{link}));
# slice assignment to add them into course definition
#{$course}{ keys %$additional_data } = values %$additional_data;
}
Source combined together is as follows:
use strict; use warnings;
use URI;
use Web::Scraper;
use Data::Dump qw(dump);
my $url = 'http://courses.illinois.edu/cis/2011/spring/schedule/CS/index.html?skinId=2169';
my $courses = scraper {
process 'div.ws-row',
'course[]' => scraper {
process 'div.ws-course-number', 'id' => 'TEXT';
process 'div.ws-course-title', 'title' => 'TEXT';
process 'div.ws-course-title a', 'link' => '#href';
};
result 'course';
};
my $res = $courses->scrape(URI->new($url));
for my $course (#$res) {
my $crs_scraper = scraper {
process 'div.ws-description', 'desc' => 'TEXT';
# ... add more items here
};
my $additional_data = $crs_scraper->scrape(URI->new($course->{link}));
# slice assignment to add them into course definition
#{$course}{ keys %$additional_data } = values %$additional_data;
}
dump $res;