CGI Printing issue - perl

#!/usr/bin/perl -w
use CGI qw(:all);
use CGI::Carp qw(fatalsToBrowser);
use strict;
print "Content-type: text/plain\n";
print "\n";
my $date = system('date');
print "Date :: $date";
The above code keeps producing the output of Date :: 0 instead of the current date.
I can't find any solution for this problem. Please help.

Instead of using system command, use backtick. system command doesn't return value in a variable. Change this line:
my $date = system('date');
to
my $date = `date`;
See this for more understanding about system and backtick:
https://stackoverflow.com/a/800105/4248931

The return value of the system command is the return value of the call. For a successful call this will be 0. If you want to capture the output of a command use backticks or IPC. Look at this answer: Capture the output of Perl system()
my $date = `date`;
print "Date :: $date";
But better would be to use DateTime.

Related

How can I get the local time modification of a file with File::stat in perl?

How can I get the file modification time formatted in local time?
By doing this:
use File::stat;
use Time::Piece;
my $format = '%Y%m%d%H%M';
print Time::Piece->strptime(stat($ARGV[0])->mtime, '%s')->strftime($format);
I get 202011301257 for a file that was saved at Nov 30 13:57 in my local time (GMT+01:00).
Since I can do
print localtime $file->stat->mtime;
and
print localtime->strftime($format)
I'd like to do something like
print (localtime stat($file)->mtime)->strftime($format);
Which throws
Can't locate object method "mtime" via package "1" (perhaps you forgot to load "1"?)
Any advice?
I'd like to do something like
print (localtime stat($file)->mtime)->strftime($format);
Very close! Your first parenthesis is in the wrong spot:
#!/usr/bin/env perl
use warnings; # Pardon the boilerplate
use strict;
use feature 'say';
use File::stat;
use Time::Piece;
my $format = '%Y%m%d%H%M';
say localtime(stat($ARGV[0])->mtime)->strftime($format);
Always use use strict; use warnings;. It would have caught the problem:
print (...) interpreted as function at a.pl line 6.
You have the following
print ( localtime ... )->strftime($format);
Because the space between print and ( is meaningless, the above is equivalent to the following:
( print( localtime ... ) )->strftime($format);
The problem is that you are using ->strftime on the result of print. The problem goes away if you don't omit the parens around print's operands.
print( ( localtime ... )->strftime($format) );
Alternatively, not omitting the parens localtime's args would allow you to remove the parens causing the problem.
print localtime( ... )->strftime($format);

Perl parameters passing with special characters

This is a pure Perl parameters passing issue. I cannot use Get::Opt as it is not installed on every machine.
I need to pass parameters with spaces and other special chars sometimes. Three scripts to demo the process. Is there a better way to do this?
[gliang#www stackoverflow]$ perl parameter_wrapper.pl
prep.pl #<5> parameters
prep_v2.pl #<5> parameters
<aaa_777-1>
<bbb-6666-2>
<Incomplete QA>
<-reason>
<too long, mail me at ben#example.com :)>
cat parameter_wrapper.pl
#!/usr/bin/perl -w
use strict;
# call prep.pl with 5 parameters
my $cmd = "./prep.pl aaa_777-1 bbb-6666-2 'Incomplete QA' -reason 'too long, mail me at ben\#example.com :)\n'";
system($cmd);
cat prep.pl
#!/usr/bin/perl -w
use strict;
my #parameters = #ARGV;
my $count = scalar(#parameters);
my #parameters_new = wrap_parameters(#parameters);
my $cmd = "./prep_v2.pl #parameters_new";
print "prep.pl #<$count> parameters\n";
system($cmd);
sub wrap_parameters {
my #parameters = #_;
my #parameters_new;
foreach my $var(#parameters) {
$var = quotemeta($var);
push(#parameters_new, $var);
}
return #parameters_new;
}
cat prep_v2.pl
#!/usr/bin/perl -w
use strict;
my #parameters = #ARGV;
my $count = scalar(#parameters);
print "prep_v2.pl #<$count> parameters\n";
foreach my $var (#parameters) {
#print "<$var>\n";
}
Getopt::Long has been part of the Perl core since Perl 5 was first released in 1994. Are you sure it's not available on the machines you're looking to deploy on? In your comment you refer to it as "Get::Opt", so could you have made a mistake while checking the machines?

Is there a way to check, if an argument is passed in single quotes?

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.

XML::Smart Parser in Perl

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}('#');

Perl-SQLite3: Basic Question

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.