perl hash declaration error - perl

I am new to perl and can't seem to find why this snippet is giving me a 500 error.
#!/usr/bin/perl
use strict;
use warnings;
use CGI::Carp qw( fatalsToBrowser );
my ($distance, $weight, $total_gas, $mph, $buffer, $pair, #pairs, $value, $form, $name);
our %FORM = ();
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
#pairs = split(/&/, $buffer);
foreach $pair (#pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$FORM{$name} = $value;
}
Everything I tried on the %FORM = (); gives me variable declaration errors.

Are you certain that #pairs contains the values you expect (ie that they are name value pairs split with "="? More than likely $name isn't defined and you can't add an undefined key pair to a hash. Why are you using STDIN to read in values from the query string? Try:
my $q = CGI->new;
my #keys = $q->param;
my %FORM;
foreach my $name (#keys)
{
my $value = $q->param($name);
$FORM{$name} = $value;
}
or
my $q = CGI->new;
my %FORM = $q->Vars;
http://perldoc.perl.org/CGI.html

I think you're missing HTTP header. Try adding to put following line before any print:
print "Content-type: text/html\n\n";
Make sure you have enough permissions for script to run. It'll depend on OS you're using.
Also you'd consider using CGI module as mentioned in scrappedcola's answer. This code will work for both POST and GET:
use strict; use warnings;
use CGI;
my $form = CGI->Vars;
print "Content-type: text/html\n\n";
print "name=".$form->{name};

Related

Perl get hash keys value count in single hash itself

I have written a script which processes data from $data variable and get the count of values of each key.
The script works fine but I am producing 2 hashes called %data_hash, %count_hash. One for storing the data and another to get the count of those key values.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my $data = "KEY1,VAL1
KEY2,VAL1
KEY1,VAL2
KEY1,VAL3
KEY1,VAL4
KEY2,VAL2
KEY2,VAL3
KEY2,VAL4
KEY1,VAL5
";
my (%data_hash, %count_hash);
foreach my $each_data (split /\n/, $data){
my ($key, $val) = (split /,/, $each_data);
push( #{$data_hash{$key}}, $val );
}
print Dumper(\%data_hash);
foreach my $key (sort keys %data_hash) {
$count_hash{$key} = scalar #{$data_hash{$key}};
}
print Dumper(\%count_hash);
Can I have a single hash instead of 2 and get the count by retaining the data?
Sure you can:
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my $data = "KEY1,VAL1
KEY2,VAL1
KEY1,VAL2
KEY1,VAL3
KEY1,VAL4
KEY2,VAL2
KEY2,VAL3
KEY2,VAL4
KEY1,VAL5
";
my (%data_hash, %count_hash);
foreach my $each_data (split /\n/, $data){
my ($key, $val) = (split /,/, $each_data);
push( #{$data_hash{$key}{vals}}, $val );
$data_hash{$key}{num_vals}++;
}
print Dumper(\%data_hash);

get request in perl and Use of uninitialized value

my $url = "https://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=pubmed&term=journal+of+medical+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]&usehistory=y";
print "\n before url \n";
print $url;
#post the esearch URL
my $output = get($url);
print $output;
I have not used perl ever before.
If I hit this URL in browser, I do get the XML.
However, From what I see in output from script, $output is empty and
print $output;
returns
Use of uninitialized value in print at ./extractEmails.pl line 48.
Please suggest what's wrong and how to fix it
Edit:
As suggested, complete code:
#!/usr/bin/perl -w
# A perlscript written by Joseph Hughes, University of Glasgow
# use this perl script to parse the email addressed from the affiliations in PubMed
use strict;
use LWP::Simple;
my ($query,#queries);
#Query the Journal of Virology from 2014 until the present (use 3000)
$query = 'journal+of+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(#queries,$query);
#Journal of General Virology
$query = 'journal+of+general+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(#queries,$query);
#Virology
$query = 'virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(#queries,$query);
#Archives of Virology
$query = 'archives+of+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(#queries,$query);
#Virus Research
$query = 'virus+research[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(#queries,$query);
#Antiviral Research
$query = 'antiviral+research[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(#queries,$query);
#Viruses
$query = 'viruses[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
push(#queries,$query);
#Journal of Medical Virology
$query = 'journal+of+medical+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]';
# global variables
push(#queries,$query);
my %emails;
my $emailcnt=0;
my $count=1;
#assemble the esearch URL
foreach my $query (#queries){
my $base = 'https://eutils.ncbi.nlm.nih.gov/entrez/eutils/';
#my $url = $base . "esearch.fcgi?db=pubmed&term=$query&usehistory=y";
my $url = "https://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?db=pubmed&term=journal+of+medical+virology[journal]+AND+2014[Date+-+Publication]:3000[Date+-+Publication]&usehistory=y";
print "\n before url \n";
print $url;
#post the esearch URL
my $output = get($url);
print "\n before output \n";
print get($url);
print $output;
#parse WebEnv, QueryKey and Count (# records retrieved)
my $web = $1 if ($output =~ /<WebEnv>(\S+)<\/WebEnv>/);
my $key = $1 if ($output =~ /<QueryKey>(\d+)<\/QueryKey>/);
my $count = $1 if ($output =~ /<Count>(\d+)<\/Count>/);
#retrieve data in batches of 500
my $retmax = 500;
for (my $retstart = 0; $retstart < $count; $retstart += $retmax) {
my $efetch_url = $base ."efetch.fcgi?db=pubmed&WebEnv=$web";
$efetch_url .= "&query_key=$key&retmode=xml";
my $efetch_out = get($efetch_url);
my #matches = $efetch_out =~ m(<Affiliation>(.*)</Affiliation>)g;
#print "$_\n" for #matches;
for my $match (#matches){
if ($match=~/\s([a-zA-Z0-9\.\_\-]+\#[a-zA-Z0-9\.\_\-]+)$/){
my $email=$1;
$email=~s/\.$//;
$emails{$email}++;
}
}
}
my $cnt= keys %emails;
print "$query\n$cnt\n";
}
print "Total number of emails: ";
my $cnt= keys %emails;
print "$cnt\n";
my #email = keys %emails;
my #VAR;
push #VAR, [ splice #email, 0, 100 ] while #email;
my $batch=100;
foreach my $VAR (#VAR){
open(OUT, ">Set_$batch\.txt") || die "Can't open file!\n";
print OUT join(",",#$VAR);
close OUT;
$batch=$batch+100;
}
I recommend against using LWP::Simple for any reason because it is impossible to configure it or handle errors usefully. Using LWP::UserAgent which it wraps is nearly as simple anyway (though the error handling is a bit complicated). The below examples would replace the use LWP::Simple; and my $output = get($url); lines.
use strict;
use warnings;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new(timeout => 30);
my $response = $ua->get($url);
unless ($response->is_success) {
# the Client-Warning, Client-Aborted, and X-Died headers each may be set on client/transport errors
die $response->status_line;
}
my $output = $response->decoded_content;
The core HTTP::Tiny is also simple.
use strict;
use warnings;
use HTTP::Tiny;
my $ua = HTTP::Tiny->new;
my $response = $ua->get($url);
unless ($response->{success}) {
die $response->{status} == 599 ? $response->{content} : "$response->{status} $response->{reason}";
}
my $output = $response->{content};
If you really want an LWP::Simple approach that will at least report transport errors, try ojo from Mojolicious:
perl -Mojo -E'say g(shift)->text' http://example.com
In a script rather than a oneliner, you can use Mojo::UserAgent directly, and also handle HTTP errors like above:
use strict;
use warnings;
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
my $response = $ua->get($url)->result;
unless ($response->is_success) {
die $response->code . ' ' . $response->message;
}
my $output = $response->text;

Perl : Need to append two columns if the ID's are repeating

If id gets repeated I am appending app1, app2 and printing it once.
Input:
id|Name|app1|app2
1|abc|234|231|
2|xyz|123|215|
1|abc|265|321|
3|asd|213|235|
Output:
id|Name|app1|app2
1|abc|234,265|231,321|
2|xyz|123|215|
3|asd|213|235|
Output I'm getting:
id|Name|app1|app2
1|abc|234,231|
2|xyz|123,215|
1|abc|265,321|
3|asd|213,235|
My Code:
#! usr/bin/perl
use strict;
use warnings;
my $basedir = 'E:\Perl\Input\\';
my $file ='doctor.txt';
my $counter = 0;
my %RepeatNumber;
my $pos=0;
open(OUTFILE, '>', 'E:\Perl\Output\DoctorOpFile.csv') || die $!;
open(FH, '<', join('', $basedir, $file)) || die $!;
my $line = readline(FH);
unless ($counter) {
chomp $line;
print OUTFILE $line;
print OUTFILE "\n";
}
while ($line = readline(FH)) {
chomp $line;
my #obj = split('\|',$line);
if($RepeatNumber{$obj[0]}++) {
my $str1= join("|",$obj[0]);
my $str2=join(",",$obj[2],$obj[3]);
print OUTFILE join("|",$str1,$str2);
print OUTFILE "\n";
}
}
This should do the trick:
use strict;
use warnings;
my $file_in = "doctor.txt";
open (FF, "<$file_in");
my $temp = <FF>; # remove first line
my %out;
while (<FF>)
{
my ($id, $Name, $app1, $app2) = split /\|/, $_;
$out{$id}[0] = $Name;
push #{$out{$id}[1]}, $app1;
push #{$out{$id}[2]}, $app2;
}
foreach my $key (keys %out)
{
print $key, "|", $out{$key}[0], "|", join (",", #{$out{$key}[1]}), "|", join (",", #{$out{$key}[2]}), "\n";
}
EDIT
To see what the %out contains (in case it's not clear), you can use
use Data::Dumper;
and print it via
print Dumper(%out);
I'd tackle it like this:
#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use 5.14.0;
my %stuff;
#extract the header row.
#use the regex to remove the linefeed, because
#we can't chomp it inline like this.
#works since perl 5.14
#otherwise we could just chomp (#header) later.
my ( $id, #header ) = split( /\|/, <DATA> =~ s/\n//r );
while (<DATA>) {
#turn this row into a hash of key-values.
my %row;
( $id, #row{#header} ) = split(/\|/);
#print for diag
print Dumper \%row;
#iterate each key, and insert into $row.
foreach my $key ( keys %row ) {
push( #{ $stuff{$id}{$key} }, $row{$key} );
}
}
#print for diag
print Dumper \%stuff;
print join ("|", "id", #header ),"\n";
#iterate ids in the hash
foreach my $id ( sort keys %stuff ) {
#join this record by '|'.
print join('|',
$id,
#turn inner arrays into comma separated via map.
map {
my %seen;
#use grep to remove dupes - e.g. "abc,abc" -> "abc"
join( ",", grep !$seen{$_}++, #$_ )
} #{ $stuff{$id} }{#header}
),
"\n";
}
__DATA__
id|Name|app1|app2
1|abc|234|231|
2|xyz|123|215|
1|abc|265|321|
3|asd|213|235|
This is perhaps a bit overkill for your application, but it should handle arbitrary column headings and arbitary numbers of duplicates. I'll coalesce them though - so the two abc entries don't end up abc,abc.
Output is:
id|Name|app1|app2
1|abc|234,265|231,321
2|xyz|123|215
3|asd|213|235
Another way of doing it which doesn't use a hash (in case you want to be more memory efficient), my contribution lies under the opens:
#!/usr/bin/perl
use strict;
use warnings;
my $basedir = 'E:\Perl\Input\\';
my $file ='doctor.txt';
open(OUTFILE, '>', 'E:\Perl\Output\DoctorOpFile.csv') || die $!;
select(OUTFILE);
open(FH, '<', join('', $basedir, $file)) || die $!;
print(scalar(<FH>));
my #lastobj = (undef);
foreach my $obj (sort {$a->[0] <=> $b->[0]}
map {chomp;[split('|')]} <FH>) {
if(defined($lastobj[0]) &&
$obj[0] eq $lastobj[0])
{#lastobj = (#obj[0..1],
$lastobj[2].','.$obj[2],
$lastobj[3].','.$obj[3])}
else
{
if($lastobj[0] ne '')
{print(join('|',#lastobj),"|\n")}
#lastobj = #obj[0..3];
}
}
print(join('|',#lastobj),"|\n");
Note that split, without it's third argument ignores empty elements, which is why you have to add the last bar. If you don't do a chomp, you won't need to supply the bar or the trailing hard return, but you would have to record $obj[4].

Perl HTTP::Request and Server Down

I have a perl script that is supposed to use HTTP::Response to grab an XML file and then parse it. The script works great, except when it can't reach the server its trying to get the info from.
I know I have to have an error checking and if an error does exist, use a return to continue on with the loop, I have done with with NET::SNMP and SSH, but I can't seem to get it working for this scenario. I'm about to be pull my hair in frustration. Any help is greatly appreciated.
#! /usr/bin/perl
use LWP::UserAgent;
use HTTP::Request::Common;
use Net::SNMP;
use XML::Simple;
use HTTP::Status;
$ua = LWP::UserAgent->new;
if ( open ( FH, "DeviceList.txt" ) )
{
while ( defined ( my $line = <FH> ) )
{
$line =~ s/\s+$//;
$device = $line;
&checkcon;
}
close FH;
}
else
{
print "DeviceList.txt file not found\n";
}
#exit;
sub checkcon
{
my ($req, $error) = HTTP::Request->new(GET => 'https://'.$device.'/getxml?location=/HelloWorld');
$ua->ssl_opts(SSL_verify_mode => SSL_VERIFY_NONE);
$ua->timeout(10);
$req->authorization_basic('test', 'test');
$test = $ua->request($req)->content;
print $req;
if ($test =~ "parser error") {
print "No Workie\n";
return;
}
#if (!is_success ($req))
#{
#print "No Workie!";
#return;
#}
# create object
my $xml = new XML::Simple;
# read XML file
my $data = $xml->XMLin("$test");
print "Looping";
# access XML data
`echo "$device,$data->{Hello}{World}{content}" >> Test.txt`;
}
exit 0;

#INC hook unknown fatal error

Hey I'm writing a program that uses an #INC hook to decrypt the real perl source from blowfish. I'm having a quite annoying problem that doesn't show up using warnings or any of my standard tricks... Basically when I get to creating the new cipher object the loop skips to the next object in #INC without an error or anything.... I dont know what to do!
#!/usr/bin/perl -w
use strict;
use Crypt::CBC;
use File::Spec;
sub load_crypt {
my ($self, $filename) = #_;
print "Key?\n: ";
chomp(my $key = <STDIN>);
for my $prefix (#INC) {
my $buffer = undef;
my $cipher = Crypt::CBC->new( -key => $key, -cipher => 'Blowfish');
my $derp = undef;
$cipher ->start('decrypting');
open my $fh, '<', File::Spec->($prefix, "$filename.nc") or next;
while (read($fh,$buffer,1024)) {
$derp .= $cipher->crypt($buffer);
}
$derp .= $cipher->finish;
return ($fh, $derp);
}
}
BEGIN {
unshift #INC, \&load_crypt;
}
require 'gold.pl';
Also if I put the actual key in the initializing method it still fails
You've got a bunch of problems here. First of all, you're using File::Spec wrong. Second, you're returning a filehandle that's already at end of file, and a string that isn't a valid return value. (Also, I'd put the key prompt outside of the hook.)
#!/usr/bin/perl -w
use strict;
use Crypt::CBC;
use File::Spec;
# Only read the key once:
print "Key?\n: ";
chomp(my $key = <STDIN>);
sub load_crypt {
my ($self, $filename) = #_;
return unless $filename =~ /\.pl$/;
for my $prefix (#INC) {
next if ref $prefix;
#no autodie 'open'; # VERY IMPORTANT if you use autodie!
open(my $fh, '<:raw', File::Spec->catfile($prefix, "$filename.nc"))
or next;
my $buffer;
my $cipher = Crypt::CBC->new( -key => $key, -cipher => 'Blowfish');
my $derp;
$cipher->start('decrypting');
while (read($fh,$buffer,1024)) {
$derp .= $cipher->crypt($buffer);
}
$derp .= $cipher->finish;
# Subroutine writes 1 line of code into $_ and returns 1 (false at EOF):
return sub { $derp =~ /\G(.*\n?)/g and ($_ = $1, 1) };
}
return; # Didn't find the file; try next #INC entry
} # end load_crypt
# This doesn't need a BEGIN block, because we're only using the hook
# with require, and that's a runtime operation:
unshift #INC, \&load_crypt;
require 'gold.pl';