* 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"} > }
Related
I am working on a program which uses different subroutines in separate files.
There are three parts
A text file with the name of the subroutine
A Perl program with the subroutine
The main program which extracts the name of the subroutine and launches it
The subroutine takes its data from a text file.
I need the user to choose the text file, the program then extracts the name of the subroutine.
The text file contains
cycle.name=cycle01
Here is the main program :
# !/usr/bin/perl -w
use strict;
use warnings;
use cycle01;
my $nb_cycle = 10;
# The user chooses a text file
print STDERR "\nfilename: ";
chomp($filename = <STDIN>);
# Extract the name of the cycle
open (my $fh, "<", "$filename.txt") or die "cannot open $filename";
while ( <$fh> ) {
if ( /cycle\.name/ ) {
(undef, $cycleToUse) = split /\s*=\s*/;
}
}
# I then try to launch the subroutine by passing variables.
# This fails because the subroutine is defined as a variable.
$cycleToUse($filename, $nb_cycle);
And here is the subroutine in another file
# !/usr/bin/perl
package cycle01;
use strict;
use warnings;
sub cycle01 {
# Get the total number of arguments passed
my ($filename, $nb_cycle) = #_;
print "$filename, $nb_cycle";
Your code doesn't compile, because in the final call, you have mistyped the name of $nb_cycle. It's helpful if you post code that actually runs :-)
Traditionally, Perl module names start with a capital letter, so you might want to rename your package to Cycle01.
The quick and dirty way to do this is to use the string version of eval. But evaluating an arbitrary string containing code is dangerous, so I'm not going to show you that. The best way is to use a dispatch table - basically a hash where the keys are valid subroutine names and the values are references to the subroutines themselves. The best place to add this is in the Cycle01.pm file:
our %subs = (
cycle01 => \&cycle01,
);
Then, the end of your program becomes:
if (exists $Cycle01::subs{$cycleToUse}) {
$Cycle01::subs{$cycleToUse}->($filename, $nb_cycle);
} else {
die "$cycleToUse is not a valid subroutine name";
}
(Note that you'll also need to chomp() the lines as you read them in your while loop.)
To build on Dave Cross' answer, I usually avoid the hash table, partly because, in perl, everything is a hash table anyway. Instead, I have all my entry-point subs start with a particular prefix, that prefix depends on what I'm doing, but here we'll just use ep_ for entry-point. And then I do something like this:
my $subname = 'ep_' . $cycleToUse;
if (my $func = Cycle01->can($subname))
{
$func->($filename, $nb_cycle);
}
else
{
die "$cycleToUse is not a valid subroutine name";
}
The can method in UNIVERSAL extracts the CODE reference for me from perl's hash tables, instead of me maintaining my own (and forgetting to update it). The prefix allows me to have other functions and methods in that same namespace that cannot be called by the user code directly, allowing me to still refactor code into common functions, etc.
If you want to have other namespaces as well, I would suggest having them all be in a single parent namespace, and potentially all prefixed the same way, and, ideally, don't allow :: or ' (single quote) in those names, so that you minimise the scope of what the user might call to only that which you're willing to test.
e.g.,
die "Invalid namespace $cycleNameSpaceToUse"
if $cycleNameSpaceToUse =~ /::|'/;
my $ns = 'UserCallable::' . $cycleNameSpaceToUse;
my $subname = 'ep_' . $cycleToUse;
if (my $func = $ns->can($subname))
# ... as before
There are definitely advantages to doing it the other way, such as being explicit about what you want to expose. The advantage here is in not having to maintain a separate list. I'm always horrible at doing that.
I'm not aware of how to grab the query string from the URL using Perl. I've tried a couple of ways, example:
my $qs = $ENV{'QUERY_STRING'};
my #d = split(/&/, $qs);
if ( $d[1] eq 'reports' ) {
... do something
}
and
use CGI;
my $q = CGI->new;
my $page = $q->param('page');
But am not getting the value of the key. Right now I'm manually placing in the query string, i.e. project.local/routes.cgi?page=reports but I get the following from the command line:
Use of uninitialized value $qs in split at ./routes.cgi line 23.
Use of uninitialized value $d[1] in string eq at ./routes.cgi line 25.
I'm not sure why this warning exists as it should just be undef if it doesn't exist?
How should I store and check a query string variable? I'm primarily using the routes.cgi script as a routes controller where all links point to i.e. <a href="project.local/routes.cgi?page=xx"> and then I process a template toolkit file and redirect to that page (good concept?)
Results of diagnostics:
Use of uninitialized value $qs in split at ./routes.cgi line 23 (#1)
(W uninitialized) An undefined value was used as if it were already
defined. It was interpreted as a "" or a 0, but maybe it was a mistake.
To suppress this warning assign a defined value to your variables.
Edit:
use URI qw( );
use URI::QueryParam qw( );
my $u = URI->new($base_url);
my ($p) = $u->query_param('page');
if ( $p eq 'reports' ) {
...do something
}
Man, youre fighting many days (based on your past questions) with your route.cgi. Reading thru comments and answers in your past questions, many developers already said to you: use some framework.
Now for your question(s):
Use of uninitialized value $qs in split at ./routes.cgi line 23.
Thats mean (in line, what the use diagnostics says) - the $qs variable isn't contains any value. Why the $ENV{'QUERY_STRING'}; isn't have a value is depends on your environment, but generally, you should not depend on some environment variables but on what you get from the HTTP request.
Use of uninitialized value $d[1] in string eq at ./routes.cgi line 25.
Of course, because the $qs is undefined, the split splits the nothing, and the splitted nothing is nothing too - so you get nothing to your #d array and therefore the $d[1] isn't initialised.
BTW, when you comes from the php-word (as you said in one of your questions), you should to know, than after an succesfull split of the "QUERY_STRING" at & you will get to $d[0] the value page=report and not only the report.
As #AndyLester told you, for handling URL's (getting or composing) its parts here is the URI::URL module, but you really should at least read it's description.
Ad routes: generally is better and nicer and more SEO friendly to have URLs like:
http://example.com/blog/archive/2013/12/20
and not
http://example.com/run?section=blog&action=archive&year=2014&month=12&day=20
So, for the "routes" don't use URL parameters, but the PATH_INFO. And this "philosophy" is already developed into many frameworks, like Poet+Mason, Mojolicious, Dancer and many others, or here are standalone modules for handling routes. (search MetaCPAN.org).
From my point of view, the perl web-app developemnt based on the next commands:
Install my own perl-environment (need only once)
curl -L http://install.perlbrew.pl | bash
#relog, to init the environment
perlbrew available
prelbrew install perl-5.20.0
prelbrew switch perl-5.20.0
prelbrew install-cpanm
When got my "own" perl
cpanm Poet #will install a bunch of modules
#or alternatively
cpanm Mojolicious
And from now, things are relatively easy:
cd my_development_directory
poet new myapp
cd myapp
echo 'This is my report <% localtime %>' > comps/report.mc
./bin/run.pl
and you have an running perl web-application. So, point your browser to: http://localhost:5000/report and will get
This is my report Tue Jul 29 16:09:52 2014
and alongside you will get an great debug panel and much more... (see Mason & Poet manuals)
I'm still an beginner in perl development, so other more experianced perl-monks could give you better advices.
You want to use the URI::URL module.
http://search.cpan.org/dist/URI/lib/URI/URL.pm
jm666 is correct, you really should consider using a framework. However, if you are looking to keep your module installs to a minimum, try something like this...
use strict;
use warnings;
use URI::Escape;
use Data::Dumper;
#this will catch anything after the "?", as in SomeURL?Var=111&OtherVar=QQQ
my $RequestHash;
if($ENV{"QUERY_STRING"}) {
#QUERY_STRING="id=demo:5&other=some%20text&last=more%20text"
my #TempArray=split("&", $ENV{"QUERY_STRING"});
foreach my $item (#TempArray) {
my ($Key, $Value)=split("=", uri_unescape($item)); #need to fix this to work with more than one "=" in the value
$RequestHash->{lc($Key)}=$Value; #normalize the key name to lower case - because you never know what users will do
} #end foreach
} #end query check if
print Data::Dumper::Dumper($RequestHash);
I am trying to store my log messages in a hash depending upon message type as shown below:
#!/usr/bin/perl
use strict;
use warnings;
my %log;
opendir (DIR, '.') or die $!;
while (my $file = readdir(DIR)) {
# some code to select TAR filename in $1
if (-e $1.'.tar') {
push(#{$log->{$1}}, $file); /* line 12 */
}
else {
$log{$1} = [];
push(#{$log->{$1}}, $file); /* line 16 */
}
Now this code gives compilation error saying:
Global symbol "$log" requires explicit package name at at lines 12 & 16
where I am actually trying to use the hash "%log". What can be a possible way to get rid of this error ? Why exactly is this happening ?
I did see some explanation on context where people replied saying the variables were created in one context and were being referred in another but I feel this variable should be available inside while loop in this piece of code. This happens only when I have "use strict" and works fine otherwise.
I have started with Perl so I do not fully understand the basics! Please help me understand why this variable is not accessible.
my %log;
defines hash %log, but lines 12 and 16 don't use it. Instead, you're accessing the anonymous hash referenced by the scalar $log which you've never declared. You have two options.
You could continue to use an anonymous hash.
my $log = {}; # The creation of the hash ("{}") is currently being done
# implicitly by "->". This is called autovivification.
... $log->{...} ...
This adds a bit of a extra complexity and an unnoticeable reduction in speed.
You could use use a hash directly.
my %log;
... $log{...} ...
I'm not sure what are you trying to do with $1, but the hash access is not a reference, so change:
$log->{$1}
to
$log{$1}
The error message you got, says: Global symbol "$log" requires explicit package, because $log variable was not defined. Remember that %log and $log are two different variables (hash vs scalar).
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).
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.