I am passing about seven fields from an HTML form to a Perl CGI script.
Some of the values are not getting recovered using a variety of methods (POST, GET, CGI.pm or raw code).
That is, this code
my $variable = $q->param('varname');
resulted in about half the variables either being empty or undef, although the latter may have been a coincidental situation from the HTML page, which uses JavaScript.
I wrote a test page on the same platform with a simple form going to a simple CGI, and also got results where onpy half the parameters were represented. The remaining values were empty after the assignment.
I tried both POST and GET. I also tried GET and printed the query string after attempting to write out the variables; everything was in the query string as it should be. I'm using CGI.pm for this.
I tried to see if the variable values had been parsed successfully by CGI.pm by creating a version of my test CGI code which just displays the
parameters on the HTML page. The result is a bunch of odd strings like
CGI=HASH(0x02033)->param('qSetName')
suggesting that assignment of these values results in a cast of some kind, so I was unable to tell if they actually 'contained' the proper values.
My real form uses POST, so I just commented out the CGI.pm code and iterated over STDIN and it had all the name-value pairs as it should have.
Everything I've done points to CGI.pm, so I will try reinstalling it.
Here's the test code that missed half the vars:
#!/usr/bin/perl;
use CGI;
my $q = new CGI;
my $subject = $q->param('qSetSubject');
my $topic = $q->param('qTopicName');
my $userName = $q->param('uName');
my $accessLevel = $q->param('accessLevel');
my $category = $q->param('qSetCat');
my $type = $q->param('qSetType');
print "Content-Type: text/html\n\n";
print "<html>\n<head><title>Test CGI<\/title><\/head>\n<body>\n\n<h2>Here Are The Variables:<\/h2>\n";
print "<list>\n";
print "<li>\$q->param(\'qSetSubject\') = $subject\n";
print "<li>\$q->param(\'qTopicName\') = $topic\n";
print "<li>\$q->param(\'uName\') = $userName\n";
print "<li>\$q->param(\'qSetCat\') = $accessLevel\n";
print "<li>\$q->param(\'qSetType\') = $category\n";
print "<li>\$q->param(\'accessLevel\') = $type\n";
print "<\/list>\n";
The results of ikegami's code are here:
qSetSubject: precalculus
qTopicName: polar coordinates
uName: kjtruitt
accessLevel: private
category: mathematics
type: grid-in
My attempt to incorporate ikegami's code
%NAMES = (
seqNum => 'seqNum',
uName => 'userName',
qSetName => 'setName',
accessLevel => 'accessLevel',
qSetCat => 'category',
qTopicName => 'topic',
qSetType => 'type',
qSetSubject => 'subject',
);
use CGI;
my $cgi = CGI->new();
print "Content-Type:text/html\n\n";
#print($cgi->header('text/plain'));
for my $name ($cgi->param) {
for ($cgi->param($name)) {
#print("$name: ".( defined($_) ? $_ : '[undef]' )."\n");
print "$NAMES{$name} = $_\n";
${$NAMES{$name}} = $_;
}
}
print "<html>\n<head><title>Test CGI<\/title><\/head>\n<body>\n\n<h2>Here Are The Variables:<\/h2>\n";
print "Hello World!\n";
print "<list>\n";
print "<li>\$q->param(\'qSetSubject\') = $subject\n";
print "<li>\$q->param(\'qTopicName\') = $topic\n";
print "<li>\$q->param(\'uName\') = $userName\n";
print "<li>\$q->param(\'qSetCat\') = $accessLevel\n";
print "<li>\$q->param(\'qSetType\') = $category\n";
print "<li>\$q->param(\'accessLevel\') = $type\n";
print "<\/list>\n";
You are receiving
qSetSubject: precalculus
qTopicName: polar coordinates
uName: kjtruitt
accessLevel: private
category: mathematics
type: grid-in
so
my $category = $q->param('qSetCat');
my $type = $q->param('qSetType');
should be replaced with
my $category = $q->param('category');
my $type = $q->param('type');
Related
I'm trying to read a gz file line by line in Perl6, however, I'm getting blocked:
How to read gz file line by line in Perl6 however, this method, reading everything into :out uses far too much RAM to be usable except on very small files.
I don't understand how to use Perl6's Compress::Zlib to get everything line by line, although I opened an issue on their github https://github.com/retupmoca/P6-Compress-Zlib/issues/17
I'm trying Perl5's Compress::Zlib to translate this code, which works perfectly in Perl5:
use Compress::Zlib;
my $file = "data.txt.gz";
my $gz = gzopen($file, "rb") or die "Error reading $file: $gzerrno";
while ($gz->gzreadline($_) > 0) {
# Process the line read in $_
}
die "Error reading $file: $gzerrno" if $gzerrno != Z_STREAM_END ;
$gz->gzclose() ;
to something like this using Inline::Perl5 in Perl6:
use Compress::Zlib:from<Perl5>;
my $file = 'chrMT.1.vcf.gz';
my $gz = Compress::Zlib::new(gzopen($file, 'r');
while ($gz.gzreadline($_) > 0) {
print $_;
}
$gz.gzclose();
but I can't see how to translate this :(
I'm confused by Lib::Archive example https://github.com/frithnanth/perl6-Archive-Libarchive/blob/master/examples/readfile.p6 I don't see how I can get something like item 3 here
There should be something like
for $file.IO.lines(gz) -> $line { or something like that in Perl6, if it exists, I can't find it.
How can I read a large file line by line without reading everything into RAM in Perl6?
Update Now tested, which revealed an error, now fixed.
Solution #2
use Compress::Zlib;
my $file = "data.txt.gz" ;
my $handle = try open $file or die "Error reading $file: $!" ;
my $zwrap = zwrap($handle, :gzip) ;
for $zwrap.lines {
.print
}
CATCH { default { die "Error reading $file: $_" } }
$handle.close ;
I've tested this with a small gzipped text file.
I don't know much about gzip etc. but figured this out based on:
Knowing P6;
Reading Compress::Zlib's README and choosing the zwrap routine;
Looking at the module's source code, in particular the signature of the zwrap routine our sub zwrap ($thing, :$zlib, :$deflate, :$gzip);
And trial and error, mainly to guess that I needed to pass the :gzip adverb.
Please comment on whether my code works for you. I'm guessing the main thing is whether it's fast enough for the large files you have.
A failed attempt at solution #5
With solution #2 working I would have expected to be able to write just:
use Compress::Zlib ;
.print for "data.txt.gz".&zwrap(:gzip).lines ;
But that fails with:
No such method 'eof' for invocant of type 'IO::Path'
This is presumably because this module was written before the reorganization of the IO classes.
That led me to #MattOates' IO::Handle like object with .lines ? issue. I note no response and I saw no related repo at https://github.com/MattOates?tab=repositories.
I am focusing on the Inline::Perl5 solution that you tried.
For the call to $gz.gzreadline($_): it seems like gzreadline tries to return the line read from the zip file by modifying its input argument $_ (treated as an output argument, but it is not a true Perl 5 reference variable[1]), but the modified value is not returned to the Perl 6 script.
Here is a possoble workaround:
Create a wrapper module in the curent directory, e.g. ./MyZlibWrapper.pm:
package MyZlibWrapper;
use strict;
use warnings;
use Compress::Zlib ();
use Exporter qw(import);
our #EXPORT = qw(gzopen);
our $VERSION = 0.01;
sub gzopen {
my ( $fn, $mode ) = #_;
my $gz = Compress::Zlib::gzopen( $fn, $mode );
my $self = {gz => $gz};
return bless $self, __PACKAGE__;
}
sub gzreadline {
my ( $self ) = #_;
my $line = "";
my $res = $self->{gz}->gzreadline($line);
return [$res, $line];
}
sub gzclose {
my ( $self ) = #_;
$self->{gz}->gzclose();
}
1;
Then use Inline::Perl5 on this wrapper module instead of Compress::Zlib. For example ./p.p6:
use v6;
use lib:from<Perl5> '.';
use MyZlibWrapper:from<Perl5>;
my $file = 'data.txt.gz';
my $mode = 'rb';
my $gz = gzopen($file, $mode);
loop {
my ($res, $line) = $gz.gzreadline();
last if $res == 0;
print $line;
}
$gz.gzclose();
[1]
In Perl 5 you can modify an input argument that is not a reference, and the change will be reflected in the caller. This is done by modifying entries in the special #_ array variable. For example: sub quote { $_[0] = "'$_[0]'" } $str = "Hello"; quote($str) will quote $str even if $str is not passed by reference.
I used the below code to search documents (which has a particular keyword in content) from Apache Solr
my $solrgetapi = "http://$address:$port/solr/OppsBot/select?q=content:";
my $solrgeturl = $solrgetapi.'"'.$keyword.'"';
my $browser = LWP::UserAgent->new;
my $req = HTTP::Request->new( GET => $solrgeturl );
$req->authorization_basic( "$username", "$pass" );
my $page = $browser->request( $req );
print $page->decoded_content;
The result I get is as follows:
{
"responseHeader":{
"status":0,
"QTime":2,
"params":{
"q":"content:\"ABC\""}},
"response":{"numFound":0,"start":0,"docs":[]
}}
I want to extract the numFound value to a variable.
I came across some solutions in SolrJ like these
queryResponse.getResults().getNumFound();
But I couldn't find in Perl.
I tried with these below codes also. But I couldn't get these to work. Please help.
$numFound = $page->decoded_content->{response}->{numFound};
print $page->{numFound}
You neglected to transform the JSON text into a data structure.
use JSON::MaybeXS qw(decode_json);
say decode_json($page->decoded_content)->{response}{numFound}
# 0
I'm working with a legacy system and need to get data out of an Oracle database using Perl. Perl is one of the languages I don't spend much time in, so I'd like to be able to run a simple SQL query and pass the data to another system via JSON.
It seems that JSON, DBI, and DBD are available on this system. I'd like to accomplish this without making too many changes or updates to the system, if possible. I believe the JSON library is at version 5.12.2
I found DBI-Link library on Github and I believe this file is almost exactly what I need:
#!/usr/bin/perl -l
use strict;
use warnings;
$|++;
use JSON;
use DBI;
use DBD::Oracle qw(:ora_types);
my $dbh = DBI->connect(
'dbi:Oracle:host=localhost;sid=xe',
'hr',
'foobar',
{
AutoCommit => 1,
RaiseError => 1,
}
);
my #methods = qw(table_info column_info primary_key_info);
foreach my $method (#methods) {
if ( $dbh->can($method) ) {
print "Handle has method $method. w00t!"
}
else {
$dbh->disconnect;
print "Sadly, handle does not have method $method. D'oh!";
exit;
}
}
my $sth=$dbh->table_info('%', '%', '%', 'TABLE');
while(my $table = $sth->fetchrow_hashref) {
my $t;
$t->{'Table Name'} = $table->{TABLE_NAME};
$t->{'Column Info'} = $dbh->column_info(
undef,
$table->{TABLE_SCHEM},
$table->{TABLE_NAME},
'%'
)->fetchall_arrayref({});
$t->{'Primary Key Info'} = $dbh->primary_key_info(
undef,
$table->{TABLE_SCHEM},
$table->{TABLE_NAME}
)->fetchall_arrayref({});
print map {"$_: ". json_encode($t->{$_})} grep{ defined $t->{$_} } 'Table Name', 'Column Info', 'Primary Key Info';
print;
}
$sth->finish;
$dbh->disconnect;
The Error
I've installed the dependencies but when I run it I am getting:
Undefined subroutine &main::json_encode called at ./oracle.t line 47.
I searched the rest of the source in that repository and don't see any my json_encode definition, so maybe I have a version of the JSON library that is too old is my possible idea, but it seems unlikely that the json_encode method would have changed names.
The Next Steps
After I get json_encode to work I know I will need to execute a custom query and then save the data, it would be something like this:
$sth = $dbh->prepare("select * from records where pending = 1");
$sth->execute;
my $records = new HASH;
while($r = $sth->fetchrow_hashref)
{
$records << $r
}
my $json = json_encode($records)
However I'm unsure how to build the $records object for encoding so any help would be appreciated. I have searched stackoverflow, google, and github for perl examples of oracle to json and only had luck with the code from that DBI-Link repo.
According to the documentation for the JSON module, the function you want is encode_json and not json_encode.
I'd probably store the records in an array of hashes; something like this:
my #records;
while (my $r = $sth->fetchrow_hashref)
{
push(#records, $r);
}
If you know what field you want a hash-of-hashes keyed on:
my %records;
while (my $r = $sth->fetchrow_hashref)
{
$records{ $r->{key_field} } = $r;
}
For debugging purposes I'd like to Access the lexical scope of different subroutines with a specific Attribute set. That works fine. I get a Problem when the first variable stores a string, then I get a empty string. I do something like this:
$pad = $cv->PADLIST; # $cv is the coderef to the sub
#scatchpad = $pad->ARRAY; # getting the scratchpad
#varnames = $scratchpad[0]->ARRAY; # getting the variablenames
#varcontents = $scratchpad[1]->ARRAY; # getting the Content from the vars
for (0 .. $#varnames) {
eval {
my $name = $varnames[$_]->PV;
my $content;
# following line matches numbers, works so far
$content = $varcontent[$_]->IVX if (scalar($varcontent[$_]) =~ /PVIV=/);
# should match strings, but does give me undef
$content = B::perlstring($varcontent[$_]->PV) if (scalar($varcontent[$_]) =~ /PV=/);
print "DEBUGGER> Local variable: ", $name, " = ", $content, "\n";
}; # there are Special vars that throw a error, but i don't care about them
}
Like I said in the comment the eval is to prevent the Errors from the B::Special objects in the scratchpad.
Output:
Local variable: $test = 42
Local variable: $text = 0
The first Output is okay, the second should Output "TEXT" instead of 0.
What am I doing wrong?
EDIT: With a little bit of coding I got all values of the variables , but not stored in the same indexes of #varnames and #varcontents. So now is the question how (in which order) the values are stored in #varcontents.
use strict;
use warnings;
use B;
sub testsub {
my $testvar1 = 42;
my $testvar2 = 21;
my $testvar3 = "testval3";
print "printtest1";
my $testvar4 = "testval4";
print "printtest2";
return "returnval";
}
no warnings "uninitialized";
my $coderef = \&testsub;
my $cv = B::svref_2object ( $coderef );
my $pad = $cv->PADLIST; # get scratchpad object
my #scratchpad = $pad->ARRAY;
my #varnames = $scratchpad[0]->ARRAY; # get varnames out of scratchpad
my #varcontents = $scratchpad[1]->ARRAY; # get content array out of scratchpad
my #vars; # array to store variable names adn "undef" for special objects (print-values, return-values, etc.)
for (0 .. $#varnames) {
eval { push #vars, $varnames[$_]->PV; };
if ($#) { push #vars, "undef"; }
}
my #cont; # array to store the content of the variables and special objects
for (0 .. $#varcontents) {
eval { push #cont, $varcontents[$_]->IV; };
eval { push #cont, $varcontents[$_]->PV; };
}
print $vars[$_], "\t\t\t", $cont[$_], "\n" for (0 .. $#cont);
EDIT2: Added runnable script to demonstrate the issue: Variablenames and variablevalues are not stored in the same index of the two Arrays (#varnames and #varcontents).
I'd like to write small scripts which feature incremental search (find-as-you-type) on the command line.
Use case: I have my mobile phone connected via USB, Using gammu --sendsms TEXT I can write text messages. I have the phonebook as CSV, and want to search-as-i-type on that.
What's the easiest/best way to do it? It might be in bash/zsh/Perl/Python or any other scripting language.
Edit:
Solution: Modifying Term::Complete did what I want. See below for the answer.
I get the impression GNU Readline supports this kind of thing. Though, I have not used it myself. Here is a C++ example of custom auto complete, which could easily be done in C too. There is also a Python API for readline.
This StackOverflow question gives examples in Python, one of which is ...
import readline
def completer(text, state):
options = [x in addrs where x.startswith(text)]
if state < options.length:
return options[state]
else
return None
readline.set_completer(completer)
this article on Bash autocompletion may help. This article also gives examples of programming bash's auto complete feature.
Following Aiden Bell's hint, I tried Readline in Perl.
Solution 1 using Term::Complete (also used by CPAN, I think):
use Term::Complete;
my $F;
open($F,"<","bin/phonebook.csv");
my #terms = <$F>; chomp(#terms);
close($F);
my $input;
while (!defined $input) {
$input = Complete("Enter a name or number: ",#terms);
my ($name,$number) = split(/\t/,$input);
print("Sending SMS to $name ($number).\n");
system("sudo gammu --sendsms TEXT $number");
}
Press \ to complete, press Ctrl-D to see all possibilities.
Solution 2: Ctrl-D is one keystroke to much, so using standard Term::Readline allows completion and the display off possible completions using only \.
use Term::ReadLine;
my $F;
open($F,"<","bin/phonebook.csv");
my #terms = <$F>; chomp(#terms);
close($F);
my $term = new Term::ReadLine;
$term->Attribs->{completion_function} = sub { return #terms; };
my $prompt = "Enter name or number >> ";
my $OUT = $term->OUT || \*STDOUT;
while ( defined (my $input = $term->readline($prompt)) ) {
my ($name,$number) = split(/\t/,$input);
print("Sending SMS to $name ($number).\n");
system("sudo gammu --sendsms TEXT $number");
}
This solution still needs a for completion.
Edit: Final Solution
Modifying Term::Complete (http://search.cpan.org/~jesse/perl-5.12.0/lib/Term/Complete.pm) does give me on the fly completion.
Source code: http://search.cpan.org/CPAN/authors/id/J/JE/JESSE/perl-5.12.0.tar.gz
Solution number 1 works with this modification. I will put the whole sample online somewhere else if this can be used by somebody
Modifications of Completion.pm (just reusing it's code for Control-D and \ for each character):
170c172,189
my $redo=0;
#match = grep(/^\Q$return/, #cmp_lst);
unless ($#match < 0) {
$l = length($test = shift(#match));
foreach $cmp (#match) {
until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
$l--;
}
}
print("\a");
print($test = substr($test, $r, $l - $r));
$redo = $l - $r == 0;
if ($redo) { print(join("\r\n", '', grep(/^\Q$return/, #cmp_lst)), "\r\n"); }
$r = length($return .= $test);
}
if ($redo) { redo LOOP; } else { last CASE; }