I am creating a simple perl script to create a web page to register users. This is just a learning program for me. It is very simple. I will display a page on the browser. The user enters name, user name, and password. After the user presses submit, I will check the user name against the database. If the user name exists in the database, I just want to display an error and bring up the register page again. I am using the cgi->redirect function. I am not sure if that is how I should use the redirection function. It does not work like I thought. It display "The document has moved here". Please point me to the right way. Thanks.
Here is the scripts
registeruser.pl
#!/usr/bin/perl
print "Content-type: text/html\n\n";
print <<PAGE;
<html>
<head>
<link rel="stylesheet" type="text/css" href="tracker.css"/>
</head>
<body>
<div id="header">
<h1> Register New User</h1>
</div>
<div id="content">
<form action="adduser.pl" method="POST">
<b>Name:</b> <input type="text" name="name"><br>
<b>UserName:</b> <input type="text" name="username"><br>
<b>Password:</b> <input type="password" name="password"><br>
<input type="submit">
</div>
</body>
<html>
PAGE
adduser.pl
#!/usr/bin/perl
use CGI;
use DBI;
$cgiObj = CGI->new;
print $cgiObj->header ('text/html');
# get post data
$newUser = $cgiObj->param('username');
$newName = $cgiObj->param('name');
$newPass = $cgiObj->param('password');
# set up sql connection
$param = 'DBI:mysql:Tracker:localhost';
$user = 'madison';
$pass = 'qwerty';
$connect = DBI->connect ($param, $user, $pass);
$sql = 'select user from users where user = "' . $newUser . '"';
$query = $connect->prepare ($sql);
$query->execute;
$found = 0;
while (#row = $query->fetchrow_array)
{
$found = 1;
}
if ($found == 0)
{
# no user found add new user
$sql = 'insert into users (user, name, passwd) values (?, ?, ?)';
$insert = $connect->prepare ($sql);
$insert->execute ($newUser, $newName, $newPass);
}
else
{
# user already exists, get new user name
# What do I do here ????
print $cgiObj->redirect ("registerusr.pl");
}
One thing to look out for, SQL Injection. For an illustrated example, Little Bobby Tables.
As it stands your code is inescure, and can allow people to do bad things to your database. DBI provides placeholders as a secure way of querying a database with user input. Example http://bobby-tables.com/perl.html
Also, in this day and age even the CGI module warns you not to use it:
The rational for this decision is that CGI.pm is no longer considered good practice for developing web applications, including quick prototyping and small web scripts. There are far better, cleaner, quicker, easier, safer, more scalable, more extensible, more modern alternatives available at this point in time. These will be documented with CGI::Alternatives.
I suggest you use Dancer to make your life easier.
Three things
Include use strict; and use warnings; in EVERY perl script. No exceptions.
This is the #1 thing that you can do to be a better perl programmer. It will save you an incalculable amount of time during both development and testing.
Don't use redirects to switch between form processing and form display
Keep your form display and form processing in the same script. This enables you to display error messages in the form and only move on to a new step upon a successfully processed form.
You simply need to test the request_method to determine if the form is needing to be processed or just displayed.
CGI works for learning perl, but look at CGI::Alternatives for live code.
The following is your form refactored with the first 2 guidelines in mind:
register.pl:
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
my $q = CGI->new;
my $name = $q->param('name') // '';
my $username = $q->param('username') // '';
my $password = $q->param('password') // '';
# Process Form
my #errors;
if ( $q->request_method() eq 'POST' ) {
if ( $username =~ /^\s*$/ ) {
push #errors, "No username specified.";
}
if ( $password =~ /^\s*$/ ) {
push #errors, "No password specified.";
}
# Successful Processing
if ( !#errors ) {
# Obfuscate for display
$password =~ s/./*/g;
print $q->header();
print <<"END_PAGE";
<html>
<head><title>Success</title></head>
<body>
<p>Name = $name</p>
<p>Username = $username</p>
<p>Password = $password</p>
</body>
</html>
END_PAGE
exit;
}
}
# Display Form
print $q->header();
print <<"END_PAGE";
<html>
<head>
<link rel="stylesheet" type="text/css" href="tracker.css"/>
</head>
<body>
<div id="header">
<h1>Register New User</h1>
</div>
#{[ #errors ? join("\n", map "<p>Error: $_</p>", #errors) : '' ]}
<div id="content">
<form action="register.pl" method="POST">
<b>Name:</b> #{[ $q->textfield( -name => 'name' ) ]}<br>
<b>UserName:</b> #{[ $q->textfield( -name => 'username' ) ]}<br>
<b>Password:</b> #{[ $q->password_field( -name => 'password' ) ]}<br>
<input type="submit">
</div>
</body>
<html>
END_PAGE
__DATA__
Related
I have a html table that has 2 radio buttons for every row and a save button. I want to store the value of the radio button when saved and preset the value when the page is revisited.This is the html code I have written
<form action='table_extract.cgi' method = 'get'>
<td><input type='radio' name='signoff' value = 'approve'>Approve<br>
<input type='radio' name='signoff' value='review'>Review</td>
<td><input type='submit' name='button' value='Save'/></td></form>
This is what is in table_extract.cgi
#!usr/local/bin/perl
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use strict;
use warnings;
print <<END;
Content-Type: text/html; charset=iso-8859-1
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
END
my $regfile = 'signoff.out';
my $sign;
$sign = param('signoff');
open(REG,">>$regfile") or fail();
print REG "$sign\n";
close(REG);
print "param value :", param('signoff');
print <<END;
<title>Thank you!</title>
<h1>Thank you!</h1>
<p>signoff preference:$sign </p>
END
sub fail {
print "<title>Error</title>",
"<p>Error: cannot record your registration!</p>";
exit; }
This is just first part of the problem. I was not able to find any output in console or in poll.out. Once I read the values, I need to preset the values to the radio buttons that was saved by the user in the previous visit.
The problem is in the HTML, your submit button has two type attributes. When I repaired this, the form worked for me.
You are doing too much work to save the form. See chapter SAVING THE STATE OF THE SCRIPT TO A FILE in the documentation.
i hava a cgi page index.cgi and one template of login form as
index.cgi
use Singleton::CGI;
use Singleton::Session;
$q = new Singleton::CGI();
$session = new Singleton::Session();
$template = HTML::Template->new(filename => 'login.tmpl');
print $q->header;
print $q->start_html("hello perl");
print $q; # printing hash of CGI Object.
print $session;
print $template->output;
print $q->end_html;
if($q->param('submit')){
print $q->header;
print $q->start_html("hello user");
print $q; # printing hash of CGI Object.
print $session;
print $q->param('text');
print $q->end_html;
}
login.tmpl:
<form action="/" method="post">
<input type="text" name="text"/>
<input type="submit" name="submit" value="submit"/>
</form>
here is the output when i get the index.cgi
CGI=HASH(0xbe0510)
SingletonSession=HASH(0x1e67ee60)
along with form
next when i submit the form then
CGI=HASH(0xe2ac500) alnog with form input value.
SingletonSession=HASH(0x115dc7a0)
as per my requirement i should only get one session Object.
how should i maintain only one query and session Object through out the application?
Your web server executes your script for each request it receives, so you're asking to share a variable across two processes that aren't even running at the same time. Impossible. That's why sessions are used, to provide persistence of information.
I'm an old-newbie in Perl, and Im trying to create a subroutine in perl using HTML::TokeParser and URI.
I need to extract ALL valid links enclosed within on div called "zone-extract"
This is my code:
#More perl above here... use strict and other subs
use HTML::TokeParser;
use URI;
sub extract_links_from_response {
my $response = $_[0];
my $base = URI->new( $response->base )->canonical;
# "canonical" returns it in the one "official" tidy form
my $stream = HTML::TokeParser->new( $response->content_ref );
my $page_url = URI->new( $response->request->uri );
print "Extracting links from: $page_url\n";
my($tag, $link_url);
while ( my $div = $stream->get_tag('div') ) {
my $id = $div->get_attr('id');
next unless defined($id) and $id eq 'zone-extract';
while( $tag = $stream->get_tag('a') ) {
next unless defined($link_url = $tag->[1]{'href'});
next if $link_url =~ m/\s/; # If it's got whitespace, it's a bad URL.
next unless length $link_url; # sanity check!
$link_url = URI->new_abs($link_url, $base)->canonical;
next unless $link_url->scheme eq 'http'; # sanity
$link_url->fragment(undef); # chop off any "#foo" part
print $link_url unless $link_url->eq($page_url); # Don't note links to itself!
}
}
return;
}
As you can see, I have 2 loops, first using get_tag 'div' and then look for id = 'zone-extract'. The second loop looks inside this div and retrieve all links (or that was my intention)...
The inner loop works, it extracts all links correctly working standalone, but I think there is some issues inside the first loop, looking for my desired div 'zone-extract'... Im using this post as a reference: How can I find the contents of a div using Perl's HTML modules, if I know a tag inside of it?
But all I have by the moment is this error:
Can't call method "get_attr" on unblessed reference
Some ideas? Help!
My HTML (Note URL_TO_EXTRACT_1 & 2):
<more html above here>
<div class="span-48 last">
<div class="span-37">
<div id="zone-extract" class="...">
<h2 class="genres"><img alt="extracting" class="png"></h2>
<li><a title="Extr 2" href="**URL_TO_EXTRACT_1**">2</a></li>
<li><a title="Con 1" class="sel" href="**URL_TO_EXTRACT_2**">1</a></li>
<li class="first">Pàg</li>
</div>
</div>
</div>
<more stuff from here>
I find that TokeParser is a very crude tool requiring too much code, its fault is that only supports the procedural style of programming.
A better alternatives which require less code due to declarative programming is Web::Query:
use Web::Query 'wq';
my $results = wq($response)->find('div#zone-extract a')->map(sub {
my (undef, $elem_a) = #_;
my $link_url = $elem_a->attr('href');
return unless $link_url && $link_url !~ m/\s/ && …
# Further checks like in the question go here.
return [$link_url => $elem_a->text];
});
Code is untested because there is no example HTML in the question.
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.
My INSERT, DELETE statements won't work and I dont know why . . . in fact it's driving me crazy. Please see my attached scrpits. I have been using the Open Perl IDE as well as Notebook++ to contrast and work on these scripts. As far as I can tell there is nothing the matter with them and it's driving me nuts. I have checked the file permissions for the database. I can search for information in the database and display all the items in the database but I cant INSERT, DELETE, or UPDATE.
Below find the link to my page (formatting of the page will be better when I can get some functionality):
http://129.2.168.163/cm485a2/project1.html
Please help.
#!/usr/bin/perl -w
use strict;
#use DBI;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser); # provide descriptive error messages
use Win32::ODBC; #use ODBC package vs. DBI as in text
print header(); # print out "Content-Type: text/html\n\n"
# Get user's desired action from form
my $action = param('form_action');
# Connect to database
my $db = new Win32::ODBC("DSN=rreAccesscm485a2; UID=cm485a; PWD=kbradford68g")
or die Win32::ODBC::Error();
my $cust_ID;
my $fName;
my $mI;
my $lName;
my $street;
my $city;
my $state;
my $zip_Code;
my $DOB;
my $agent_ID;
my $home_Phone;
my $cell_Phone;
my $profession;
my $employer;
my $referrer;
$cust_ID = param('cust_ID');
$fName = param('first_Name');
$mI = param('mI');
$lName = param('last_Name');
$street = param('street_Name');
$city = param('city');
$state = param('state');
$zip_Code = param('zip_Code');
$DOB = param('DOB');
$agent_ID = param('agent_ID');
$home_Phone = param('home_Phone');
$cell_Phone = param('cell_Phone');
$profession = param('profession');
$employer = param('employer');
$referrer = param('referrer');
my $sql;
$sql = qq{INSERT INTO customer (Customer ID, first_Name, mI, last_Name,};
$sql .= qq{street_Name, city, state, zip_Code, DOB};
$sql .= qq{agent_ID, home_Phone, cell_Phone, profession, employer, referrer)};
$sql .= qq{ VALUES ('$cust_ID','$fName','$mI','$lName','$street','$city',};
$sql .= qq{'$state','$zip_Code','$DOB','$agent_ID','$home_Phone','$cell_Phone',};
$sql .= qq{'$profession', '$employer', '$referrer')};
#print '$sql=' . $sql . "\n";
if ($db->Sql($sql))
{
print "SQL Error: " . $db->Error() . "\n";
print qq(<html><head><title>Database Error</title>
</head>
<body><center><font size="6">Error with database call.</font>
<hr />
<font size="4" color="red">ODBC DB Error</font><br />
<font size="3">Please hit your <b>Back</b> button to re-enter the data and try again.</font></center>
</body>
</html>);
exit;
}
sub Display_Page {
print qq(<html><head><title>Record Added!</title></head>
<body>
<center>
<font size="6">Record Added!</font>
<hr />
<font size="4">
Back to Main Page
</font><br />
</center>
</body>
</html>);
}
You need to quote Customer ID or change the column name so that it doesn't contain spaces.
You also have to make sure you have a comma (,) after every column. It's missing after the DOB column name.