I am trying to do the following.
Take a block of text that a user inputs in a TEXTAREA FORM from a website and pass it to a perl/cgi script that adds the line number before each line. So for example:
diet coke
potato chips
gelato
would become
1 diet coke
2 potato chips
3 gelato
I know how to pass a single value or a bunch of values to a perl script, but when I try to do a foreach (#array) to add a line number it doesn't work. Wondering how to do this.
My html file is
<HTML>
<BODY>
<FORM ACTION="/cgi-bin/splitfoods.pl">
<P>What did you eat today? <BR><TEXTAREA NAME="value" ID="value" style="width:900px;height\
:700px;background-color:#FFF8DC;font-size:20px">
</TEXTAREA>
<P><INPUT TYPE="SUBMIT" VALUE="Submit">
</FORM>
</BODY>
</HTML>
and the cgi file is (from matthewh)
#!/usr/bin/perl
use CGI;
use CGI qw(:standard);
$query = new CGI;
#foods = split('\n',$query->param("value"));
# -- HTML STUFF --
print header;
print start_html;
for($i=1; $i<=#foods; $i++) {
print "$i #foods[$i-1]";
print "<br>";
}
print end_html;
request looks like
cgi-bin/splitfoods.pl?value=diet+coke%0D%0Apotato+chips%0D%0Agelato
Thanks
#foods = split('\n',$query->param('food'));
for($i=1; $i<=#foods; $i++) {
print "$i #foods[$i-1]\n";
}
This is a bit cleaner and less likely to breakdown on edge cases. Plus the numbering is HTML instead which is more natural for web. You really should read the entire document for CGI and always start code with warnings and strict on.
use strict;
use warnings;
no warnings "uninitialized";
use CGI ":standard";
# Scalar/array context matters with param()!
my $food = param("value");
my #foods = split /\n/, $food;
print
header(),
start_html(),
ol(li( \#foods )),
end_html();
Related
I need to extract captcha from url and recognised it with Tesseract.
My code is:
#!/usr/bin/perl -X
###
$user = 'user'; #Enter your username here
$pass = 'pass'; #Enter your password here
###
#Server settings
$home = "http://perltest.adavice.com";
$url = "$home/c/test.cgi?u=$user&p=$pass";
###Add code here!
#Grab img from HTML code
#if ($html =~ /<img. *?src. *?>/)
#{
# $img1 = $1;
#}
#else
#{
# $img1 = "";
#}
$img2 = grep(/<img. *src=.*>/,$html);
if ($html =~ /\img[^>]* src=\"([^\"]*)\"[^>]*/)
{
my $takeImg = $1;
my #dirs = split('/', $takeImg);
my $img = $dirs[2];
}
else
{
print "Image not found\n";
}
###
die "<img> not found\n" if (!$img);
#Download image to server (save as: ocr_me.img)
print "GET '$img' > ocr_me.img\n";
system "GET '$img' > ocr_me.img";
###Add code here!
#Run OCR (using shell command tesseract) on img and save text as ocr_result.txt
system("tesseract ocr_me.img ocr_result");
print "GET '$txt' > ocr_result.txt\n";
system "GET '$txt' > ocr_result.txt";
###
die "ocr_result.txt not found\n" if (!-e "ocr_result.txt");
# check OCR results:
$txt = 'cat ocr_result.txt';
$txt =~ s/[^A-Za-z0-9\-_\.]+//sg;
$img =~ s/^.*\///;
print `echo -n "file=$img&text=$txt" | POST "$url"`;
As you see I`m trying extract img src tag. This solution did not work for me ($img1) use shell command tesseract in perl script to print a text output. Also I used adopted version of that solution($img2) How can I extract URL and link text from HTML in Perl?.
If you need HTMLcode from that page, here is:
<html>
<head>
<title>Perl test</title>
</head>
<body style="font: 18px Arial;">
<nobr>somenumbersimg src="/JJ822RCXHFC23OXONNHR.png"
somenumbers<img src="/captcha/1533030599.png"/>
somenumbersimg src="/JJ822RCXHFC23OXONNHR.png" </nobr><br/><br/><form method="post" action="?u=user&p=pass">User: <input name="u"/><br/>PW: <input name="p"/><br/><input type="hidden" name="file" value="1533030599.png"/>Text: <input name="text"></br><input type="submit"></form><br/>
</body>
</html>
I got error that image not found. My problem is wrong regular expression, as I think.I can not install any modules such as HTTP::Parser or similar
Aside from the fact that using regular expressions on HTML isn't very reliable, your regular expression in the following code isn't going to work because it's missing a capture group, so $1 won't be assigned a value.
if ($html =~ /<img. *?src. *?>/)
{
$img = $1;
}
If you want to extract parts of text using a regular expression you need to put that part inside brackets. Like for example:
$example = "hello world";
$example =~ /(hello) world/;
this will set $1 to "hello".
The regular expression itself doesn't make that much sense - where you have ". *?", that'll match any character followed by 0 or more spaces. Is that a typo for ".*?" which would match any number of characters but isn't greedy like ".*", so will stop when it finds a match for the next part of the regex.
This regular expression is possibly closer to what you're looking for. It'll match the first img tag that has a src attribute that starts with "/captcha/" and store the image URL in $1
$html =~ m%<img[^>]*src="(/captcha/[^"]*)"%s;
To break it down how it works. The "m%....%" is just a different way of saying "/.../" that allows you to put slashes in the regex without needing to escape them. "[^>]*" will match zero or more of any character except ">" - so it won't match the end of the tag. And "(/captcha/[^"]*)" is using a capture group to grab anything inside the double quotes that will be the URL. It's also using the "/s" modifier on the end which will treat $html as if it is just one long line of text and ignoring any \n in it which probably isn't needed, but on the off chance the img tag is split over multiple lines it'll still work.
this is the html form... simple form with 1 field... I eventually will incorporate some logic to control when the redirect is done, but for now, all I want is to see it work... I have tried several methods, and nothing has worked... I have stripped down the code to the bare basics, but still no joy...
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>query your team</title>
</head>
<body>
<h2>team query form</h2>
<form method="post" id="newform" action="cgi-bin/team_disp.pl">
<div style="padding-left:30px; padding-top:50px;">
<div style="padding-top:75px;">
<p>Enter Search Criteria </p>
</div>
<div style="margin-top: -15px;">
<input type="text" name="srchtxt" maxlength="100" length="50">
<input type="submit" value="Search">
</div>
</div>
</form>
</body>
</html>
and here's my perl script... just trying to get redirect to re-paint the screen with the "referer"... again, I tried multiple ways to get this, but it would never render... I am not sure if my site is disallowing redirects? I have had some near misses, but nothing redirects the actual page... I see the referer is set properly, but my attempts to manually set it, or refer to it have thus far failed...
#!/usr/bin/perl
# use strict;
use warnings;
use DBI;
use CGI;
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use CGI qw(redirect referer);
use CGI qw/:standard/;
print "Content-type: text/html \n\n";
$db_handle = DBI->connect("dbi:mysql:database=fauqu001_fqdb;host=fauqu001.mysql.guardedhost.com;;user=fauqu001_fqdb;password=t8rdG^h6sC2f")
or die "Couldn't connect to database: $DBI::errstr\n";
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#pairs = split(/&/, $buffer);
foreach $pair (#pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
print '<br><h3>',$name,' = ',$value,'</br>';
}
my $query = CGI->new();
my $referrer = $ENV{HTTP_REFERER};
print $query->redirect($referrer);
my $xdate = `date`;
my $cgi = new CGI;
print $cgi->header();
print 'user_agent(): ' . $cgi->user_agent() . '<br>';
print 'remote_host(): ' . $cgi->remote_host() . '<br>';
print 'script_name(): ' . $cgi->script_name() . '<br>';
print 'referer(): ' . $cgi->referer() . '<br>';
print 'request_method(): ' . $cgi->request_method() . '<br>';
end;
The redirect header needs to be part of the headers returned by your CGI program. The headers are the first data returned by your program. They are terminated by the first blank line in your program's output. More specifically, the headers are terminated when your program emits two consecutive line-end characters.
Early in your program you have:
print "Content-type: text/html \n\n";
That print() statements ends with two consecutive line-end characters. Therefore, your program can emit no more headers after this point. Any data returned by your program after this point will be treated as the body of the response, not the header.
So when, several lines later, you run this:
print $query->redirect($referrer);
That won't be interpreted as a redirection header. It's just data in the body of your response.
A useful tip in a CGI program: Work out exactly what you want to return before you return anything at all. You needed to print the redirection header instead of the content type header. But because you had already printed the content-type header (and, more importantly, the end of headers marker) it was too late to change your mind and print a different header.
Your program shows many signs of being cannibalised from several other programs without any real understanding of what you are doing.
You load the CGI library three times:
use CGI;
...
use CGI qw(redirect referer);
use CGI qw/:standard/;
You create two CGI objects:
my $query = CGI->new();
....
my $cgi = new CGI;
You ignore CGI's parameter parsing code and use a buggy hand-written version:
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#pairs = split(/&/, $buffer);
foreach $pair (#pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
print '<br><h3>',$name,' = ',$value,'</br>';
}
You explicitly load the referer() function from CGI.pm, but then get the value using an environment variable:
use CGI qw(redirect referer);
...
my $referrer = $ENV{HTTP_REFERER};
You don't just print the two header sets that I've mentioned above. You find time to add a third later on.
print "Content-type: text/html \n\n";
print $query->redirect($referrer);
print $cgi->header();
I assume (I hope!) that you're just learning Perl and CGI. But this random poking at stuff until it works really isn't the best way to do it. Please find a good tutorial and spend time understanding what is going on here.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 8 years ago.
Improve this question
I am using XAMMP Apache Server. There is a text file named 'animal.txt' containing the name of an animal on each line, with a basic description.
I am trying to write a Perl program, using HTML and CGI. The aim of the program is to have the user search an animal name, using a HTML form. This will then link to a Perl program which loops through the animal.txt file and reads the file line by line. The program will take any line that matches the users search from the original HTML form, and print all animals containing the same name.
So far this is where I am :
(Clientside form)
#!\xampp\perl\bin\perl.exe
use CGI qw/:standard/; # load standard CGI routines
use CGI::Carp('fatalsToBrowser');
print header(); # create the HTTP header
print <<HTML
<head>
<title>Shop Here</title>
</head>
<body>
<h1>Animal list search</h1>
A basic form <br />
<form action="dumpsVar2.pl">
Search: <input type="text", name="Search" size=5><br><br>
Submit: <input type="submit" name="select" size="7"><br>
</form>
</body>
</html>
HTML
And then the perl program: (Server-Side)
#!\xampp\perl\bin\perl.exe
use CGI qw(:standard);
use CGI::Carp('fatalsToBrowser');
$query = new CGI;
#parameters = $query -> param;
print header, start_html("Parameters");
print "$0 was passed these parameters:<br> <br> ";
foreach $name (#parameters) {
$value = $query -> param($name);
print p("$name = $value");
}
$inFile = "animal.txt";
open (IN, $inFile) or die "Can't find file: $inFile";
#animals = (<IN>);
$item = param;
foreach $line (<IN>) {
if ($line =~ /$item/) {
print "$item";
}
}
print end_html;
Several issues here, but the crux of the matter is this code.
#animals = (<IN>);
$item = param;
foreach $line (<IN>) {
if ($line =~ /$item/) {
print "$item";
}
}
Let's look at each line in turn:
#animals = (<IN>);
This reads all of the data from IN into the array #animals. It also leaves IN's file pointer at the end of the file. Any further attempts to read data from IN will fail.
$item = param;
If you call param with no arguments, you get a list of the parameter names that were found in the CGI request. As you're assigning this list to a scalar value, this behaviour changes and you'll get the number of parameters. In your system this will always be 1. So $item contains the value 1.
foreach $line (<IN>) {
Remember how you read all of the data from IN a couple of lines back? Well you're trying to read more data from it here. And that's not going to work. I think you probably wanted #animals here, not <IN>. Currently your foreach is never executed as on the first iteration the call to <IN> returns undef - which is false.
if ($line =~ /$item/) {
Let's assume that you've replaced <IN> with #animals in your foreach loop - so that the loop body is actually executed. This still isn't doing what you wanted. Remember that $item contains 1 rather than the name of an animal to search for. And I doubt that you have an animal called "1".
What you probably want is something more like this:
my $animal = param('Search');
while (<IN>) {
print if /$animal/;
}
I'd also point out that learning CGI in 2014 is pretty ridiculous. You would be far better off looking at a simple Perl web framework like Web::Simple or Dancer.
I think your problem is
$item = param;
Which is putting the number of parameters in your form, in this case 2, into $item. I doubt you have an animal named 2
Change it to
$item = param('Search');
I am trying to create a webpage on my site that takes input from a form (firstname,lastname) and process this input via a PERL CGI script and write that input to a file.
I would also like the page after script runs to display a message stating it successfully completed with links to get back to the homepage.
I am pretty sure my HTML page is correct when referencing the script so I will just post my perl script below.
Thanks in advance.
#!/usr/bin/perl
use strict; use warnings;
use CGI::Carp qw('fatalsToBrowser'); # send errors to the browser, not to the logfile
use CGI;
print header "Content-Type: text/html\n\n";
print start_html ("Receive Form Post");
my $datestring = localtime();
my $fname = param('firstname');
my $lname = param('lastname');
open (TESTFILE, '>>c:\inetpub\wwwroot\logfiles\bwrigsbee.txt') or die;
print TESTFILE "This file has been successfully edited on $datestring\n";
print TESTFILE "by $fname $lname\n";
close (TESTFILE);
print end_html;
HTML Form that is in the page that calls the script:
<form action="logwrite.pl" method="POST">
<table style="width:400px" border=1px border=solid border=black>
<tr>
<td>First name: <input type="text" name="firstname"></td>
</tr>
<tr>
<td>Last name: <input type="text" name="lastname"></td>
</tr>
<tr>
<td><input type="submit" value="Submit"></td>
</tr>
</table>
</form>
Debug info from browser--->
Undefined subroutine &main::param called at C:\studentwebusers\CIS33715\logwrite.pl line 11.
Remove the single quotes in your use CGI::Carp call:
use CGI::Carp qw(fatalsToBrowser);
Also, your call to header should not include the additional parameters. It could accept a type 'text/html' but all the additional info is an error
print header;
Use autodie anytime you're doing file processing. That way you won't have to be bothered to create detailed error messages. And use the 3 parameter form of open with lexical finel handles.
Finally, go ahead and use the object notation for all of methods in CGI. That will change your script to the following:
use strict;
use warnings;
use autodie;
use CGI::Carp qw(fatalsToBrowser); # send errors to the browser, not to the logfile
use CGI;
my $q = CGI->new;
print $q->header;
print $q->start_html("Receive Form Post");
my $datestring = localtime();
my $fname = $q->param('firstname');
my $lname = $q->param('lastname');
open my $fh, '>>', 'c:\inetpub\wwwroot\logfiles\bwrigsbee.txt';
print $fh "This file has been successfully edited on $datestring\n";
print $fh "by $fname $lname\n";
close $fh;
print $q->end_html;
Here is the table in which I am retrieving the data from an SQLite database.
Its having lots of records, so near that ADD button I need something like
|< < > >| which would do the paging function whenever I click.
Also, besides the table each header (e.g. UserName UserId) I need a sorting
button. Something like a ^ button. Please do help me find the solution..Thank You.
#!C:\perl\bin\perl.exe
use CGI;
use CGI qw/:standard/;
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
my $q = new CGI;
use DBI;
use CGI qw(:all);
use warnings;
print $q->header ( );
my $dbh = DBI->connect(
"dbi:SQLite:DEVICE.db",
"", "",
{
RaiseError => 1,
AutoCommit => 1
}
);
my #rows = ();
my $sql = "SELECT UserId,UserName,CardNo,GroupId,Role,VerifyType FROM UsersList";
my $sth = $dbh->prepare($sql) or die("\n\nPREPARE ERROR:\n\n$DBI::errstr");
$sth->execute or die("\n\nQUERY ERROR:\n\n$DBI::errstr");
print '<table>';
print "<tr>";
print "<th>$sth->{NAME}->[0]</th>";
print "<th>$sth->{NAME}->[1]</th>";
print "<th>$sth->{NAME}->[2]</th>";
print "<th>$sth->{NAME}->[3]</th>";
print "<th>$sth->{NAME}->[4]</th>";
print "<th>$sth->{NAME}->[5]</th>";
print "<th> EDIT </th>";
print "<th> DELETE </th>";
while (my #row = $sth->fetchrow_array) {
print "
<tr>
<td>$row[0]</td>
<td>$row[1]</td>
<td>$row[2]</td>
<td>$row[3]</td>
<td>$row[4]</td>
<td>$row[5]</td>
<td>EDIT</td>
<td>DELETE</td>
</tr>";
}
print "<tr style='background-color:#CDC9C9;'><td><A HREF=\"http://localhost/cgi-
bin/AddUser.cgi\">ADD</A></td><td></td><td></td><td></td><td></td></tr>";
print"</table>";
$sth->finish();
$dbh->commit();
$dbh->disconnect;
print <<END_HTML;
<html>
<head><title></title></head>
<body>
<form action="UsersList.cgi" method="get">
<TABLE align="center">
<TR>
<TD align="left">
<input type="hidden" name="submit" value="Submit">
</TD>
</TR>
</TABLE>
</form>
</body></html>
END_HTML
----------------------------------------
Ok, first thing, get and read Learning Perl. It is, hands down, the best book to learn Perl with.
Next, take a look at Ovid's CGI Course.
Third, your code has some major problems, and you'll need to walk before you run.
I've tidied and commented the heck out of your code.
#!C:\perl\bin\perl.exe
# Windows perl ignores the shebang, except to check for flags and
# arguments to start the Perl interpreter with.
# Your webserver might use it though
# You forgot to enable strict. You enabled warnings further down in
# your code. These two pragmas will help you write bug free code by
# catching many errors.
#
# Keep your module and pragma usage at the top of your
# scripts. It aids readability.
use strict;
use warnings;
# Using CGI is a good idea, but you only need to use CGI one time.
use CGI qw/:all/;
# These are good while learning and debugging.
# Do not use them in production code.
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use DBI;
my $dbh = DBI->connect(
"dbi:SQLite:DEVICE.db",
"", "",
{
RaiseError => 1,
AutoCommit => 1
}
);
# Don't use indirect object notation. It can lead to subtle bugs.
# Use the arrow notation for method invocation instead.
my $q = CGI->new();
print $q->header ( );
# The #rows array was doing nothing.
# No need to commit when autocommit is on.
$dbh->commit();
$dbh->disconnect;
# Here we get the html table in a string.
my $table = generate_data_table( $dbi );
# And here we print your whole HTML block with the table interpolated
# into the the main text. As it was, the HTML page was printing AFTER
# the table you generated.
#
# I put a crappy improper stylesheet in the header of your html page.
# Unless you are only doing the most rudimentary HTML work, learn to
# use CSS properly. Your time will be repayed hundreds of times over.
# For only rudimentary work, there's still a good chance you'll break
# even on any time you invest in learning CSS.
print <<END_HTML;
<html>
<head>
<title>Add Users</title>
<style>
.adduser {
background-color:#CDC9C9;
}
</style>
</head>
<body>
<form action="UsersList.cgi" method="get">
$table
<input type="hidden" name="submit" value="Submit">
</form>
</body>
</html>
END_HTML
# Use subroutines to group related actions.
sub generate_data_table {
my $dbi = shift;
my $sql = "SELECT UserId,UserName,CardNo,GroupId,Role,VerifyType FROM UsersList";
my $sth = $dbh->prepare($sql)
or die("\n\nPREPARE ERROR:\n\n$DBI::errstr");
$sth->execute
or die("\n\nQUERY ERROR:\n\n$DBI::errstr");
# Actually generate the table HTML
my $table = '<table><tr>';
# Header
$table .= join '', map "<th>$sth->{NAME}[$_]</th>\n", 0..5;
$table .= "</tr>\n";
# Normal Rows
while (my #row = $sth->fetchrow_array) {
$table .= '<tr>',
$table .= join '', map "<td>$row[$_]</td>\n", 0..5;
$table .= join "\n",
'<td>EDIT</td>'
'<td>DELETE</td>'
"</tr>\n";
}
# Special Row
#
# Don't use inline CSS, use classes and either group all your css at
# the top of your html code, or better yet, load an external stylesheet.
# There is no reason to have to escape quotes when working with Perl CGI.
# First, in html ' and " are interchangeable, so you can pick a quote
# that doesn't need esacaping.
#
# Finally, if you MUST use both ' and " in a single string, you can use
# Perl's quoting operators (q and qq) to select a safe delimiter that will allow you
# to avoid escaping.
$table .=
"<tr class='adduser' >"
. '<td>ADD</td>'
. '<td></td><td></td><td></td><td></td></tr>'
. "</table>";
$sth->finish();
return $table;
}
Finally, to handle sorting and paging, you can use a library as others have suggested, or you can modify your SQL query. The keywords you want for grabbing only a range of results are LIMIT and OFFSET, use an ORDER BY clause to sort your result set. Add some parameters to your forms to indicate what sorting methods or range you want.
One of the (many) advantages that you'd get from using DBIx::Class for your database access is that all searches have built-in support for paging.
Alternatively, you might find something like Data::Page to be useful.
As for sorting, that's probably best done in your SQL query with a 'sort' clause.