I'm new to Mojolicious, trying to learn it. I'm trying to upload multiple files using form but only one file is uploaded at a time. Any suggestion?
#!perl -w
use Mojolicious::Lite;
use Mojo::Upload;
use v5.14;
get '/' => 'page';
post '/' => sub {
my $self = shift;
my #files;
for my $file ($self->req->upload('files')) {
my $size = $file->size;
my $name = $file->filename;
push #files, "$name ($size)";
$file->move_to("C:\\Program Files\\Apache Software Foundation\\Apache24\\htdocs\\ProcessingFolder\\".$name);
}
$self->render(text => "#files");
} => 'save';
app->start;
__DATA__
## page.html.ep
<!DOCTYPE html>
<html>
<body>
<form action="<%=/ProcessingFolder/%>" method="POST"
enctype="multipart/form-data">
<input name="files" type="file" enctype="multipart/form-data" multiple="multiple">
<button type="submit">Upload</button>
</form>
</body>
</html>
Found Answer. Used uploads() instead of upload() which returns Array reference.
#!perl -w
use Mojolicious::Lite;
use Mojo::Upload;
use v5.14;
get '/' => 'page';
post '/' => sub {
my $self = shift;
my #files;
for my $file (#{$self->req->uploads('files')}) {
my $size = $file->size;
my $name = $file->filename;
push #files, "$name ($size)";
$file->move_to("C:\\Program Files\\Apache Software Foundation\\Apache24\\htdocs\\ProcessingFolder\\".$name);
}
$self->render(text => "#files");
} => 'save';
app->start;
__DATA__
## page.html.ep
<!DOCTYPE html>
<html>
<body>
<form action="<%=/ProcessingFolder/%>" method="POST"
enctype="multipart/form-data">
<input name="files" type="file" enctype="multipart/form-data" multiple="multiple">
<button type="submit">Upload</button>
</form>
</body>
</html>
I think there is a small bug in the answer above - the variable ProcessingFolder is obsolete ...
#!perl -w
# install Mojolicious by : sudo -s 'curl -L cpanmin.us | perl - Mojolicious'
# run by : perl mojo-file-upload.pl daemon -m production -l http://*:8083
# point your browser #: http://127.0.0.1/upload-files
#
use Mojolicious::Lite;
use Mojo::Upload;
use v5.14;
get '/' => 'upload-files-page';
get '/upload-files' => 'upload-files-page';
post '/upload-files' => sub {
my $self = shift;
my #files;
for my $file (#{$self->req->uploads('files')}) {
my $size = $file->size;
my $name = $file->filename;
push #files, "$name ($size)";
$file->move_to("/tmp/".$name);
}
$self->render(text => "#files");
} => 'save';
app->start;
__DATA__
## upload-files-page.html.ep
<!DOCTYPE html>
<html>
<body>
<form action="/upload-files" method="POST"
enctype="multipart/form-data">
<input name="files" type="file"
enctype="multipart/form-data" multiple="multiple">
<button type="submit">Upload</button>
</form>
</body>
</html>
Related
My web page uses Charset UTF-8 to allow Chinese character input in a textarea form field. I want to test if the input contains a certain character. I've writtena test script to see how Perl is going to handle the Chinese input. It's not finding the match when there is a known match.
Here is my test form:
<!DOCTYPE html>
<head>
<meta charset="utf-8">
</head>
<body>
<form method="post" action="http://www.my_domain.com/cgi-bin/my_test_script.pl">
<textarea name="user_input" rows="" cols=""></textarea>
<input type="submit" name="submit" value="submit">
</form>
</body>
</html>
Here is my code:
#!/usr/bin/perl -T
use strict;
use warnings;
use CGI;
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use utf8;
print "Content-type: text/html; charset=UTF-8\n\n";
print "<meta http-equiv='content-type' content='text/html;charset=UTF-8'>";
my $query = new CGI;
my $msg = $query->param('user_input');
chomp $msg;
my $msg_code = ord($msg);
print "<p> Message was: ".$msg."\n";
print "<p> Message Code is: ".$msg_code."\n";
my $char_from_code_point = "\N{U+89C6}";
my $char_from_code_point_reverse_code = ord($char_from_code_point);
print "<p> char_from_code_point= ".$char_from_code_point."\n";
print "<p> char_from_code_point_reverse_code = ".$char_from_code_point_reverse_code."\n";
if ($msg =~ m/$char_from_code_point/) {
print "<p>Matched!\n";
}
else {
print "<p> NOT matched\n";
}
And here is the output from submitting the correct character:
Message was: 视
Message Code is: 232
char_from_code_point= 视
char_from_code_point_reverse_code = 35270
NOT matched
Could someone please point out what I'm doing wrong?
Thank you.
Suppose, we have the following HTML file:
test.htm
<!DOCTYPE html>
<html>
<head>
<title>test</title>
</head>
<body>
<b>weight:</b> 120kg<br>
<b>length:</b> 10cm<br>
</body>
</html>
How can I get the following data from it?
{
'weight' => '120kg',
'length' => '10cm',
}
parser.pl
#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use HTML::TreeBuilder;
my $root = HTML::TreeBuilder->new;
$root->parse_file('test.htm');
#what to do here?
$root->delete( );
This gets you very close to what you want (you'll need to tweak the text strings you're getting for the keys and values slightly).
But I think you'll find it far simpler using a tool like Web:Scraper.
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use Data::Dumper;
use HTML::TreeBuilder;
my $root = HTML::TreeBuilder->new;
$root->parse_file(\*DATA);
my $data;
foreach my $elem ($root->find('b')) {
$data->{($elem->content_list)[0]} = $elem->right;
}
say Dumper $data;
__END__
<!DOCTYPE html>
<html>
<head>
<title>test</title>
</head>
<body>
<b>weight:</b> 120kg<br>
<b>length:</b> 10cm<br>
</body>
</html>
Output:
$VAR1 = {
'length:' => ' 10cm',
'weight:' => ' 120kg'
};
Two solutions using Mojo::DOM:
use strict;
use warnings;
use Mojo::DOM;
use Data::Dump;
my $dom = Mojo::DOM->new(do {local $/; <DATA>});
my %hash = do {
my $text = $dom->find('body')->all_text();
split ' ', $text;
};
dd \%hash;
my %hash2 = map {
$_->all_text() => $_->next_sibling() =~ s{^\s+|\s+$}{}gr
} $dom->find('b')->each;
dd \%hash2;
__DATA__
<!DOCTYPE html>
<html>
<head>
<title>test</title>
</head>
<body>
<b>weight:</b> 120kg<br>
<b>length:</b> 10cm<br>
</body>
</html>
Outputs:
{ "length:" => "10cm", "weight:" => "120kg" }
{ "length:" => "10cm", "weight:" => "120kg" }
here is my html code
<html>
<title>Results</title>
<body><h1> Here are your results</h1>
<p>Please click the Button to see your result run by Ravi's team.</p>
<form action='index.pl' method='post'>
<input type='submit' value='submit'>
</form>
</body>
</html>
and index.pl is my perl and my subroutine is as follows.
sub my_result{
my $run;
my $dir="/kbio/sraja/BenzoExposedDataSet/database/Output";
my $parsebphtml = "/parse_bphtml.pl";
my $olgacsvfile = "/database/Output/sample.csv";
my #bp=<$dir/*.bp>;
$run ="perl $parsebphtml > $olgacsvfile";
# print "$com\n";
system($run)==0 or my_err("Could not run $run\n");
#printing the table
open(F,"$olgacsvfile") or my_err("Could not open the csv ($olgacsvfile) file");
print "<h2> Average Results </h2>";
print "<table border=1>";
while(my $line=<F>){
print "<tr>";
my #cells= split ',',$line;
foreach my $cell (#cells)
{
print "<td colspan=1>$cell</td>";
}
print "</tr>";
}
print "</table>";
}
So as you see, table is what i need to return to results.html
Any help would be really appreciable.
thanks .
Geet
I don't know how much work you want to do but, if you want to keep it simple give a try at the HTML::Template module. Here is a simple usage example.
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset=utf-8>
<title>A random page</title>
</head>
<body>
<TMPL_VAR NAME=page_content>
</body>
</html>
My perl code contained something like this. Better yet, check the documentation at http://metacpan.org/pod/HTML::Template .
use HTML::Template;
sub my_result {
return $html_string;
}
my $master_template = HTML::Template->new(filename => "Path to html template file");
$master_template->param('page_content' => my_result());
Depending on how far you plan on going with this, I would recommend that you a more advanced templating system such as the one used by the mojolicious framework (http://mojolicio.us/perldoc/Mojo/Template).
Cheers,
MrMcKizzle
I'm trying to achieve one last task for my assignment is to validate the form before submit it to the another CGI program.
What happen is that I have a simple CGI program that will ask user to input the data
#!/usr/bin/perl -w
use CGI qw/:standard/;
# Standard HTTP header
print header();
# Write information to data file and produce a form
&printForm();
# Finish HTML page
print end_html();
# This sub will create a form to access the print_fortune.cgi script
sub printForm
{
print qq~
<html>
<head><title>My Search Engine</title>
</head>
<body>
<form action="b1.cgi" method="GET">
What is your e-msil address? <input type="text" name="passing" size=40>
<input type="submit" value="send address">
<input type="hidden" name="form" value="insert" />
</form>
<form method="get" action="b1.cgi" enctype="application/x-www-form-urlencoded">
<input type="text" name="search" value="" size="30" /><br />
<label><input type="radio" name="option" value="name" checked="checked" />name</label>
<label><input type="radio" name="option" value="author" />author</label><label>
<input type="radio" name="option" value="url" />url</label>
<label><input type="radio" name="option" value="keyword" />keyword</label>
<input type="submit" name=".submit" value="Search" />
<input type="hidden" name="passing" value="http://default.com" />
<div><input type="hidden" name="form" value="search" /></div></form>
</body>
So the above program contains two forms. One is to add new data to the database and the other one is to search from the database.
#!/usr/bin/perl
print "Content-type: text/html\n\n";
use LWP::Simple;
use CGI;
use HTML::HeadParser;
use DBI;
my $serverName = "";
my $serverPort = "";
my $serverUser = "";
my $serverPass = "";
my $serverDb = "";
my $serverTabl = "";
$cgi = CGI->new;
my $pass = $cgi->param('passing');
$URL = get ("$pass");
$head = HTML::HeadParser->new;
$head->parse("$URL");
my $methods = $cgi->param('form');
if ($methods eq "insert"){
insert_entry();
}
show_entries();
sub insert_entry {
my ($dbh, $success, $name, $author, $url,$temp);
$dbh = DBI->connect("DBI:mysql:database=$serverDb;host=$serverName;port=$serverPort",$serverUser,$serverPass);
$name = $head->header('X-Meta-Name');
$author = $head->header('X-Meta-Author');
$url = $cgi->param('passing');
$temp = $head->header('X-Meta-Keywords');
#keyword = split(/,/,$temp);
$success = $dbh->do("INSERT INTO $serverTabl(name,author,url,keyword1,keyword2,keyword3,keyword4,keyword5) VALUES(?,?,?,?,?,?,?,?)", undef,$name,$
author,$url,$keyword[0],$keyword[1],$keyword[2],$keyword[3],$keyword[4]);
$dbh->disconnect;
if($success != 1) {
return "Sorry, the database was unable to add your entry.
Please try again later.";
} else {
return;
}
}
sub show_entries {
my ($dbh, $sth, #row);
my $search = $cgi->param('search');
my $option = $cgi->param('option');
$dbh = DBI->connect("DBI:mysql:database=$serverDb;host=$serverName;port=$serverPort",$serverUser,$serverPass);
$sth = $dbh->prepare("SELECT *
FROM $serverTabl
WHERE $option LIKE '%$search%'");
$sth->execute;
print "Existing Entries",HR;
while(#row = $sth->fetchrow_array) {
$row[5] = scalar(localtime($row[5]));
print "<table border='2'><tr>";
print "<td>" . $row[0] . "</td>";
print "<td>Name" . $row[1] . "</td>";
print "<td>Author" . $row[2] . "</td>";
print "<td>URL" . $row[3] . "</td>";
print "<td>Keyword1" . $row[4] . "</td>";
print "<td>Keyword2" . $row[5] . "</td>";
print "<td>Keyword3" . $row[6] . "</td>";
print "<td>Keyword4" . $row[7] . "</td>";
print "<td>Keyword5" . $row[8] . "</td>";
print "</tr></table>";
}
$sth->finish;
$dbh->disconnect;
}
So now the question is how can I do a regular expression for the form submission before it goes to the second program?
I want to do validation for
name allows spaces but only alphabetical characters
author allows spaces but only alphabetical characters
keywords allows no spaces and only alphabetical characters
url only allows alphanumerical characters and the following :/.~?=+& No two periods can exist consecutively.
I'm really sorry but I'm really new to Perl. We are only been taught about PHP, but Perl almost nothing....
The perluniprops Perl document lists all the \p regular expression properties.
For a string that contains only letters, you want
/^[\p{Alpha}]+$/
For a string that contains only letters and spaces you want
/^[\p{Alpha}\x20]+$/
To match a URL the documentation of the URI module gives this as an official pattern to match a URL
m|^(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?$|
Be sure to cite the references in your work to get extra marks!
Im trying to parse some html tags using perl module Web::Scraper but seems Im an inept using perl. I wonder if anyone can look for mistakes in my code...:
This is my HTML to parse (2 urls inside li tags):
<more html above here>
<div class="span-48 last">
<div class="span-37">
<div id="zone-extract" class="123">
<h2 class="genres"></h2>
<li>1</li>
<li><a class="sel" href="**URL_TO_EXTRACT_2**">2</a></li>
<li class="first">Pàg</li>
</div>
</div>
</div>
<more stuff from here>
Im trying to obtain:
ID:1 Link:URL_TO_EXTRACT_1
ID:2 Link:URL_TO_EXTRACT_2
With this perl code:
my $scraper = scraper {
process ".zone-extract > a[href]", urls => '#href', id => 'TEXT';
result 'urls';
};
my $links = $scraper->scrape($response);
This is one of the infinite process combinations I tried, with two different results: An empty return, or all the urls inside code (and I only need links inside zone-extract).
Resolved with mob's contribution... #zone-extract instead .zone-extract :)
#!/usr/bin/env perl
use strict;
use warnings;
use Web::Scraper;
my $html = q[
<div class="span-48 last">
<div class="span-37">
<div id="zone-extract" class="123">
<h2 class="genres"></h2>
<li>1</li>
<li><a class="sel" href="**URL_TO_EXTRACT_2**">2</a></li>
<li class="first">Pàg</li>
</div>
</div>
</div>
]; # / (turn off wrong syntax highlighting)
my $parser = scraper {
process '//div[#id="zone-extract"]//a', 'urls[]' => sub {
my $url = $_[0]->attr('href') ;
return $url;
};
};
my $ref = $parser->scrape(\$html);
print "$_\n" for #{ $ref->{urls} };