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.
I need to scan through html fragments looking for certain strings in text (not within element attributes) and wrapping those matching strings with a <span></span>. Here's a sample attempt with output:
use v5.10;
use Mojo::DOM;
my $body = qq|
<div>
<p>Boring Text:</p>
<p>
Highlight Cool whenever we see it.
but not here.
<code>
sub Cool {
print "Foo\n";
}
</code>
And here is more Cool.
</p>
</div>
|;
my $dom = Mojo::DOM->new($body);
foreach my $e ($dom->find('*')->each) {
my $text = $e->text;
say "e text is: $text ";
if ($text =~ /Cool/) {
(my $newtext = $text ) =~ s/Cool/<span class="fun">Cool<\/span>/g;
$e->replace_content($newtext);
}
}
say $dom->root;
the output:
e text is:
e text is: Boring Text:
e text is: Highlight Cool whenever we see it. but not. And here is more Cool.
e text is: here
e text is: sub Cool { print "Foo "; }
<div>
<p>Boring Text:</p>
<p>Highlight <span class="fun">Cool</span> whenever we see it. but not. And here is more <span class="fun">Cool</span>.</p>
</div>
Close but what I really want to see is something like the following:
<div>
<p>Boring Text:</p>
<p>Highlight <span class="fun">Cool</span> whenever we see it. but not here.
<code>
sub <span class="fun">Cool<span> {
print "Foo\n";
}
</code>
And here is more <span class="fun">Cool</span>.</p>
</div>
Any help / pointers would be greatly appreciated.
Thanks,
Todd
Having looked into XML::Twig I'm not so sure it's the correct tool. It's surprising how awkward such a simple task can be.
This is a working program that uses HTML::TreeBuilder. Unfortunately it doesn't produce formatted output so I've added some whitespace myself.
use strict;
use warnings;
use HTML::TreeBuilder;
my $html = HTML::TreeBuilder->new_from_content(<<__HTML__);
<div>
<p>Boring Text:</p>
<p>
Highlight Cool whenever we see it.
but not here.
<code>
sub Cool {
print "Foo\n";
}
</code>
And here is more Cool.
</p>
</div>
__HTML__
$html->objectify_text;
for my $text_node ($html->look_down(_tag => '~text')) {
my $text = $text_node->attr('text');
if (my #replacement = process_text($text)) {
my $old_node = $text_node->replace_with(#replacement);
$old_node->delete;
}
}
$html->deobjectify_text;
print $html->guts->as_XML;
sub process_text {
my #nodes = split /\bCool\b/, shift;
return unless #nodes > 1;
my $span = HTML::Element->new('span', class => 'fun');
$span->push_content('Cool');
for (my $i = 1; $i < #nodes; $i += 2) {
splice #nodes, $i, 0, $span->clone;
}
$span->delete;
#nodes;
}
output
<div>
<p>Boring Text:</p>
<p>
Highlight <span class="fun">Cool</span> whenever we see it.
but not here.
<code> sub <span class="fun">Cool</span> { print "Foo "; } </code>
And here is more <span class="fun">Cool</span>.
</p>
</div>
Here is a start using XML::Twig. One issue is the literal newline inside <code> tag. I guess that the parser cannot see the difference between it and a normal one. Perhaps it would help to encode it as 
 or use CDATA sections. Otherwise I don't know how to handle it:
Content of script.pl:
#!/usr/bin/env perl
use warnings;
use strict;
use XML::Twig;
my $body = qq|
<div>
<p>Boring Text:</p>
<p>
Highlight Cool whenever we see it.
but not here.
<code>
sub Cool {
print "Foo\n";
}
</code>
And here is more Cool.
</p>
</div>
|;
XML::Twig::Elt::set_replaced_ents(q{});
my $elt = XML::Twig::Elt->new( 'span' => { class => 'fun' }, 'Cool' );
my $twig = XML::Twig->new( pretty_print => 'nice' )->parse( $body );
$twig->subs_text( 'Cool', $elt->sprint );
$twig->print;
Running it like:
perl script.pl
It yields:
<div>
<p>Boring Text:</p>
<p>
Highlight <span class="fun">Cool</span>
whenever we see it.
but not here.
<code>
sub <span class="fun">Cool</span>
{
print "Foo
";
}
</code>
And here is more <span class="fun">Cool</span>
.
</p>
</div>
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!
I'm trying to create a simple program that will get the content of the webpage for the sake of my assignment.
Right now I create a very simple HTML page that will let the user enter a URL.
<html>
<head><title>URL page</title>
</head>
<body>
<form action="cgi-bin/b1.cgi" method="GET">
Enter the URL you want to see <input type="text" name="passing" size=40>
<input type="submit" value="submit">
</form>
</body>
</html>
so I just want to pass the url to my CGI program that I have so far
#!/usr/bin/perl
print "Content-type: text/html\n\n";
use LWP::Simple;
use CGI;
use HTML::HeadParser;
#my $pass = $cgi->param('passing');
$URL = get ("$passing");
$head = HTML::HeadParser->new;
$head->parse("$URL");
print "This is the Title of the page" . $head->header('Title') . "\n\n";
print $head->header('X-Meta-Description') . "\n\n";
print $head->header('X-Meta-Keywords') . "\n\n";
print $head->header('Content-Type') . "\n\n";
print $head->header('Content-Language') . "\n\n";
exit;
So from the above code as you can see if I can get the value that pass from the GET method to the line where it say URL = get(); then I can get the content.
I tried some approch like my $pass = $cgi->param('passing'); but it gives me an error about param
Any suggestion would be so much appreciated.
I am searching for HF50(HF$HF) for example in "MyFile.txt" so that the extracted data must save to "save.txt". The data on "save.txt" now extracted again and fill the parameters and output on my table. But when I tried the code, I've got no output and "save.txt" is blank.?
Var $HF is not recognized whatever I type. Please help.
#! /usr/bin/perl
print "Content-type:text/html\r\n\r\n";
use CGI qw(:standard);
use strict;
use warnings;
my ($file,$line,$tester,$HF,$keyword);
my ($f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$f10,$f11,$f12,$f13,$f14,$f15,$f16,$f17,$f18,$f19);
my $keyWord=param('keyword');
$HF=$keyWord;
my $infile='MyFile.txt';
my $outfile='save.txt';
open (my $inhandle, '<',$infile) or die "Can't open $infile:$!";
open (my $outhandle, '>', $outfile) or die "Can't open $outfile:$!";
while (my $line=<$inhandle>){
if ($line=~ m/HF$HF/i) {
print {$outhandle}$line;
print $line;
print "<HTML>";
print "<head>";
print "<body bgcolor='#4682B4'>";
print "<title>FUSION SHIFT REPORT</title>";
print "<div align='left'>";
print "<FORM METHOD='get' ACTION='http://Shielex.com/pe/mrigos/mainhead.html'>";
print "<b>SEACRH:</b>";
print "<INPUT TYPE='text' NAME='rec' SIZE='12' MAXLENGHT='40'>";
print "<INPUT TYPE='submit' value='go'>";
print "</form>";
print "<TABLE CELLPADDING='1' CELLSPACING='1' BORDER='1' bordercolor=black width='100%'>";
print "<TR>";
print "<td width='11%'bgcolor='#00ff00'><font size='2'>TESTER No.</td>";
print "<td width='10%'bgcolor='#00ff00'><font size='2'>DATE</td>";
print "<td width='11%'bgcolor='#00ff00'><font size='2'>DEVICE NAME</td>";
print "<td bgcolor='#00ff00'><font size='2'>TEST PROGRAM</td>";
print "<td width='10%'bgcolor='#00ff00'><font size='2'>SMSLOT</td>";
print "<td width='12%'bgcolor='#00ff00'><font size='2'>LOADBOARD</td>";
print "<td width='10%'bgcolor='#00ff00'><font size='2'>CATEGORY</td>";
print "<td width='13%'bgcolor='#00ff00'><font size='2'>ROOT CAUSE 1</td>";
print "<td width='13%'bgcolor='#00ff00'><font size='2'>ROOT CAUSE 2</td>";
print "</tr>";
print "<TR>";
$file='save.txt';
open(F,$file)||die("Could not open $file");
while ($line=<F>)
{
my #cells=($f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$f10,$f11,$f12,$f13,$f14,$f15,$f16,$f17,$f18,$f19)= split ',',$line;
print "<TD bgcolor='#ADD8E6'><font size='2'>$f2</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f3</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f5</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f6</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f8</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f10</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f17</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f18</TD>";
print "<TD bgcolor='#ADD8E6'><font size='2'>$f19</TD>";
print "</tr>";
}
}
}
close F;
print "</TABLE>";
print "</body>";
print "<html>";
=MyFile.txt data=
1,HF50,13-OCT-08,04:17:53,761503BZZGR-62,B2761503BP22.EVA,DWP,DWP,Calibration
2,HF60,13-OCT-08,04:17:53,761503BZZGR-62,B2761503BP22.EVA,DWP,DWP,Calibration
1,HF50,13-OCT-08,04:17:53,761503BZZGR-62,B2761503BP22.EVA,DWP,DWP,Calibration
Are you running this as a CGI script? In that case, you probably don't have permission to open a file for writing. Did you check the error log to see if your message from die is in there?
You might want to check out Troubleshooting Perl CGI scripts. Go through all of the steps without skipping any. When you get stuck, you have most of the imformation you need to help us help you.
Good luck, :)
You never close $outfile so it doesn't get flushed. But maybe you want to store the data in an array instead?
As an aside, you should always use the three-argument form of open() and you should also always use absolute paths when working with CGI programs, as in many situations, the "current directory" is not what you think it is.
First, Perl's output is by nature buffered. So, unless you use some explicit method, there's no guarantee that the physical file will have anything to read. As somebody mentioned, you'll have to flush the output somehow. My comments are below in the code. (You could also do this by closing the output file and opening it in append mode after you've read from it.)
Second, it doesn't seem like you want to do what it looks like you want to do. If everything was flushed perfectly to the file, you're requesting an html header per input line. So as I added lines into the input, it printed out that many search boxes. I don't expect that is what you wanted.
Here's a more perl-ified code:
use CGI qw(:standard);
use IO::File;
use strict;
use warnings;
my ($file,$line,$HF); #,$tester,$HF,$keyword);
# don't pollute -> my ($f1,$f2,$f3,$f4,$f5,$f6,$f7,$f8,$f9,$f10
# ,$f11,$f12,$f13,$f14,$f15,$f16,$f17,$f18,$f19);
# my $keyWord=param('keyword'); <-- if you're not going to do anything with $keyWord
$HF=param('keyword'); # <- assign it to the variable you're going to use
my $infile='MyFile.txt';
my $outfile='save.txt';
open (my $inhandle, '<',$infile) or die "Can't open $infile:$!";
open (my $outhandle, '>', $outfile) or die "Can't open $outfile:$!";
# this would flush -> my $outhandle = IO::File->new( ">$outfile" );
print q{Content-type:text/html
<HTML>
<head>
<title>FUSION SHIFT REPORT</title>
<style type="text/css">
.header { background-color : #0f0; font-size : 12pt }
.detail { background-color : #ADD8E6; font-size : 12pt }
</style>
</head>
<body bgcolor='#4682B4'>
<div align='left'>
<FORM METHOD='get' ACTION='http://Shielex.com/pe/mrigos/mainhead.html'>
<b>SEACRH:</b>
<input type='text' name='rec' size='12' maxlenght='40'>
<input type='submit' value='go'>
</form>
<table cellpadding='1' cellspacing='1' border='1' bordercolor=black width='100%'>
<tr>
<td class="header" width='11%'>TESTER No.</td>
<td class="header" width='10%'>DATE</td>
<td class="header" width='11%'>DEVICE NAME</td>
<td class="header" >TEST PROGRAM</td>
<td class="header" width='10%'>SMSLOT</td>
<td class="header" width='12%'>LOADBOARD</td>
<td class="header" width='10%'>CATEGORY</td>
<td class="header" width='13%'>ROOT CAUSE 1</td>
<td class="header" width='13%'>ROOT CAUSE 2</td>
</tr>
};
my $hf_str = ",HF$HF,";
# OO -> $outhandle->autoflush(); <- set autoflush
while (my $line=<$inhandle>){
next unless index( $line, $hf_str ) > -1;
# OO -> $outhandle->print( $line );
# $outhandle->flush(); <- if autoflush not set, do it manually
print *{$outhandle} $line;
print "<tr>"
, ( map { qq{<td class="detail">$_</td>} }
split ',', $line
)
, "</tr>\n"
;
}
print q{
</table>
</body>
</html>
};