perl not clearing data on page exit [closed] - perl

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
sorry if the title doesn't make much sense, I'll explain.
I am learning Perl, which I have to use at work, so am running test programs. I am inputting data into a web form (name, age, location) and searching a MySQL database to find a match. When I search it returns any matching results printed on the screen. However, if I go back to the form and search again, knowing that the result will not be found, it just displays the last found record and I can't quite figure out why.
Can someone help me please?
Thanks in advance.
# Read the standard input (sent by the form):
read(STDIN, $FormData, $ENV{'CONTENT_LENGTH'});
# Get the name and value for each form input:
#pairs = split(/&/, $FormData);
# Then for each name/value pair....
$db = DBI->connect($conn->DataSource(), $conn->Username(), $conn->Password()) or die "Unable to connect: $DBI::errstr\n";
foreach $pair (#pairs)
{
# Separate the name and value:
($name, $value) = split(/=/, $pair);
#replace + with space as + means space when data is collected
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Store values in a hash called %FORM:
$FORM{$name} = $value;
}
$query = $db->prepare("SELECT * FROM person WHERE Name = '".$FORM{'PName'}."' AND Age = '".$FORM{'Age'}."' AND Location = '".$FORM{'Location'}."'");
$query->execute();
# BIND TABLE COLUMNS TO VARIABLES
$query->bind_columns(undef, \$name, \$age, \$location);
# LOOP THROUGH RESULTS
$row = 0;
while($query->fetch())
{
push #Peeps, Person->New();
$Peeps[$row]->Name($name);
$Peeps[$row]->Age($age);
$Peeps[$row]->Location($location);
$row++;
}
$db->disconnect(); #disconnect from the db
print '<table>';
for($i = 0; $i <= $#Peeps; $i++)
{
print "<tr><td>$Peeps[$i]{'NAME'}</td><td>$Peeps[$i]{'AGE'}</td><td>$Peeps[$i]{'LOCATION'}</td></tr>";
}
print '</table>';
$db->disconnect(); #disconnect from the db

If you are using mod_perl or fastcgi where the server process is persistent over multiple requests, global variables (which you are using in your example) may not be reset between requests, but keep their old values.
In your example, this means that the next request may see the %FORM values set by the earlier request, if the request happens to come to the same server process.
If by adding %FORM = (); at the top of your script fixes the problem, then this is your issue. You can verify by saying e.g. print $test++; and see if it increments.
Note that this is not the real solution, I would recommend putting your real code inside a function or module and using local variables and parameters there, it is more maintainable as well. And using some of the web application frameworks available (minimally CGI.pm).
You also need to fix the SQL injection security problem, rule of thumb: Never put variables in SQL statement strings, but do something like:
$dbh->prepare("SELECT ... WHERE This = ? AND That = ?")
$dbh->execute($this, $that);

I'm afraid the question is too generic and for any useful answer, a bit of code/pseudo code is going to be essential. However, based entirely on what you've asked, it does look like a browser caching issue, or perhaps a session-data caching issue. Like I say, disclosing a bit of code / pseudo code will help understand your question better

Related

Problems check username input against flat file for user creation

I am working on a user login and am having trouble with the user creation part. My problem is that I am trying to check the input username against a text file to see if that username already exists. I can't seem to get it to compare the input username to the array that I have brought in. I have tried two different ways of accomplishing this. One using an array and another using something I read online that I don't quite understand. Any help or explanation would be greatly appreciated.
Here is my attempt using an array to compare off of
http://codepad.org/G7xmsf3z
Here is my second attempt
http://codepad.org/SbeqmdbG
In your first attempt, try to put the if inside of the loop:
foreach my $pair(#incomingarray) {
(my $name,my $value) = split (/:/, $pair);
if ($name eq $username) {
print p("Username is already taken, try again");
close(YYY);
print end_html();
}
else {
open(YYY, ">>password.txt");
print YYY $username.":".$hashpass."\n";
print p("Your account has been created sucessfully");
close(YYY);
print end_html();
}
}
In you second attempt, I think you should try and change the line:
if (%users eq $username) {
with this one:
if (defined $users{$username}) {
As has been stated above regarding locking the flatfile from other processes there is the issue with scaling too. the more users you have the slower the lookup will be.
I started years ago with a flat file, believing I would never scale enough to require a real database and didn't want to learn how to use mySQL for example. Eventually after flatfile corruptions and long lookup times I had no choice but to move to a database.
Later you will find yourself wanting to store user preferences and such, it's easy to add a new field to a database. Flatfile will end up having the overhead of splitting each line into separate fields.
I'd suggest you do it properly with a database.
As in my comment, you should not be using a flatfile to hold your user info. You should use a proper database that will handle concurrent access for you rather than having to understand and code up how to deal with all of that yourself!
If you insist on using an array, you can search it with grep() if it is not "too large":
if (grep /^$username:/, #incomingarray) {
print "user name '$username' is already registered, try again\n";
}
else {
print "user name '$username' is not already registered\n";
}
I see some other problems in your code as well.
You should always prefer lexical (my) variables over package (our) variables.
Why do you think (erroneously) that $name and $username cannot be lexical variables?
You should always use the 3-arg form of open() and check its return value like in your 2nd code example. Your open() in the 1st code example is how it was done many many years ago.

HOP::Lexer with overlapping tokens

I'm using HOP::Lexer to scan BlitzMax module source code to fetch some data from it. One particular piece of data I'm currently interested in is a module description.
Currently I'm searching for a description in the format of ModuleInfo "Description: foobar" or ModuleInfo "Desc: foobar". This works fine. But sadly, most modules I scan have their description defined elsewhere, inside a comment block. Which is actually the common way to do it in BlitzMax, as the documentation generator expects it.
This is how all modules have their description defined in the main source file.
Rem
bbdoc: my module description
End Rem
Module namespace.modulename
This also isn't really a problem. But the line after the End Rem also contains data I want (the module name). This is a problem, since now 2 definitions of tokens overlap each other and after the first one has been detected it will continue from where it left off (position of content that's being scanned). Meaning that the token for the module name won't detect anything.
Yes, I've made sure my order of tokens is correct. It just doesn't seem possible (somewhat understandable) to move the cursor back a line.
A small piece of code for fetching the description from within a Rem-End Rem block which is above a module definition (not worked out, but working for the current test case):
[ 'MODULEDESCRIPTION',
qr/[ \t]*\bRem\n(?:\n|.)*?\s*\bEnd[ \t]*Rem\nModule[\s\t]+/i,
sub {
my ($label, $value) = #_;
$value =~ /bbdoc: (.+)/;
[$label, $1];
}
],
So in my test case I first scan for a single comment, then the block above (MODULEDESCRIPTION), then a block comment (Rem-End Rem), module name, etc.
Currently the only solution I can think of is setup a second lexer only for the module description, though I wouldn't prefer that. Is what I want even possible at all with HOP::Lexer?
Source of my Lexer can be found at https://github.com/maximos/maximus-web/blob/develop/lib/Maximus/Class/Lexer.pm
I've solved it by adding (a slightly modified version of) the MODULEDESCRIPTION. Inside the subroutine I simply filter out the module name and return an arrayref with 4 elements, which I later on iterate over to create a nice usable array with tokens and their values.
Solution is again at https://github.com/maximos/maximus-web/blob/develop/lib/Maximus/Class/Lexer.pm
Edit: Or let me just paste the piece of code here
[ 'MODULEDESCRIPTION',
qr/[ \t]*\bRem\R(?:\R|.)*?\bEnd[ \t]*Rem\R\bModule[\s\t]\w+\.\w+/i,
sub {
my ($label, $value) = #_;
my ($desc) = ($value =~ /\bbbdoc: (.+)/i);
my ($name) = ($value =~ /\bModule (\w+\.\w+)/i);
[$label, $desc, 'MODULENAME', $name];
}
],

How to skip 'die' in perl

I am trying to extract data from website using perl API. The process is to use a list of uris as input. Then I extract related information for each uri from website. If the information for one uri is not present it dies. Some thing like the code below
my #tags = $c->posts_for(uri =>"$currentURI");
die "No candidate related articles\n" unless #tags;
Now, I don't want the program to stop if it doesn't get any tags. I want the program to skip that particular uri and go to the next available uri. How can i do it?
Thank you for your time and help.
Thank you,
Sammed
Well, assuming that you're inside a loop processing each of the URIs in turn, you should be able to do something like:
next unless #tags;
For example, the following program only prints lines that are numeric:
while (<STDIN>) {
next unless /^\d+$/;
print;
}
The loop processes every input line in turn but, when one is found that doesn't match that regular expression (all numeric), it restarts the loop (for the next input line) without printing.
The same method is used in that first code block above to restart the loop if there are no tags, moving to the next URI.
Besides the traditional flow control tools, i.e. next/last in a loop or return in a sub, one can use exceptions in perl:
eval {
die "Bad bad thing";
};
if ($#) {
# do something about it
};
Or just use Try::Tiny.
However, from the description of the task it seems next is enough (so I voted for #paxdiablo's answer).
The question is rather strange, but as near as I can tell, you are asking how to control the flow of your current loop. Of course, using die will cause your program to exit, so if you do not want that, you should not use die. Seems elementary to me, that's why it is a strange questions.
So, I assume you have a loop such as:
for my $currentURI (#uris) {
my #tags = $c->posts_for(uri =>"$currentURI");
die "No candidate related articles\n" unless #tags;
# do stuff with #tags here....
}
And if #tags is empty, you want to go to the next URI. Well, that's a simple thing to solve. There are many ways.
next unless #tags;
for my $tag (#tags) { ... stuff ... }
if (#tags) { .... }
Next is the simplest one. It skips to the end of the loop block and starts with the next iteration. However, using a for or if block causes the same behaviour, and so are equivalent. For example:
for my $currentURI (#uris) {
my #tags = $c->posts_for(uri =>"$currentURI");
for my $tag (#tags) {
do_something($tag);
}
}
Or even:
for my $currentURI (#uris) {
for my $tag ($c->posts_for(uri =>"$currentURI")) {
do_something($tag);
}
}
In this last example, we removed #tags all together, because it is not needed. The inner loop will run zero times if there are no "tags".
This is not really complex stuff, and if you feel unsure, I suggest you play around a little with loops and conditionals to learn how they work.

Perl DBI Query -> JSON -> JQuery AutoComplete

I've been trying to read up on how to implement a JSON solution in order to use JQueryUI's autocomplete functionality. I am trying to use autocomplete to search a database on for a name and after selection populate the ID to a hidden object. I've seen alot of examples around the web, but haven't found the best way to implement this. The database doesn't change that often, so I'm not sure how to best approach this performance wise.
Backend:
#!/usr/bin/perl
use CGI;
use DBI;
use strict;
use warnings;
my $cgi = CGI->new;
my $dbh = DBI->connect('dbi:mysql:hostname=localhost;database=test',"test","test") or die $DBI::errstr;
my $sth = $dbh->prepare(qq{select id, name from test;}) or die
$dbh->errstr;
$sth->execute() or die $sth->errstr;
my $json = undef;
while(my #user = $sth->fetchrow_array()) {
$json .= qq{{"$user[0]" : "$user[1]"}};
}
print $cgi->header(-type => "application/json", -charset => "utf-8");
print $json;
The jQuery autocomplete needs a "value" or "label" field returned with the json result. If you do not include it, the jquery autocomplete will not work:
The basic functionality of the autocomplete works with the results of the query assigned to the ‘label’ and ‘value’ fields. Explanation on the ‘label’ and ‘value’ fields from the jQuery UI site:
“The local data can be a simple Array of Strings, or it contains Objects for each item in the array, with either a label or value property or both. The label property is displayed in the suggestion menu. The value will be inserted into the input element after the user selected something from the menu. If just one property is specified, it will be used for both, eg. if you provide only value-properties, the value will also be used as the label.”
Link to full example: http://www.jensbits.com/2011/05/09/jquery-ui-autocomplete-widget-with-perl-and-mysql/
You need to grap the JSON package from CPAN instead of doing this:
my $json = undef;
while(my #user = $sth->fetchrow_array()) {
$json .= qq{{"$user[0]" : "$user[1]"}};
}
For example, with JSON it'd look like this:
use JSON;
my $json = {};
while(my #user = $sth->fetchrow_array()) {
$json->{$user[0]} = $user[1];
}
print JSON::to_json($json);
The JSON package will automatically construct a valid JSON string from any Perl data structure you provide it. We use it all over the place on Melody and it's proved to be a real life saver for sanely converting a structure into valid JSON.
Here I'm talking about performance.
There is some trigger you can set to improve performance, client side you can set the minimum number of characters required before the request is sent.
You can also set the "timeout" between two characters typing before the request is sent.
If your database table is really huge, I suggest you put a LIMIT on results you retrieve.
First to avoid long request processing, but also because some clients like IE6 arent't really fast handling more than a hundred results (Not to say, it's also not really user friendly).
On a project using IE6, we limited the elements returned to 100. If the user can't reduce the search to 100 elements, we presume he/she doesn't know what he/she is looking for.
Hope it helps a bit.

Googling within a Perl script? [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
I have a string in $var.
Using Perl, how can I pass this string to Google and get back an array of Google search results?
Before proceeding, please be aware of the Google Terms of Service.
You agree not to access (or attempt to access) any of the Services by any means other than through the interface that is provided by Google, unless you have been specifically allowed to do so in a separate agreement with Google. You specifically agree not to access (or attempt to access) any of the Services through any automated means (including use of scripts or web crawlers) and shall ensure that you comply with the instructions set out in any robots.txt file present on the Services.
That being said, there exists an official API to query web search programmatically.
The JSON/Atom Custom Search API lets you develop websites and programs to retrieve and display search results from your Google Custom Search programmatically. With this API, you can use RESTful requests to get search results in either JSON or Atom format.
You can use XML::Atom::Client or LWP+JSON::Any or many other libraries to perform the REST calls.
(You may still find references to the older Google Web Search API but it's deprecated and limited.)
Take a look at the Google Custom search API:
http://code.google.com/apis/customsearch/
If you need to search over a wider variety of hosts, you'll need to use the older, deprecated Websearch API, but that will limit the number of queries you can make per day.
Barring that, you'll need to do a lot of html scraping and parsing.
Here is how a simple script could look like (and yes it violates TOS so it's just PoC, and you shouldn't use it...)
use WWW::Mechanize;
use 5.10.0;
use strict;
use warnings;
my $mech = new WWW::Mechanize;
my $option = shift;
#you may customize your google search by editing this url (always end it with "q=" though)
my $google = 'http://www.google.co.uk/search?q=';
my #dork = ("this is my search one","this is my search two");
#declare necessary variables
my $max = 0;
my $link;
my $sc = scalar(#dork);
#start the main loop, one itineration for every google search
for my $i ( 0 .. $sc ) {
#loop until the maximum number of results chosen isn't reached
while ( $max <= $option ) {
#say $google . $dork[$i] . "&start=" . $max;
$mech->get( $google . $dork[$i] . "&start=" . $max );
#get all the google results
foreach $link ( $mech->links() ) {
my $google_url = $link->url;
if ( $google_url !~ /^\// && $google_url !~ /google/ ) {
say $google_url;
}
}
$max += 10;
}
}
By the way I wrote this a while back, so it's not exactly up to the par, but it does the job, and I am too lazy to boot linux to find the newer version of this...