Accessing multiple <select>-ed parameters with Perl CGI - html

I am using the Perl CGI module. If I have HTML like this
<select multiple name="FILTER_SITE">
<option>1</option>
<option>2</option>
</select>
and submit my form I can get something like this in the URL:
[..] FILTER_SITE=1&FILTER_SITE=2
Perl's my $FILTER_SITE = $cgi->param('FILTER_SITE'); wil capture only the first instance.
How can I make use of both (in this case)? Hack it and parse the referrer myself and add them to an array is my first idea but it'd be a bit messy, then again I'm hardly versed in CGI.pm or Perl.
With Data::Dumper, interestingly
print "<pre>".Dumper($cgi->param('FILTER_SITE')) . "</pre>";
$VAR1 = '1';
$VAR2 = '2';

NOTE: Current documentation (as of 2020 May 29) says this method could cause a security vulnerability. Please check my answer below.
The param method supplies a single value in scalar context and (potentially) multiple values in list context. Read about it here.
So if you change your code to, for example
my #FILTER_SITE = $cgi->param('FILTER_SITE');
then the array will contain all selected values of the option.
If it suits your code better, you can also write
for my $FILTER_SITE ($cgi->param('FILTER_SITE')) {
:
}

I know this is an old post, but looks like few things changed since this question was answered. I want to post the latest info on this, especially because the accepted answer is now considered a security vulnerability. CGI.pm documentation says
{Warning - calling param() in list context can lead to vulnerabilities if you do not sanitise user input as it is possible to inject other param keys and values into your code. This is why the multi_param() method exists, to make it clear that a list is being returned, note that param() can still be called in list context and will return a list for back compatibility.}
It is recommended to use $cgi->multi_param method instead.

Example of parsing values
#!/usr/bin/perl
use Encode;
print "Content-Type: text/html; charset=UTF-8\n\n";
if($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $querystring, $ENV{'CONTENT_LENGTH'});
print "<h1>POST</h1>";
} else {
print "<h1>GET</h1>";
$type = "display_form";
$querystring = $ENV{'QUERY_STRING'};
}
print "<p>$querystring</p>";
if (length ($querystring) > 0){
#pairs = split(/&/, $querystring);
foreach $pair (#pairs){
($name, $value) = split(/=/, $pair);
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if (exists $in{$name}) {
$value = "$value,$in{$name}";
}
$in{$name} = $value;
}
}
foreach my $val (sort keys %in) {
print "<p>$val: $in{$val}</p>";
}

Related

Creating a comment box html form with perl processing script

I currently have a script named "test.pl" that does a variety of things and prints out HTML code to view on a webpage. One of the things I want it to do, is allow the user to type in a comment, and select which type of comment it is and the processing form of the comment box will append the comment into a file. I am not sure if I am doing this right because it doesn't seem to be working as I'm getting some errors.. here are the snippets of the code:
#!/usr/bin/perl
use warnings;
use CGI qw(:cgi-lib :standard); # Use CGI modules that let people read data passed from a form
#Initiate comment processing
&ReadParse(%in);
if ($in("comment") && $in("type") ! == "") {
$comment = $in("comment");
$type = $in("type");
WritetoFile($comment,$type);
}
sub WritetoFile {
my $input = shift;
my $type = shift;
my $file = "$type" . "_comment.txt";
open (my $fh, '>>', $file) or die "Could not open file '$file' $!";
print $fh "$input\n";
close $fh
}
The form I am using is this:
<FORM ACTION=test.pl METHOD=POST>
Comment:
<INPUT TYPE=TEXT NAME="comment" LENGTH=60>
<P>
Select Type
<SELECT NAME ="type">
<OPTION SELECTED> Animal
<OPTION> Fruit
<OPTION> Vegetable
<OPTION> Meat
<OPTION> Other
<INPUT TYPE=SUBMIT VALUE="Submit"></FORM
Any suggestions on how to make this work or even improve the process I am doing would be greatly appreciated!I would prefer to keep the processing script and the script that does the rest of my subs to be the same script (test.pl) unless this is something I have to keep separate
Your code is a bizarre mixture of old- and new-style Perl. You're using the cgi-lib compatibility layer in CGI.pm and calling its ReadParse() function using the (unnecessary since 1994) leading ampersand. On the other hand, you're using three-arg open() and lexical filehandles. I'd be interested to hear how you developed that style.
Your problem comes from your (mis-)handling of the %in hash. Your call to ReadParse() puts all of the CGI parameters into the hash, but you're using the wrong syntax to get the values out of the hash. Hash keys are looked up using braces ({ ... }), not parentheses (( ... )).
You also have some confusion over your boolean equality operators. != is used for numeric comparisons. You want ne for string comparisons.
You probably wanted something like:
ReadParse(%in);
if ($in{comment} ne "" and $in{type} ne "") {
$comment = $in{comment};
$type = $in{type};
WritetoFile($comment,$type);
}
Your $comment and $type variables are unnecessary as you can pass the hash lookups directly into your subroutine.
WritetoFile($in{comment}, $in{type});
Finally, as others have pointed out, learning CGI in 2014 is like learning to use a typewriter - it'll still work, but people will think you're rather old-fashioned. Look at CGI::Alternatives for some more modern approaches.

Perl: Accessing part of a JSON query

I have been writing part of a website I'm making, part of the stats page will display information about a websites Json response.
The address of the website is: http://steamcommunity.com/market/listings/440/Name%20Tag/render/?count=1&start=1&query=.
Here is a link to a parser so the code is easier to read http://json.parser.online.fr/.
The code I have written so far works but no matter what i try I cant get the information I need.
use JSON::XS;
use WWW::Mechanize;
use HTTP::Cookies;
use LWP::Simple;
use strict;
use warnings;
my $url = "http://steamcommunity.com/market/listings/440/Name%20Tag/render/?count=2&start=2";
my $json = get $url;
my $data = decode_json $json;
my $info = $data -> {listinginfo};
My problem is that i would like to access the price of the listing however when new listings are made available the reference for them changes. I have no idea how to deal with this and Google is not helping. Any help would be greatly appreciated, thanks in advance.
Seb Morris.
EDIT: Thanks for the replies, I have progressed my code and ended up with:
my $data = decode_json $json;
my #infoids = keys %{$data -> {listinginfo}};
foreach my $infoid (#infoids) {
my $price = $data -> {listinginfo}{$infoid}{converted_price};
print "$price" . "\n";
}
However I am getting the error: Use of uninitialized value $price in string at line 30. I dont understand why I am getting this error as I have declared the variable. Any help would be really appreciated.
If I understand, your problem is that the listinginfo object contains key(s) which change for each request, and you don't know to find out what the key is for the request you just made.
You can find the keys to a perl hash using the 'keys' function. So you can get all of the keys of the listinginfo hash like this:
my #infoids = keys %{$data -> {listinginfo}};
Note the need to use %{ } to de-reference listinfo, which is itself a hash reference.
There could be more than one info ID, although when I tested the web service you linked in your question it only ever returned one. If you are sure there will only ever be one, you can use:
my $price = $data -> {listinginfo}{$infoids[0]}{price};
Or, if there might be more than one, you can loop through them:
foreach my $infoid (#infoids) {
my $price = $data -> {listinginfo}{$infoids[0]}{price};
# Now do something with price
}

Problems parsing Reddit's JSON

I'm working on a perl script that parses reddit's JSON using the JSON module.
However I do have the problem of being very new to both perl and json.
I managed to parse the front page and subreddits successfully, but the comments have a different structure and I can't figure out how to access the data I need.
Here's the code that successfully finds the "data" hash for the front page and subreddits:
foreach my $children(#{$json_text->{"data"}->{"children"}}) #For values of children.
{
my $data = $children->{"data"}; #accessing each data hash.
my %phsh = (); #my hash to collect and print.
$phsh{author} = $data->{"author"};#Here I get the "author" value from "data"
*Etc....
This successfully gets what I need from http://www.reddit.com/.json
But when I go to the json of a comment, this one for example, it has a different format and I can't figure out how to parse it. If I try the same thing as before my parser crashes, saying it is not a HASH reference.
So my question is: How do access the "children" in the second JSON? I need to get both the data for the Post and the data for the comments. Can anybody help?
Thanks in advance!
(I know it may be obvious, but I'm running on very little sleep XD)
You need to either look at the JSON data or dump the decoded data to see what form it takes. The comment data, for example is an array at the top level.
Here is some code that prints the body field of all top-level comments. Note that a comment may have an array of replies in its replies field, and each reply may also have replies in turn.
Depending on what you want to do you may need to check whether a reference is to an array or a hash by checking the value returned by the ref operator.
use strict;
use warnings;
binmode STDOUT, ':utf8';
use JSON;
use LWP;
use Data::Dump;
my $ua = LWP::UserAgent->new;
my $resp = $ua->get('http://www.reddit.com/r/funny/comments/wx3n5/caption_win.json');
die $resp->status_line unless $resp->is_success;
my $json = $resp->decoded_content;
my $data = decode_json($json);
die "Error: $data->{error}" if ref $data eq 'HASH' and exists $data->{error};
dd $data->[1]{data}{children}[0];
print "\n\n";
my $children = $data->[1]{data}{children};
print scalar #$children, " comments:\n\n";
for my $child (#$children) {
print $child->{data}{body}, "\n";
}

How to parse between <div class ="foo"> and </div> easily in Perl

I want to parse a Website into a Perl data structure.
First I load the page with
use LWP::Simple;
my $html = get("http://f.oo");
Now I know two ways to deal with it.
First are the regular expressions and secound the modules.
I started with reading about HTML::Parser and found some examples.
But I'm not that sure about by Perl knowledge.
My code example goes on
my #links;
my $p = HTML::Parser->new();
$p->handler(start => \&start_handler,"tagname,attr,self");
$p->parse($html);
foreach my $link(#links){
print "Linktext: ",$link->[1],"\tURL: ",$link->[0],"\n";
}
sub start_handler{
return if(shift ne 'a');
my ($class) = shift->{href};
my $self = shift;
my $text;
$self->handler(text => sub{$text = shift;},"dtext");
$self->handler(end => sub{push(#links,[$class,$text]) if(shift eq 'a')},"tagname");
}
I don't understand why there is two times a shift. The secound should be the self pointer. But the first makes me think that the self reference is allready shiftet, used as a Hash and the Value for href is stored in $class. Could someone Explain this line (my ($class) = shift->{href};)?
Beside this lack, I do not want to parse all the URLs, I want to put all the code between <div class ="foo"> and </div> into a string, where lots of code is between, specially other <div></div> tags. So I or a module has to find the right end.
After that I planed to scan the string again, to find special classes, like <h1>,<h2>, <p class ="foo2"></p>, etc.
I hope this informations helps you to give me some usefull advices, and please have in mind that first of all I want an easy understanding way, which has not to be a great performance in the first level!
HTML::Parser is more of a tokenizer than a parser. It leaves a lot of hard work up to you. Have you considered using HTML::TreeBuilder (which uses HTML::Parser) or XML::LibXML (a great library which has support for HTML)?
Use HTML::TokeParser::Simple.
Untested code based on your description:
#!/usr/bin/env perl
use strict; use warnings;
use HTML::TokeParser::Simple;
my $p = HTML::TokeParser::Simple->new(url => 'http://example.com/example.html');
my $level;
while (my $tag = $p->get_tag('div')) {
my $class = $tag->get_attr('class');
next unless defined($class) and $class eq 'foo';
$level += 1;
while (my $token = $p->get_token) {
$level += 1 if $token->is_start_tag('div');
$level -= 1 if $token->is_end_tag('div');
print $token->as_is;
unless ($level) {
last;
}
}
}
No need to get so complicated. You can retrieve and find elements in the DOM using CSS selectors with Mojo::UserAgent:
say Mojo::UserAgent->new->get('http://f.oo')->res->dom->find('div.foo');
or, loop through the elements found:
say $_ for Mojo::UserAgent->new->get('http://f.oo')->res->dom
->find('div.foo')->each;
or, loop using a callback:
Mojo::UserAgent->new->get('http://f.oo')->res->dom->find('div.foo')->each(sub {
my ($count, $el) = #_;
say "$count: $el";
});
According to the docs, the handler's signature is (\%attr, \#attr_seq, $text). There are three shifts, one for each argument.
my ($class) = shift->{href};
is equivalent to:
my $class;
my %attr_seq;
my $attr_seq_ref;
$attr_seq_ref = shift;
%attr_seq = %$attr_seq_ref;
$class = $attr_seq{'href'};

Is there a neat way to serialize a Perl hash into an HTML querystring

I have a perl script using CGI.
The browser calls it with some parameters.
I want to take those parameters, modify some of them and then send back a redirect with a new querystring representing the modified parameters.
I know that I could do this, like this:
my $cgi = CGI->new()
my %vars = $cgi->Vars
$vars{'modify_me'} .=' more stuff';
my $serialized = join '&', map {$_.'='.$cgi->escapeHTML($vars{$_})} keys %vars;
However, this just feels like it might be missing something. In addition, it doesn't do anything to handle multivalued parameters. Who knows what else it fails to do.
So, is there a module out there that just deals with this problem? I'm not interested in reinventing a wheel that a more talented wright wrought. Right?
The URI module is your friend. It has a query_form method that takes a hash, hashref or arrayref of parameters and generates a query string from it.
It will URL Encode your data for you (and note that you do want it URL Encoded and not HTML Encoded).
So you might have something like:
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use URI;
my $q = CGI->new;
my #data = map {
my $name = $_;
my #values = $q->param($name);
my $value;
if (scalar #values == 1) {
($value) = #values;
} else {
$value = \#values;
}
if ($name eq "foo") {
$value = "replaced";
}
($name, $value);
} $q->param;
my $uri = URI->new('http://example.com/myAlternative.cgi');
$uri->query_form(\#data);
print $q->redirect(
-uri=> $uri,
-status => 301
);
Have you looked at Data::URIEncode or URI::QueryParam?
Turns out, there's a way to achieve my specific need using just the CGI module. However, the other answers cover a wider need, to serialize an arbitrary hash.
If you want to modify incoming parameters and then create a link to the same script with modified parameters you can do this:
my $params = $cgi->Vars;
$ Modify the values in hash that $params references
my $new_url = $cgi->self_url(); # URL with modified parameters