AUTOLOAD parameters

Changes

@@ -1,6 +1,8 @@
 Revision history for CGI-Info
 
 0.60
+	Handle JSON POST data
+	AUTOLOAD parameters
 	Added the cookie() method
 	Added Appveyor support to CI test on Windows
 	Added tests that the framework to allow CGI scripts to be tested from
@@ -30,7 +32,7 @@ Revision history for CGI-Info
 	Don't add an argument if it's already there
 	--search-engine and --mobile didn't work
 	Less harsh SQL injection tests, there were too many false positives
-	Tablets are no longer considered mobile phones
+	Tabletsare no longer considered mobile phones
 	params now returns undef if no arguments were given
 	Pretend Facebookexternal (used to prefetch pages for
 		display) is a search_engine.

MANIFEST

@@ -25,6 +25,7 @@ t/is_mobile.t
 t/is_robot.t
 t/is_search.t
 t/is_tablet.t
+t/json.t
 t/kwalitee.t
 t/manifest.t
 t/metrics.t

Makefile.PL

@@ -41,6 +41,7 @@ WriteMakefile(
 	'File::Basename' => 0,
 	'String::Clean::XSS' => 0,
 	'Log::Any' => 0,
+	'JSON::Parse' => 0,
 	# 'String::EscapeCage' => 0.02,
 	'Class::Autouse' => 0,
     },

lib/CGI/Info.pm

@@ -8,6 +8,7 @@ use Class::Autouse qw{Carp File::Spec};
 use Socket;	# For AF_INET
 use 5.006_001;
 use Log::Any qw($log);
+use JSON::Parse;
 
 use namespace::clean;
 
@@ -602,6 +603,23 @@ sub params {
 			$self->{_paramref} = \%FORM;
 
 			return \%FORM;
+		} elsif($content_type =~ /application\/json/i) {
+			my $buffer;
+			if($stdin_data) {
+				$buffer = $stdin_data;
+			} else {
+				if(read(STDIN, $buffer, $content_length) != $content_length) {
+					$self->_warn({
+						warning => 'read failed: something else may have read STDIN'
+					});
+				}
+				$stdin_data = $buffer;
+				JSON::Parse::assert_valid_json($buffer);
+				my $paramref = JSON::Parse::parse_json($buffer);
+				foreach my $key(keys(%{$paramref})) {
+					push @pairs, "$key=" . $paramref->{$key};
+				}
+			}
 		} else {
 			my $buffer;
 			if($stdin_data) {
@@ -1549,6 +1567,19 @@ sub reset {
 	$stdin_data = undef;
 }
 
+sub AUTOLOAD {
+	our $AUTOLOAD;
+	my $param = $AUTOLOAD;
+
+	$param =~ s/.*:://;
+
+	return if($param eq 'DESTROY');
+
+	my $self = shift;
+
+	return $self->param($param);
+}
+
 =head1 AUTHOR
 
 Nigel Horne, C<< <njh at bandsman.co.uk> >>

t/json.t

@@ -0,0 +1,65 @@
+#!perl -wT
+
+use strict;
+use warnings;
+use Test::Most tests => 5;
+use Test::NoWarnings;
+
+eval 'use autodie qw(:all)';	# Test for open/close failures
+
+BEGIN {
+	use_ok('CGI::Info');
+}
+
+JSON: {
+	my $json = '{ "first": "Nigel", "last": "Horne" }';
+
+	$ENV{'GATEWAY_INTERFACE'} = 'CGI/1.1';
+	$ENV{'REQUEST_METHOD'} = 'POST';
+	$ENV{'CONTENT_TYPE'} = 'application/json; charset=utf-8';
+	$ENV{'CONTENT_LENGTH'} = length($json);
+
+	my $allowed = { 'first' => undef, 'last' => undef };
+
+	open (my $fin, '<', \$json);
+	local *STDIN = $fin;
+
+	my $i = new_ok('CGI::Info' => [ logger => MyLogger->new() ]);
+	ok(defined($i->params(allow => $allowed)));
+	ok($i->first() eq 'Nigel');
+}
+
+package MyLogger;
+
+sub new {
+	my ($proto, %args) = @_;
+
+	my $class = ref($proto) || $proto;
+
+	return bless { }, $class;
+}
+
+sub warn {
+	my $self = shift;
+	my $message = shift;
+
+	::diag($message);
+}
+
+sub trace {
+	my $self = shift;
+	my $message = shift;
+
+	if($ENV{'TEST_VERBOSE'}) {
+		::diag($message);
+	}
+}
+
+sub debug {
+	my $self = shift;
+	my $message = shift;
+
+	if($ENV{'TEST_VERBOSE'}) {
+		::diag($message);
+	}
+}