Query-Param/lib/Query/Param.pm
package Query::Param;
# A lightweight form and query string variable parser...
use strict;
use warnings;
use URI::Escape qw(uri_unescape);
use JSON;
use Data::Dumper;
our $VERSION = '1.0.0';
########################################################################
sub new {
########################################################################
my ( $class, $query_string, $content_type ) = @_;
$content_type //= 'application/x-www-form-urlencoded';
my $self = bless {
_raw => {}, # raw key => [raw_value, ...]
_decoded => {}, # decoded key => scalar or arrayref
_type => $content_type,
}, $class;
$query_string //= q{};
if ( $content_type eq 'application/json' ) {
$self->{_raw} = $query_string;
$self->{_decoded} = decode_json($query_string);
}
elsif ( $content_type =~ /multipart\/form\-data/xsm ) {
$self->{_raw} = $query_string;
$self->{_decoded} = $self->parse_multipart_form_data( $content_type, $query_string );
}
else {
while ( $query_string =~ /([^&=]+)=?([^&]*)/xsmg ) {
my ( $key, $val ) = ( $1, $2 );
push @{ $self->{_raw}{$key} }, $val;
}
}
return $self;
}
########################################################################
sub new_from_request {
########################################################################
my ($class) = @_;
my ( $content_type, $content_length, $method ) = @ENV{qw(CONTENT_TYPE CONTENT_LENGTH REQUEST_METHOD)};
die "ERROR: no request method found\n"
if !$ENV{REQUEST_METHOD};
return $class->new( $ENV{QUERY_STRING} )
if $ENV{REQUEST_METHOD} eq 'GET';
return
if $ENV{REQUEST_METHOD} ne 'POST';
my $fh = *STDIN;
if ( !$content_length ) {
$content_length = 4096;
}
my $content = q{};
my $buffer;
while ( my $bytes_read = read $fh, $buffer, $content_length ) {
$content .= $buffer;
}
return $class->new( $content, $content_type )
if $content_type !~ /multipart\/form\-data/xsm;
return $class->_new_from_multipart_form_data( $content_type, $content );
}
########################################################################
sub _new_from_multipart_form_data {
########################################################################
my ( $class, $content_type, $content ) = @_;
my $params = $class->parse_multipart_form_data( $content_type, $content );
my $self = bless {
_raw => {},
_decoded => {},
_type => $content_type,
}, $class;
foreach ( keys %{$params} ) {
$self->{_raw}->{$_} = $self->{_decoded}->{$_} = $params->{$_};
}
return $self;
}
########################################################################
sub Vars {
########################################################################
my ($self) = @_;
my %vars;
for my $key ( $self->keys ) {
my $val = $self->get($key);
$vars{$key} = ref $val eq 'ARRAY' ? $val->[-1] : $val;
}
return \%vars;
}
########################################################################
sub parse_multipart_form_data {
########################################################################
my ( $self, $content_type, $post_data ) = @_;
my %params;
my ($boundary) = $content_type =~ /boundary=([^;]+)/xsm;
while ( $post_data =~ /Content\-Disposition:\sform\-data;\sname="([^"]+)"\r?\n\r?\n(.*?)\r?\n--$boundary/sg ) {
my ( $name, $value ) = ( $1, $2 );
$value =~ s/\s+$//xsm;
if ( exists $params{$name} ) {
if ( !ref $params{$name} ) {
$params{$name} = [ $params{$name}, $value ];
}
else {
push @{ $params{$name} }, $value;
}
}
else {
$params{$name} = $value;
}
}
return \%params;
}
########################################################################
sub param {
########################################################################
my ( $self, $key ) = @_;
return $self->keys if !defined $key;
return $self->get($key);
}
########################################################################
sub params {
########################################################################
my ($self) = @_;
my %out;
for my $key ( $self->keys ) {
my $val = $self->get($key);
$out{$key} = $val;
}
return \%out;
}
########################################################################
sub get {
########################################################################
my ( $self, $key ) = @_;
return $self->{_decoded}{$key}
if exists $self->{_decoded}{$key};
return
if !exists $self->{_raw}{$key};
my @values = map { uri_unescape( $_ =~ tr/+/ /r ) } @{ $self->{_raw}{$key} };
$self->{_decoded}{$key} = @values > 1 ? \@values : $values[0];
return $self->{_decoded}{$key};
}
########################################################################
sub set {
########################################################################
my ( $self, $key, $val ) = @_;
delete $self->{_raw}{$key};
$self->{_decoded}{$key} = $val;
return;
}
########################################################################
sub has {
########################################################################
my ( $self, $key ) = @_;
return exists $self->{_raw}{$key} || exists $self->{_decoded}{$key};
}
########################################################################
sub keys {
########################################################################
my ($self) = @_;
return
if $self->{_type} ne 'application/x-www-form-urlencoded';
my %seen;
return grep { !$seen{$_}++ } ( keys %{ $self->{_raw} }, keys %{ $self->{_decoded} } );
}
########################################################################
sub to_string {
########################################################################
my ($self) = @_;
return $self->{_raw}
if $self->{_type} ne 'application/x-www-form-urlencoded';
my @pairs;
for my $key ( $self->keys ) {
if ( exists $self->{_raw}{$key} ) {
push @pairs, map {"$key=$_"} @{ $self->{_raw}{$key} };
}
elsif ( exists $self->{_decoded}{$key} ) {
my @vals
= ref $self->{_decoded}{$key} eq 'ARRAY'
? @{ $self->{_decoded}{$key} }
: ( $self->{_decoded}{$key} );
for my $v (@vals) {
my $escaped_key = _form_escape($key);
my $escaped_val = _form_escape($v);
push @pairs, "$escaped_key=$escaped_val";
}
}
}
return join q{&}, @pairs;
}
########################################################################
sub _form_escape {
########################################################################
my ($s) = @_;
$s =~ s/([^\w\-\.\~ ])/sprintf("%%%02X", ord($1))/eg;
$s =~ s/ /+/g;
return $s;
}
########################################################################
sub pairs {
########################################################################
my ($self) = @_;
my @kv;
for my $key ( $self->keys ) {
my $val = $self->get($key);
if ( ref $val eq 'ARRAY' ) {
push @kv, map { ( $key => $_ ) } @$val;
}
else {
push @kv, ( $key => $val );
}
}
return @kv;
}
1;
__END__
=pod
=head1 NAME
Query::Param - Lightweight object interface for parsing and creating
query strings and form parameters
=head1 SYNOPSIS
use Query::Param;
my $args = Query::Param->new("foo=1&bar=2&bar=3&empty=&encoded=%25+%2B");
# Object-style access
my $foo = $args->get("foo"); # scalar: "1"
my $bar = $args->get("bar"); # arrayref: ["2", "3"]
my $encoded = $args->get("encoded"); # scalar: "% +"
# CGI-style access
my $foo_again = $args->param("foo"); # same as get("foo")
my @keys = $args->param; # all parameter names
# Get all decoded parameters
my $all = $args->params; # { foo => "1", bar => ["2", "3"], ... }
# Legacy-compatible flat hash
my $vars = $args->Vars; # { foo => "1", bar => "3", ... }
# Check for presence
if ( $args->has("bar") ) { ... }
# Update or add parameters
$args->set("foo", "updated");
$args->set("new", "value");
# Get query string back
my $str = $args->to_string; # bar=2&bar=3&empty=&encoded=%25%20%2B&foo=updated&new=value
=head1 DESCRIPTION
This module parses an application/x-www-form-urlencoded encode query
string and provides an object-oriented interface for accessing the
query parameters.
Multiple values for a parameter are stored as an array
internally. When accessed via C<get>, a scalar is returned for single
values, and an array reference for multiple values.
There are many modules that parse query strings, so why re-invent this
wheel?
=over 5
=item Simplicity
=over 10
=item * Provides exactly what's needed to parse, access, mutate, and
emit query strings - nothing more.
=item * Easy to learn: get, set, has, keys, to_string, pairs.
=item * No dependency on object systems, Moo, Moose, or Catalyst internals.
=back
=item Lazy Decoding and Isomorphic Round-Tripping
=over 10
=item * Only decodes values on demand, saving effort when you only need a subset.
=item * Preserves semantics on C<to_string()> - values go in and come
back out encoded correctly, even if original encoding format differed
(+ vs %20).
=item * Isomorphic: C<to_string()> and C<new()> are inverse operations, as
long as values are treated semantically.
=back
=item No Magic or Global Side Effects
=over 10
=item * Doesn't touch global vars (%ENV, @ARGV, etc.).
=item * Doesn't guess whether it's parsing a GET or POST - you pass it
a string explicitly.
=item * Can be used safely inside other frameworks or handlers without
surprises.
=back
=item Consistent, Predictable Behavior
=over 10
=item * Every key always returns a single value or an arrayref -
consistent rules.
=item * C<set()> replaces; multiple values only come from the original
string or if assigned intentionally.
=back
=item Tiny Footprint
=over 10
=item * Just C<URI::Escape>, no other non-core deps.
=item * Lightweight enough for CLI tools, embedded apps, or mod_perl
handlers.
=back
=item CPAN Alternatives Can Be Overkill
=over 10
=item * CGI is bloated, global, and tied to the web environment.
=item * C<CGI::Tiny> is good, but intentionally avoids mutation - no
C<set()>.
=item * C<Plack::Request> and C<HTTP::Request::Params> require full request
objects and more dependencies.
=item * Hash::MultiValue works but lacks parsing logic - and doesn't
round-trip.
=back
=back
=head1 CGI COMPATIBILITY
This module supports key methods from L<CGI> for interoperability:
=over 4
=item *
C<param()> - scalar or arrayref return, regardless of context
=item *
C<Vars()> - returns a hashref of flattened scalar values (last-value wins)
=item *
C<get()> - equivalent to C<param($key)>
=item *
C<params()> - returns a hashref retaining all values (including
arrayrefs)
=item *
C<to_string()> - round-trips encoded input with full fidelity
=back
B<Note>: Unlike CGI.pm, C<param()> and C<get()> do not change behavior
depending on context. They always return a scalar (if one value) or an
arrayref (if multiple values). This avoids subtle bugs and improves
predictability.
=head1 THREAD SAFETY
This module does not use any global state. It is safe to use in
threaded, embedded, and reentrant environments such as mod_perl,
Plack, or inside event loops.
=head1 CONSTRUCTOR
=head2 new
my $args = Query::Param->new($query_string);
Parses the provided query string and returns a new
C<Query::Param> object.
=head2 new_from_request
my $args = Query::Param->new_from_request;
Parses query strings, application/x-www-form-urlencoded, or
multipart/form-data from HTTP requests. Assumes environment variables
CONTENT_TYPE, CONTENT_LENGTH, REQUEST_METHOD have been set.
I<NOTE: Reminder - this is a lightweight parser! It does not support
file downloads when data is passed as multipart/form-data.>
If the content type is application/json the parser will decode the
payload. You can retrieve the raw payload using the C<to_string>
method or individual keys of the payload using C<get()>.
=head1 METHODS AND SUBROUTINES
=head2 get
$value = $args->get($key);
Returns the value associated with C<$key>. If there are multiple
values, an array reference is returned. If only one value exists, the
scalar is returned. Returns undef if the key does not exist.
=head2 has
if ($args->has("foo")) { ... }
Returns true if the key exists in the query string. This method
accesses the tied hash internally.
=head2 keys
Returns the keys or names of the query string parameters.
=head2 pairs
Returns a list of array references that contain key/value pairs in the
same vein as C<List::Util::pairs>.
=head2 param
my @names = $q->param;
my $value = $q->param('key');
Returns the list of all parameter names when called with no arguments.
When called with a key, returns the value for that parameter. If the
parameter occurred multiple times in the original query string,
returns an array reference of values. Otherwise, returns a scalar
value.
This method is provided for compatibility with C<CGI->param>, but
unlike CGI.pm, it always returns a scalar or array reference
regardless of context. Internally, it delegates to C<get()>.
=head2 params
my $hashref = $q->params;
Returns a hash reference containing all decoded parameters.
Each key corresponds to a parameter name. The value is either a scalar
(if the parameter had a single value) or an array reference (if the
parameter occurred multiple times).
This method is intended as a replacement for C<CGI->Vars> and provides
a consistent view of all parameters for inspection, testing, or
export.
=head2 set
Sets a query string parameter.
=head2 to_string
Creates an query string from the parsed or set parameters.
=head2 Vars
my $vars = $q->Vars;
Returns a hash reference where each key maps to a scalar value.
If a parameter occurred multiple times in the query string, only the
last value is preserved - consistent with C<CGI->Vars>, but
potentially lossy.
This method is provided for compatibility with legacy code that
expects flattened query strings. Use C<params()> instead to retain
full value lists and avoid silent data loss.
=head1 DEPENDENCIES
=over 5
=item *
L<URI::Escape>
=back
=head1 AUTHOR
Rob Lauer - <rlauer6@comcast.net>
=head1 LICENSE
This module is released under the same terms as Perl itself.
=cut