This is an automated email from the git hooks/post-receive script.
abe pushed a commit to annotated tag 0.50
in repository libcgi-test-perl.
commit 35b9f95a4d418fda76a34ad6cf59621d1ae6168c
Author: Alex Tokarev <noh...@nohuhu.org>
Date: Wed Apr 9 22:54:35 2014 -0700
Small fixes and enhancements
---
lib/CGI/Test.pm | 58 +++++++++++++++++++++++++++++++++++++++++------
lib/CGI/Test/Input.pm | 45 +++++++++++++++++++++++++++++++-----
lib/CGI/Test/Input/URL.pm | 11 ++++-----
lib/CGI/Test/Page.pm | 6 +++++
lib/CGI/Test/Page/Real.pm | 6 -----
5 files changed, 101 insertions(+), 25 deletions(-)
diff --git a/lib/CGI/Test.pm b/lib/CGI/Test.pm
index e8a570e..0505638 100644
--- a/lib/CGI/Test.pm
+++ b/lib/CGI/Test.pm
@@ -1,14 +1,13 @@
-################################################################
-# $Id$
#################################################################
# Copyright (c) 2001, Raphael Manfredi
-# Copyright (c) 2011-2012, Alexander Tokarev
+# Copyright (c) 2011-2014, Alex Tokarev
#
# You may redistribute only under the terms of the Artistic License,
# as specified in the README file that comes with the distribution.
#
package CGI::Test;
+
use strict;
use warnings;
no warnings 'uninitialized';
@@ -19,11 +18,13 @@ use URI;
use File::Temp qw(mkstemp);
use File::Spec;
use File::Basename;
+use Cwd qw(abs_path);
+
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = '0.3';
+$VERSION = '0.31';
@ISA = qw(Exporter);
@EXPORT = qw(ok);
@@ -58,6 +59,9 @@ sub new
my ($server, $path) = $this->split_uri($uri);
$this->{host_port} = $server;
+ $this->{scheme} = $uri->scheme;
+ $this->{host} = $uri->host;
+ $this->{port} = $uri->port;
$this->{base_path} = $path;
$this->{cgi_dir} = $dir;
$this->{tmp_dir} = $tmp;
@@ -105,7 +109,7 @@ sub new
#
######################################################################
sub make
-{ #
+{
my $class = shift;
return $class->new(@_);
}
@@ -122,6 +126,33 @@ sub host_port
}
######################################################################
+sub base_uri
+{
+ my $this = shift;
+
+ my $scheme = $this->{scheme};
+ my $host = $this->{host};
+ my $port = $this->{port};
+ my $base = $this->{base_path};
+
+ return $scheme . '://' . $host . ':' . $port . $base;
+}
+
+######################################################################
+sub host
+{
+ my $this = shift;
+ return $this->{host};
+}
+
+######################################################################
+sub port
+{
+ my $this = shift;
+ return $this->{port};
+}
+
+######################################################################
sub base_path
{
my $this = shift;
@@ -417,6 +448,14 @@ sub _cgi_request
unlink $fname or warn "can't unlink $fname: $!";
return $error->new(RC_INTERNAL_SERVER_ERROR, $this);
}
+
+ #
+ # Return error page if we got 5xx status
+ #
+
+ if ( my ($status) = $header->{Status} =~ /^(5\d\d)/ ) {
+ return $error->new($status, $this);
+ }
#
# Store headers for later retrieval
@@ -558,6 +597,13 @@ sub _run_cgi
{
delete $ENV{QUERY_STRING};
}
+
+ #
+ # This is a way of letting Perl test scripts to run under
+ # the same Perl version that CGI::Test is running with
+ #
+
+ $ENV{PERL} = $^X;
#
# Make sure the script sees the same @INC as we do currently.
@@ -569,8 +615,6 @@ sub _run_cgi
# any relative path to the current working directory.
#
- use Cwd qw(abs_path);
-
$ENV{PERL5LIB} = join(':', map {-e $_ ? abs_path($_) : $_} @INC);
#
diff --git a/lib/CGI/Test/Input.pm b/lib/CGI/Test/Input.pm
index 7e75f20..d0b3f3b 100644
--- a/lib/CGI/Test/Input.pm
+++ b/lib/CGI/Test/Input.pm
@@ -1,8 +1,3 @@
-package CGI::Test::Input;
-use strict;
-####################################################################
-# $Id: Input.pm 411 2011-09-26 11:19:30Z noh...@nohuhu.org $
-# $Name: cgi-test_0-104_t1 $
#####################################################################
#
# Copyright (c) 2001, Raphael Manfredi
@@ -16,6 +11,12 @@ use strict;
# parameters that can be encoded differently.
#
+package CGI::Test::Input;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
use Carp;
############################################################
@@ -87,6 +88,23 @@ sub data
############################################################
#
+# ->set_raw_data
+#
+# Set raw POST data for this input object
+#
+############################################################
+sub set_raw_data {
+ my ($this, $data) = @_;
+
+ $this->{data} = $data;
+ $this->{length} = do { use bytes; CORE::length $data };
+ $this->{stale} = 0;
+
+ return $this;
+}
+
+############################################################
+#
# ->add_widget
#
# Add new input widget.
@@ -201,6 +219,14 @@ sub add_file_now
return;
}
+sub set_mime_type {
+ my ($this, $type) = @_;
+
+ $this->{mime_type} = $type;
+
+ return $this;
+}
+
#
# Interface to be implemented by heirs
#
@@ -208,8 +234,15 @@ sub add_file_now
############################################################
sub mime_type
{
- confess "deferred";
+ my ($this) = @_;
+
+ my $type = $this->{mime_type};
+
+ confess "deferred" unless $type;
+
+ return $type;
}
+
############################################################
sub _build_data
{
diff --git a/lib/CGI/Test/Input/URL.pm b/lib/CGI/Test/Input/URL.pm
index 6f03c1c..65871e1 100644
--- a/lib/CGI/Test/Input/URL.pm
+++ b/lib/CGI/Test/Input/URL.pm
@@ -25,8 +25,12 @@ use base qw(CGI::Test::Input);
#
sub new
{
- my $this = bless {}, shift;
+ my $this = bless {
+ mime_type => 'application/x-www-form-urlencoded'
+ }, shift;
+
$this->_init;
+
return $this;
}
@@ -41,11 +45,6 @@ sub make
# Defined interface
#
-sub mime_type
-{
- return "application/x-www-form-urlencoded";
-}
-
#
# ->_build_data
#
diff --git a/lib/CGI/Test/Page.pm b/lib/CGI/Test/Page.pm
index 7ec7730..5b25b8e 100644
--- a/lib/CGI/Test/Page.pm
+++ b/lib/CGI/Test/Page.pm
@@ -34,6 +34,12 @@ sub new
# Common attribute access
#
+sub raw_content {
+ my ($self) = @_;
+
+ return $self->{raw_content};
+}
+
######################################################################
sub content_type
{
diff --git a/lib/CGI/Test/Page/Real.pm b/lib/CGI/Test/Page/Real.pm
index c8239e7..05a9613 100644
--- a/lib/CGI/Test/Page/Real.pm
+++ b/lib/CGI/Test/Page/Real.pm
@@ -34,12 +34,6 @@ sub new
# Attribute access
#
-sub raw_content
-{
- my $this = shift;
- return $this->{raw_content};
-}
-
sub uri
{
my $this = shift;
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libcgi-test-perl.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
