I'm trying to create a base template which then loads data depending on what actions are taken. I included ( required ) some pages which was fine but when I included another file which I got a 500 internal error. pasting the code straight in and it works fine:
Here's what I've got;
#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple;
require LWP::UserAgent;
use DBI;
#deal with post requests
require "perl/post-sort.pl";
#loading stylesheets and javascripts
require "header.pl";
# bring in loggin js
if( $arg{REQUEST_KEY} eq "") {
require "javascript/js-main-login.pl";
}
print "</head> \n";
print " \n";
...
...
perl/post-sort.pl
my %arg = ();
for (split /\&/, <STDIN>) {
my ($key, $val) = split /=/;
$val =~ s/\+/ /g;
$val =~ s/%([0-9a-fA-F]{2})/chr(hex($1))/ge;
$arg{$key} = $val;
}
Any help much appreciated.
A 500 internal server error often indicates a bad or missing header. Make sure that in the included code, the first thing that gets printed (to the browser) is the header, or make sure that nothing gets printed and the original code will print out the right header.
Another possibility is that a file you are require'ing does not "return true as the last statement" (i.e., doesn't end with a 1;), which would cause your script to fail at compile-time and produce a 500 error.
Also see this apropos discussion on debugging CGI scripts from earlier today.
Related
my code,
#!/usr/bin/perl -w
use strict;
use warnings;
my $codes=" ";
my $count=0;
my $str1="code1";
open (FILE, '/home/vpnuser/testFile.txt') or die("Could not open the file.");
while($codes=<FILE>)
{
print($codes);
if($codes eq $str1)
{
$count++;
}
}
print "$count";
the comparison always fails. my testFile.txt contains one simple line - code1
when i have written a separate perl script where i have two strings declared in the script it self rather than getting it from a file, the eq operator works fine. but when i am getting it from a file, there is a problem. Pease help,
Thanks in advance!
Don't forget to chomp your file input if you don't want it to end in a return character.
while(my $codes = <FILE>)
{
chomp $codes;
That is likely the reason why your string comparison is failing.
As on additional aside, kudus for including use strict; and use warnings; at the the top of your script, like one should always do.
I'd like to recommend that you also include use autodie; at the top as well when doing file processing. It will automatically give you a detailed error message for doing many kinds of operations, such as opening a file, so you won't have to remember to include the error code $! or the filename in your die statement.
I am new to Perl language and have this script which scrapes the amazon website for reviews. Everytime I run it I get an error about a compilation error. Was wondering if someone could shed some light as to whats wrong with it.
#!/usr/bin/perl
# get_reviews.pl
#
# A script to scrape Amazon, retrieve reviews, and write to a file
# Usage: perl get_reviews.pl <asin>
use strict;
use warnings;
use LWP::Simple;
# Take the asin from the command-line
my $asin = shift #ARGV or die "Usage: perl get_reviews.pl <asin>\n";
# Assemble the URL from the passed asin.
my $url = "http://amazon.com/o/tg/detail/-/$asin/?vi=customer-reviews";
# Set up unescape-HTML rules. Quicker than URI::Escape.
my %unescape = ('"'=>'"', '&'=>'&', ' '=>' ');
my $unescape_re = join '|' => keys %unescape;
# Request the URL.
my $content = get($url);
die "Could not retrieve $url" unless $content;
#Remove everything before the reviews
$content =~ s!.*?Number of Reviews:!!ms;
# Loop through the HTML looking for matches
while ($content =~ m!<img.*?stars-(\d)-0.gif.*?>.*?<b>(.*?)</b>, (.*?)[RETURN]
\n.*?Reviewer:\n<b>\n(.*?)</b>.*?</table>\n(.*?)<br>\n<br>!mgis) {
my($rating,$title,$date,$reviewer,$review) = [RETURN]
($1||'',$2||'',$3||'',$4||'',$5||'');
$reviewer =~ s!<.+?>!!g; # drop all HTML tags
$reviewer =~ s!\(.+?\)!!g; # remove anything in parenthesis
$reviewer =~ s!\n!!g; # remove newlines
$review =~ s!<.+?>!!g; # drop all HTML tags
$review =~ s/($unescape_re)/$unescape{$1}/migs; # unescape.
# Print the results
print "$title\n" . "$date\n" . "by $reviewer\n" .
"$rating stars.\n\n" . "$review\n\n";
}
The syntax errors seem to be caused by the "[RETURN]" that appears twice in your code. When I removed those, the code compiled without problems.
Amazon don't really like people scraping their web site. Which is why they provide an API that gives you access to their content. And there's a Perl module that for using that API - Net::Amazon. You should use that instead of fragile web scraping techniques.
Maybe you should try Web::Scraper (http://metacpan.org/pod/Web::Scraper).
It will get the job done in a much cleaner way.
[EDIT] Anyway, I checked the HTML code of a random review and it appears that your pattern is outdated. The reviewer's name, for instance, is introduced by 'By' and not by 'Reviewer'.
I'm trying to inspect cookie values in a cgi script; my test script looks like
#!/usr/bin/perl -w
use DBI;
use CGI qw/:standard/;
use CGI::Cookie;
my $cgiH = CGI->new;
print header;
print start_html(-title=>'Cookie Terms'), h1("Cookie Terms"), "<hr>\n";
%cookies = CGI::Cookie->fetch;
foreach $k (keys %cookies) {
my $term = "$cookies{$k}";
my $term =~ s/SubjectTerm//;
print "at $k is $term \n";
}
print end_html;
the relevant input to the script (from an HTTP GET) is
Cookie: SubjectTerm1=ponies
Cookie: SubjectTerm2=horses
(this is verified by using either fiddler or debugging the code in my delphi app). the result of my script (omitting the HTML wrapper) is either
at SubjectTerm1 is
at SubjectTerm2 is
or if I change the print statement to
print "at $k is $cookies{$k}\n";
it is
at SubjectTerm1 is SubjectTerm1=ponies; path=/
at SubjectTerm2 is SubjectTerm2=horses; path=/
What I want to arrive it is something like this
at SubjectTerm1 is ponies
at SubjectTerm2 is horses
I know I'm missing something about the hash usage but can't quite figure out what it is.
am I not addressing the %cookies hash correctly?
If you had use warnings you would see you are clobbering the $term with the line
my $term =~ s/SubjectTerm//;
Remove the my.
I think you might be able to extract the value is simply changing the assignment to
my $term = $cookies{$k}->value();
and get rid of the s/SubjectTerm//. But not sure about this sorry.
As an aside, before I answer the question, I'd strongly recommend you look at using something other than CGI.pm -- it's the best of late-90s Perl, and other than being included by default in the core perl distribution has little to recommend it.
Some more modern, more featureful alternatives include:
CGI::Application - http://cgi-app.org/
Mojolicious - http://mojolicio.us/
Dancer - http://www.perldancer.org/
Beyond that, as #Sodved says if you'd included use strict; and use warnings; at the top of your file the first of your problems -- clobbering $term by using my twice -- would have been highlighted immediately.
Once you're using the strict and warnings pragmas (and I'd say, don't leave home without them) you'll also want to change your foreach to either:
foreach (keys %cookies) {
my $term = $cookies{$_};
...
OR
foreach my $k (keys %cookies) {
my $term = $cookies{$k};
...
That is, you'll either need to declare the $k variable, or you may prefer to use Perl's built-in $_ inside the loop -- it's purely a matter of style.
Good luck!
* SECOND UPDATE FOR SUNDAY*
Now at this point I have found some added success at displaying the desired sub
The new snippet of code which enabled me to actually invoke a specific sub as I wanted.
In researching I stumbled upon the following snippet which deals with reading incoming FORM data.
This snippet does enable the invocation of the sub of my choice from this script.
However from the CLI when I run perl -x against the script the system returns the following
nonfatal *warnings* that I would like to gain understanding of and resolve.
My research shows that (tr///) and $ENV{"REQUEST_METHOD"} and $buffer are returning empty
values "" OR 0.
How would I best resolve these following errors?
I realize I can just delete any
reference to (tr///) and $buffer to resolve those errors, however, I question removing
*$ENV{"REQUEST_METHOD"}* as it seems this imperative to the function of this snippet???
CLI ERROR
Use of uninitialized value in transliteration (tr///) at test.pl line 36 (#1)
Use of uninitialized value $ENV{"REQUEST_METHOD"} in string eq at test.pl line 37 (#1)
Use of uninitialized value $buffer in split at test.pl line 44 (#1)
#!/usr/bin/perl -w
# (test.pl)
use DBI;
use DBD::mysql;
use warnings;
use strict;
use diagnostics;
$| = 1;
# The script I am wanting to create, is to allow users at (NAS) HotSpot to create a user account
# which is to write into MySQL db TABLE's *radcheck* and *radreply*.
#
# Now at this point I have found some added success at displaying the desired *sub*
# The new snippet of code which enabled me to actually *invoke* a specific *sub* as I wanted
# from an HTML form.
# Please see below for solution which still has some questions.
print "Content-type: text/html\n\n";
sub BuildAcctNow {
print "<h1 style=\"color:blue;font-family:Arial;font-size:xx-large;\">TO BUILD YOUR ACCOUNT TODAY WE WILL NEED A SMALL AMOUNT OF INFORMATION</h1><br><br>\n\n";
}
sub PauseAcctNow {
print "<h2 style=\"color:red;font-family:Arial;font-size:xx-large;\">YOUR ACCOUNT HAS BEEN PAUSED PLEASE MAKE A PAYMENT HERE.</h2><br><br>\n\n";
}
# In researching I stumbled upon the fllowing snippet which deals with reading inward FORM data.
# This snippet *does* enable the *invocation* of the *sub* of my choice from this script.
# However from the CLI when I run perl -x against the script the system returns the following
# *nonfatal* *warnings* that I would like to gain understading of and resolve.
# My research shows that (tr///) and $ENV{"REQUEST_METHOD"} and $buffer are returning empty
# values, How would I best resolve these following errors? I realize I can just delete any
# reference to (tr///) and $buffer to resolve those errors, howerver I question removing
# $ENV{"REQUEST_METHOD"} as it seems this imperative to the function of th ssnippet???
#
#
# Use of uninitialized value in transliteration (tr///) at test.pl line 36 (#1)
# Use of uninitialized value $ENV{"REQUEST_METHOD"} in string eq at test.pl line 37 (#1)
# Use of uninitialized value $buffer in split at test.pl line 44 (#1)
my ($buffer, #pairs, $pair, $name, $value, %FORM);
# Read in text
$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;
if ($ENV{'REQUEST_METHOD'} eq "POST")
{
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}else {
$buffer = $ENV{'QUERY_STRING'};
}
# Split information into name/value pairs
#pairs = split(/&/, $buffer);
foreach $pair (#pairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%(..)/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
if ($FORM{PauseAcct}) {
PauseAcctNow();
exit;
}
elsif ($FORM{BuildAcct}) {
BuildAcctNow();
exit;
}
END SECOND SUNDAY UPDATE
SUNDAY UPDATE **
I have made a simple script to hopefully exhibit what I am trying to do to this point hopefully?
The script I am ultimately needing to create will write to MySQL db into radcheck and radreply to enable users to log onto a (NAS) HotSpot.
So I will have more than one subroutine within the script.
The script presently displays an empty screen VIA browser when I use a HTML doc with a properly named SUBMIT form within the doc named BuildAcct.
I am traditionally used to defining the sub within the script and then I would define if test(s) within the script which would wait for match(es) from any defined form name(s) when they are interacted with to then call a particular sub.
Below is a test script I have created just trying to get past the antiquated use of & when calling a sub, this is causing me some grief and I am hoping for some valuable input.
#!/usr/bin/perl -w
# (test.pl)
use DBI;
use DBD::mysql;
use warnings;
#use strict;
# Presently due to my errors below I have disabled *use strict*.
$| = 1;
# The script I am wanting to create, is to allow users at (NAS) HotSpot to create a user account
# which is to write into MySQL db TABLE's *radcheck* and *radreply*.
#
# Trying to bring myself up to speed with a very basic task which I have defined below, in my
# older scripts I would define the *sub* itself, then in the script I would use an *if* test
# which checks to see if any defined FORM value returns a hit such as $form_data{'BuildAcct'} ne ""
# to call the required *sub* _ThisOne_.
print "Content-type: text/plain\n\n";
sub ThisOne {
print "Trying to display this subroutine upon submission of BuildAcct\n";
}
# Following is the *if* test I am accustomed to using to make a call to a particular sub when
# the form NAME BuildAcct is interacted with, but this is unacceptable now I realize.
# CLI Return:
# Use of uninitialized value $form_data{"BuildAcct"} in string ne at test.pl line 32.
# Use of uninitialized value $form_data{"BuildAcct"} in string ne at test.pl line 41.
if ($form_data{'BuildAcct'} ne "")
{
&ThisOne;
exit;
}
# SO, I have Google'd, and looked over numerous methods of calling *subs*, I am just stuck though,
# Why can't the following *if* test work if use of & is no longer used?
if ($form_data{'BuildAcct'} ne "")
{
ThisOne();
exit;
}
Thanking you in advance for help...
Best Regards
UPDATE **
I have turned the -w switch off on the script, not sure if that poses a negative influence, pretty new to perl.
I also created some clunky code that is ugly.
The weird thing is that from the CLI when I execute the script the system returns:
Use of uninitialized value $form_data{"BuildAcct"} in string at acctmanager.pl line 211.
Use of uninitialized value $form_data{"Test"} in string at acctmanager.pl line 212.
Yet VIA browser from a HTML doc I can change the SUBMIT name value back and forth between BuildAcct and Test and the script successfully returns two different and correct subroutines when submitted.
The BuildAcct sub returns form fields I defined within that subroutine, whereas Test does a MySQL TABLE GROUP rowfetch and displays 3 different tables from a db and prints them to the browser.
Below is my present code :-(
local ($form_data{'BuildAcct'}) = "$form_data{'BuildAcct'}";
local ($form_data{'Test'}) = "$form_data{'Test'}";
#
# AddNewUser FORM definition.
if ($form_data{'BuildAcct'} ne "")
{
&AddNewUser;
exit;
}
#
# DispTest FORM definition.
elsif ($form_data{'Test'} ne "")
{
&DispTest;
exit;
}
Could someone give me a nudge into the right direction possibly?
Thanking you in advance
ORIGINAL POST
At this point I have a FORM on an HTML doc named BuildAcct, likewise within my script I have defined the following which is to make the call to the subroutine AddNewUser when the user submits the HTML FORM...
if ($form_data{'BuildAcct'} ne "")
{
&AddNewUser;
exit;
}
The script uses cgi-lib.pl
# Enable parsing of FORM_DATA VIA cgi-lib.pl.
&ReadParse(*form_data);
## FORM or IMG FORM Fix
foreach (keys %form_data)
{
## Fix incoming form data with Image buttons
$form_data{$1} = $form_data{$_} if (/(.*)\.x/);
}
The thing I can't understand is why does this work in another script I use but this new script returns the following upon execution at the CLI;
Use of uninitialized value $form_data{"BuildAcct"} in string ne at acctmanager.pl line 208.
Use of uninitialized value $form_data{"Test"} in string ne at acctmanager.pl line 215.
Help and suggestions are greatly appreciated.
Best Regards
My best guess is that %form_data hash is being populated via cgi-lib.pl, therefore when you run it via command line, cgi-lib.pl isn't getting any input from the web browser... having said this, you haven't included the code where you're using cgi-lib.pl, so I can't be sure.
p.s. don't turn off warnings. They're there for a reason. If nothing else, you can paste the warning into google. While you're at it, alway put use strict; at the top of your script, and fix all undeclared variables.
To fix the error "Use of uninitialized value $form_data{"BuildAcct"} in string",
You can check with defined($form_data{"BuildAcct"}) or defined $form_data{"BuildAcct"} like below, before making use of $form_data{"BuildAcct"} :
if (defined $form_data{"BuildAcct"}) { < other code based on
$form_data{"BuildAcct"} > }
Server is linux. I am having inexplicable problems when I send POST data to the script.
For example, I send the following POST data: choice=update
Here is the script:
#!/usr/bin/perl -w
print "Content-type: text/html\n\n";
if ( $ENV{'REQUEST_METHOD'} eq "GET" ) {
$in = $ENV{'QUERY_STRING'};
} elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
}
#in = split(/&/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
# Convert %XX from hex numbers to alphanumeric
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;
# Associate key and value
$in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
$in{$key} .= $val;
}
print $in{'choice'};
The first time I access the script, it prints update
The second time I access it, it prints updateupdate
The third time, it prints updateupdateupdate
...and so on.
What on earth could be causing it to keep appending the string to itself between requests? I am sending exactly the same POST data every time by simply refreshing with my browser. Cookies are not being used. There is nothing else in the file that is not commented out.
Edit: Also, when I print <STDIN> it says choice=update every time. The other updates don't appear to be added to STDIN
My guess is that the script is kept running between requests. As %in is a global variable it is never cleared, so that $in{$key} .= $value ends up making the string longer and longer. You can probably evade the problem by using lexical variables.
This means you'll need to find out how the script is being run by the web server.
You'll also want to look at using modules to do all this parsing work for you, and learn about ways to write perl code avoid the problem you've encountered. I'd suggest taking a look at Modern Perl and working from there.
It sounds / looks like it's related to the web server's configuration and not the script itself.
However, at the beginning of the code, try adding:
my %in;
This would scope the variable you're printing.
Also, at the end of the code I would add: exit 0;
(Although usually not necessary).