CGI-Info

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

0.32	Thu Jul 19 15:38:22 BST 2012
	Removed some duplicate tests
	Fixed t/script.t on Windows

0.31	Wed Jul 18 15:57:04 BST 2012
	Fixed script_name and script_path when not running as a CGI script
	Added some tests

0.30	Fri Jul 13 09:35:07 BST 2012
	Fixed handling of POST content-type application/x-www-form-urlencoded
	Fixed t/params.t on Windows
	Removed unused variables

0.29	Fri Jun 15 11:01:18 EDT 2012
	Fixed t/carp.t on systems without Test::Carp

0.28	Tue Jun 12 15:30:00 EDT 2012
	Fixed boundary detection

0.27	Mon Jun 11 23:28:16 EDT 2012

bin/testjson.pl  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use autodie qw(:all);
use LWP::UserAgent;

my $ua = LWP::UserAgent->new();

my $req = HTTP::Request->new(POST => 'https://localhost/cgi-bin/info.pl');
$req->header('content-type' => 'application/json');
$req->content('{ "first": "Nigel", "last": "Horne" }');

my $resp = $ua->request($req);
if($resp->is_success()) {
	print "Reply:\n\t", $resp->decoded_content, "\n";
} else {
	print STDERR $resp->code(), "\n", $resp->message(), "\n";
}

t/edge_cases.t  view on Meta::CPAN

    my $body                   = 'fcgi=1&req=second';
    $ENV{CONTENT_LENGTH}       = length($body);
    $CGI::Info::stdin_data     = $body;

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die when stdin_data pre-populated');
    ok(!defined($p) || defined($p->{fcgi}), 'pre-populated stdin_data used');
};

subtest 'POST: content-type with charset parameter' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE}    = 'CGI/1.1';
    $ENV{REQUEST_METHOD}       = 'POST';
    $ENV{CONTENT_TYPE}         = 'application/x-www-form-urlencoded; charset=UTF-8';
    my $body                   = 'msg=hello';
    $ENV{CONTENT_LENGTH}       = length($body);
    $CGI::Info::stdin_data     = $body;

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on content-type with charset');
    ok(!defined($p) || defined($p->{msg}), 'params parsed with charset in content-type');
};

subtest 'POST: multipart without upload_dir returns undef gracefully' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';
    $ENV{REQUEST_METHOD}    = 'POST';
    $ENV{CONTENT_TYPE}      = 'multipart/form-data; boundary=----boundary123';
    $ENV{CONTENT_LENGTH}    = 100;
    $ENV{REMOTE_ADDR}       = '1.2.3.4';

t/edge_cases.t  view on Meta::CPAN

    $ENV{QUERY_STRING}      = 'x=1';
    $ENV{REMOTE_ADDR}       = '1.2.3.4';

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on multipart GET');
    # Source says: multipart/form-data not supported for GET
    is($info->status(), 501, 'multipart GET returns 501 Not Implemented');
};

subtest 'POST: unsupported content-type handled without dying' => sub {
    reset_env();
    $ENV{GATEWAY_INTERFACE}    = 'CGI/1.1';
    $ENV{REQUEST_METHOD}       = 'POST';
    $ENV{CONTENT_TYPE}         = 'application/octet-stream';
    my $body                   = "\x00\x01\x02\x03binary";
    $ENV{CONTENT_LENGTH}       = length($body);
    $CGI::Info::stdin_data     = $body;

    my $info = CGI::Info->new();
    my $p    = eval { $info->params() };
    ok(!$@, 'does not die on unsupported content-type POST');
};

# ============================================================
# 8. Script path edge cases
# ============================================================

subtest 'script_path: SCRIPT_FILENAME with spaces in path' => sub {
    reset_env();
    $ENV{SCRIPT_FILENAME} = '/var/www/my scripts/app.cgi';