I admit it's been a while since I've used Perl, but this has me stumped.
Here's the issue:
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
use DBI;
print "Content-type: text/html\n\n";
print "<html><head><title></title></head></body>";
my $login = "admin#xxxxx.com";
my $dbfile = "/var/www/shopsite-data/shopsite_db";
my $sql = qq`SELECT ss_OrderID FROM ss_ORDER WHERE ss_Email=?`;
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", "") || die "Cannot connect: $DBI::errstr";
my $sth = $dbh->prepare($sql);
$sth->execute($login) or die $sth->errstr();
while (my #result = $sth->fetchrow_array()) {
print "OrderID: $result[0]<br />";
}
$sth->finish;
print "</body>";
print "</html>";
$dbh->disconnect;
returns nothing, but I get a resultset when logged in with sqlite3 using the same query. I also get a resultset when I change the query from
my $sql = qq`SELECT ss_OrderID FROM ss_ORDER WHERE ss_Email=?`;
to
my $sql = qq`SELECT ss_OrderID FROM ss_ORDER`;
The obvious problem is the # inside the double quotes:
my $login = "admin#xxxxx.com";
is probably coming out as
$login = "admin.com"
and, if you had warnings switched on, a warning would be printed to the log file, because Perl sees #xxxx as an array and tries to interpolate it, then warns because it is empty. That is, assuming you don't have an array called #xxxx. If you do, then you would get all the values of it in the string.
Where you have the email address, use single quotes around it to prevent #xxxx being interpolated as an array:
my $login = 'admin#xxxxx.com';
Or you could use
my $login = "admin\#xxxxx.com";
to prevent the # starting an interpolation.
There may be other problems with your script but this is the most obvious one.
Strangely enough I was just reading about drawbacks of interpolation in Perl.
One more thing ...
One more thing: you already have fatalsToBrowser, but
use warnings;
use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
would probably have given you a warning on your browser about uninitialized values, so it might be worth turning warningsToBrowser on until your script seems to be working (or if it stops working again) (documentation here), and the other two on always.
I believe Kinopiko already pinpointed the problem.
I will add that, if you are going to use CGI.pm, you should not generate headers by hand. Instead, use CGI::header.
Also:
print "<html><head><title></title></head></body>";
Note the closing tag for body when you meant to use an opening tag.
Last, but definitely not least, you should
use strict;
use warnings;
in your scripts.
Related
Below is the Perl code in .pm file which is supposed to replace the specified strings (that are in "quotes") with some values. But its not happening. Can anyone explain what is happening in this code?
package SomePackage;
require Exporter;
#ISA = qw(Exporter);
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
sub send_request {
my ( $service, $action, $torole ) = #_;
my ( $seller_request_mmd );
my $replace_contents = ();
$replace_contents{"REPLACE_Service"} = $service;
$replace_contents{"REPLACE_RequestAction"} = $action;
$replace_contents{"REPLACE_TradingPartner"} = $torole;
$replace_contents{"REPLACE_Requestxml"} = "Request.xml";
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml" );
}
sub create_mmd_and_transfer {
my $local_replace_contents = shift;
my $input_mmd = shift;
my $local_output_mmd = shift;
my $output_mmd = shift;
update_mmd_file( "$input_mmd", "temp_mmd_file.xml", $local_replace_contents );
}
sub update_mmd_file {
my $input_file = shift;
my $output_file = shift;
my $contents = shift;
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template $input_file \n $input_file not found int the Templates folder \n Please place the same and then run the script ");
open( TEMP_MMD_FILE, ">$output_file" );
while ( <MMD_FILE> ) {
s/^M//g; # Getrid of the ^Ms
foreach my $content ( keys( %$contents ) ) {
my $exact_value = ${%$contents}{$content};
if ( $main::test_scenario =~ /^Invalid Request Action \a\n\d Service/
and ( $content =~ /REPLACE_Service|REPLACE_RequestAction/i ) ) {
}
else {
if ( $exact_value ne "" ) {
s/$content/$exact_value/g;
}
}
}
print TEMP_MMD_FILE;
}
close MMD_FILE;
close TEMP_MMD_FILE;
}
The following will not make your script work, just create the better base for some future questions.
Before you even thinking about posting a perl question here:
1.) add to the top of your script:
use strict;
use warnings;
Posting a code here without these two lines, nobody will bother even trying to read the code.
2.) use perl -c SomePackage.pm for the check. If it will tell you: SomePackage.pm syntax OK - you can start thinking about posting a question here. ;)
Some basic problems with your script:
package SomePackage;
use strict; # see the above
use warnings;
require Exporter;
# these variables are defined outside of this package, so, tell perl this fact. use the `our`
our #ISA = qw(Exporter);
#the use warnings will warn you about the following line
# #EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
#the correct one is without commas
our #EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file); #not saying anything about the #EXPORT rudeness. :)
#my $replace_contents = ();
#the $replace_contents is a scalar. Bellow you using a hash. So,
my %replace_contents;
#or use the scalar but the lines bellow should use the hashref notation, e.g.
# $replace_contents->{"REPLACE_Service"} = $service;
# you decide. :)
# the seller_request_mmd contains undef here.
create_mmd_and_transfer( \%replace_contents, $seller_request_mmd, "/MMD.xml");
# also bellow, in the subroutine definition it wants 4 arguments.
# indicates a problem...
# using 2-arg open is not the best practice.
# Also, you should to use lexical filehandles
# open (MMD_FILE, "<$input_file")
# better
open (my $mmd_file, '<', $input_file)
# of course, you need change every MMD_FILE to $mmd_file
# check the result of the open and die if not successful
# or you can use the
use autodie;
# instead of $exact_value = ${%$contents}{$content};
# you probably want
my $exact_value = $contents->{$content};
Indent your code!
All the above are just about the syntactic problems and not solving anything about the "logic" of your code.
Ps: And me is still an beginner, so, others sure will find much more problems with the above code.
Ok. Here's what I've done to test this.
Firstly, you didn't give us an input file or the code that you use to call the module. So I invented them. I made the simplest possible input file:
REPLACE_Service
REPLACE_RequestAction
REPLACE_TradingPartner
REPLACE_Requestxml
And this driver program:
#!/usr/bin/perl
use strict;
use warnings;
use SomePackage;
send_request('foo', 'bar', 'baz');
sub error_exit {
die #_;
}
The first time, I ran it, I got this error:
Undefined subroutine &main::send_request called at test line 8.
That was because your #EXPORT line was wrong. You had:
#EXPORT = qw(send_request, create_mmd_and_transfer, update_mmd_file);
But the point of qw(...) is that you don't need the commas. So I corrected it to:
#EXPORT = qw(send_request create_mmd_and_transfer update_mmd_file);
Then I re-ran the program and got this error:
Cannot open MMD file template
not found int the Templates folder
Please place the same and then run the script at test line 11.
That looked like there was something missing. I changed the error message, adding indicators of where the variable interpolation was supposed to happen:
open( MMD_FILE, "<$input_file" )
or main::error_exit(" Cannot open MMD file template <$input_file> \n <$input_file> not found int the Templates folder \n Please place the same and then run the script ");
Then the error message looked like this:
Cannot open MMD file template <>
<> not found int the Templates folder
Please place the same and then run the script at test line 11.
So it seems clear that the $input_file variable isn't set in the update_mmd_file() subroutine. Tracing that variable back, we see that this value is originally the $seller_request_mmd variable in send_request(). But in send_request() you declare $seller_request_mmd but you never give it a value. So let's do that:
my ( $seller_request_mmd ) = 'test_input.txt';
Now, when I run your program, it runs to completion without any errors. And I find a new temp_mmd_file.xml is generated. But it is exactly the same as the input file. So more investigation is needed.
Digging into the update_mmd_file() subroutine, we find this interesting line:
my $exact_value = ${%$contents}{$content};
I think you're trying to extract a value from $contents, which is a hash reference. But your syntax is wrong. You were probably aiming at:
my $exact_value = ${$contents}{$content};
But most Perl programmers prefer the arrow notation for working with reference look-ups.
my $exact_value = $contents->{$content};
Making that change and re-running the program, I get an output file that contains:
foo
bar
baz
Request.xml
Which is exactly what I expected. So the program now works.
But there is still a lot of work to do. As you have been told repeatedly, you should always add:
use strict;
use warnings;
to your code. That will find a lot of potential problems in your code - which you should fix.
To be honest, this feels to me like you were trying to run before you could walk. I'd recommend spending some time to work through a good Perl introductory book before taking on my more Perl work.
And there was a lot of useful information missing from your question. It wouldn't have taken as long to get to the solution if you had shown us your driver program and your input data.
I have a script that uses a custom module EVTConf which is just a wrapper around DBI.
It has the username and password hard coded so we don't have to write the username and password in every script.
I want to see the data that the query picks up - but it does not seem to pick up anything from the query - just a bless statement.
What is bless?
#!/sbcimp/dyn/data/scripts/perl/bin/perl
use EVTConf;
EVTConf::makeDBConnection(production);
$dbh = $EVTConf::dbh;
use Data::Dumper;
my %extend_hash = %{#_[0]};
my $query = "select level_id, e_risk_symbol, e_exch_dest, penny, specialist from etds_extend";
if (!$dbh) {
print "Error connecting to DataBase; $DBI::errstr\n";
}
my $cur_msg = $dbh->prepare($query) or die "\n\nCould not prepare statement: ".$dbh->errstr;
$cur_msg->execute();
$cur_msg->fetchrow_array;
print Dumper($cur_msg) ;
This is what I get:
Foohost:~/walt $
Foohost:~/walt $ ./Test_extend_download_parse_the_object
$VAR1 = bless( {}, 'DBI::st' );
$cur_msg is a statement handle (hence it is blessed into class DBI::st). You need something like:
my $cur_msg = $dbh->prepare($query) or die "…";
$cur_msg->execute();
my #row;
while (#row = $cur_msg->fetchrow_array)
{
print "#row\n";
# print Dumper(\#row);
}
only you need to be a bit more careful about how you actually print the data than I was. There are a number of other fetching methods, such as fetchrow_arrayref, fetchrow_hashref, fetchall_arrayref. All the details are available via perldoc DBI at the command line or the DBI page on CPAN.
You can see what the official documentation says about bless by using perldoc -f bless (or going to bless). It is a way of associating a variable with a class, and the class in this example is DBI::st, the DBI statement handle class. You $dbh would be in class DBI::db, for example.
What is the best way to print the results?
The best way to print them out depends on what you know about the result set.
You might choose:
printf "%-12s %6.2f\n", $row[0], $row[3];
if you know that there are only two fields you're interested in (though why didn't you just choose the two you're interested in — it costs time (a little time) to process elements 1 and 2 if they're unused).
You might choose:
foreach my $val (#row) { print "$val\n"; }
You might choose:
for (my $i = 0; $i < scalar(#row); $i++)
{
printf "%-12s = %s\n", $cur_msg->{NAME}[$i], $row[$i];
}
to print out the column name as well as the value. There are many other possibilities too, but those cover the key ones.
As noted by Borodin in his comment, you should be using use strict; and use warnings; automatically and reflexively in your Perl code. There's one variable that is not handled strictly in the code you show, namely $dbh. 'Tis easily remedied; add my before it where it is assigned. But it is a good idea to ensure that you use them all the time. Using them can allows you to avoid unexpected behaviours that you weren't aware of and weren't intending to exploit.
I'd like to store file handle to a global hash and read() it in a subroutine without revealing CGI object, but I find that it doesn't work(resulting zero sized output file).
Here is the simplified perl code:
#!/usr/local/bin/perl
use CGI;
use vars qw(%in);
&init_hash;
$fname = &process_uploaded_file if($in{'upfile'});
$fsize = -s $fname;
print "Content-Type: text/plain\r\n\r\n";
print "in{'upfile'}=",$in{'upfile'},"\r\n";
print "in{'desc'}=",$in{'desc'},"\r\n";
print "fname=",$fname,"\r\n";
print "fsize=",$fsize,"\r\n";
sub init_hash{
my $q = new CGI;
$in{'desc'} = $q->param('desc');
$in{'upfile'} = $q->param('upfile');
$in{'upfh'} = $q->upload('upfile') if($in{'upfile'});
}
sub process_uploaded_file{
my $fname = time.'.bin';
open(OUT,'>',$fname) || die('open file failed');
while(my $read = read($in{'upfh'}, my $buff, 4096)){
print OUT $buff;
}
close(OUT);
eval { close($in{'upfh'}); };
return $fname;
}
EDIT: I should provide perl and cgi.pm version.
Perl version: This is perl 5, version 12, subversion 2 (v5.12.2) built for MSWin32-x86-multi-thread
(with 8 registered patches, see perl -V for more detail)
$CGI::VERSION='3.50';
There is so much wrong with your code.
First your problem: you are trying to optimize where optimization isn't due. And the temp files of the CGI object are deleted before you actually access them. Your code should work when you extend the lifetime of the CGI object, e.g. by adding it to the %in hash.
Always use strict; use warnings;. There are no excuses.
Global variables are declared with our. The vars pragma is a historical artifact. But please don't use global variables, as they are unneccessary here.
Don't call functions like &foo unless you can tell me what exactly this does. Until you have this knowledge: foo().
Use the header method of the CGI object to write headers: $q->header('text/plain').
The \n may not be what you think it is. Do a binmode STDOUT to remove the :crlf PerlIO-layer if it is currently applied. Although equivalent to \r\n, It may be clearer to write \015\012 to demonstrate that you care about the actual bytes.
You can interpolate variables into strings, you know. You can also specify a string that is to be appended after each print by setting $\:
{
local $\ = "\015\012";
print "in{'upfile'}=$in{'upfile'}";
print "in{'desc'}=$in{'desc'}";
print "fname=$fname";
print "fsize=$fsize";
}
Don't use bareword filehandles. Instead of open OUT, "<", $fname you should open my $outfh, "<", $fname.
Why did you put one close in an eval? I don't see how this should die.
Is there a (best) way to check, if $uri was passed in single quotes?
#!/usr/local/bin/perl
use warnings;
use 5.012;
my $uri = shift;
# uri_check
# ...
Added this example, to make my problem more clear.
#!/usr/local/bin/perl
use warnings;
use 5.012;
use URI;
use URI::Escape;
use WWW::YouTube::Info::Simple;
use Term::Clui;
my $uri = shift;
# uri check here
$uri = URI->new( $uri );
my %params = $uri->query_form;
die "Malformed URL or missing parameter" if $params{v} eq '';
my $video_id = uri_escape( $params{v} );
my $yt = WWW::YouTube::Info::Simple->new( $video_id );
my $info = $yt->get_info();
my $res = $yt->get_resolution();
my #resolution;
for my $fmt ( sort { $a <=> $b } keys %$res ) {
push #resolution, sprintf "%d : %s", $fmt, $res->{$fmt};
}
# with an uri-argument which is not passed in single quotes
# the script doesn't get this far
my $fmt = choose( 'Resolution', #resolution );
$fmt = ( split /\s:\s/, $fmt )[0];
say $fmt;
You can't; bash parses the quotes before the string is passed to the Perl interpreter.
To expand on Blagovest's answer...
perl program http://example.com/foo?bar=23&thing=42 is interpreted by the shell as:
Execute perl and pass it the arguments program and http://example.com/foo?bar=23
Make it run in the background (that's what & means)
Interpret thing=42 as setting the environment variable thing to be 42
You should have seen an error like -bash: thing: command not found but in this case bash interpreted thing=42 as a valid instruction.
The shell handles the quoting and Perl has no knowledge of that. Perl can't issue an error message, it just sees arguments after shell processing. It never even sees the &. This is just one of those Unix things you'll have to learn to live with. The shell is a complete programming environment, for better or worse.
There are other shells which dumb things down quite a bit so you can avoid this issue, but really you're better off learning the quirks and powers of a real shell.
I'm continuing to work out of an outdated bioinformatics book and I'm attempting to use the XML::Smart Module.
I suspect the module's methods have changed over the course of 6 years and I'm inexperienced with perl to troubleshoot from cpan source. The commented out code proves the ncbi.gov query functions, I'm having trouble with the 'new' method - it's not parsing the XML. What am I doing wrong? Thanks!
Update Specifically I'm running into trouble with parsing and displaying the Id array: my #Id = $results->{eSearchResult}{IdList}{Id}{'#'}; I'm running this on OSX terminal and I don't see any Ids when I run this script. I am seeing the proper Count. Thanks!
#!/usr/local/bin/perl
# use lib "/Users/fogonthedowns/myperllib";
# use LWP::Simple;
use XML::Smart;
use strict;
#Set base URL for all eutils
my $utils = "http://eutils.ncbi.nlm.nih.gov/entrez/eutils";
my $db = "Pubmed";
my $query ="Cancer+Prostate";
my $retmax = 10;
my $esearch = "$utils/esearch.fcgi?" .
"db=$db&retmax=$retmax&term=";
# my $esearch_result = get($esearch.$query);
# print "ESEARCH RESULT: $esearch_result\n";
# print "Using Query: \n$esearch$query\n";
# print "hello world\n";
my $results = XML::Smart->new($esearch.$query,"XML::Parser");
my $count = $results->{eSearchResult}{Count};
my #Id = $results->{eSearchResult}{IdList}{Id}{'#'};
my $all_Id = join("\n", #Id);
print "Count = $count\n";
print "$all_Id\n";
The first thing you have done wrong is to comment out use strict, the second is to use -w instead of use warnings.
With strict turned on, perl will report:
Bareword "XML::Parser" not allowed while "strict subs" in use at tmp:test.pl line 19.
This lets us trace where the problem is occurring.
The examples in the documentation say that the second argument (the parser to use) should be quoted, and you haven't quoted it.
So we change to:
my $results = XML::Smart->new($esearch.$query,"XML::Parser");
… and it runs.
(Incidentally, the language is called "Perl", not "perl" or "PERL")
change:
my #Id = $results->{eSearchResult}{IdList}{Id}{'#'};
to:
my #Id = $results->{eSearchResult}{IdList}{Id}('#');