r34288 - in /trunk/libhttp-request-ascgi-perl: Changes LICENSE MANIFEST META.yml Makefile.PL README debian/changelog debian/compat debian/control debian/copyright debian/rules dist.ini lib/HTTP/Request/AsCGI.pm t/02unescape.t t/05env.t

eloy at users.alioth.debian.org eloy at users.alioth.debian.org
Tue Apr 28 21:36:50 UTC 2009


Author: eloy
Date: Tue Apr 28 21:36:45 2009
New Revision: 34288

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34288
Log:
  * New upstream release
  * debian/rules: converte to new schema
  * debian/control: Standards-Version update to 3.8.1
  * update package to debhelper 7, use debian/rules from debhelper 7


Added:
    trunk/libhttp-request-ascgi-perl/LICENSE
      - copied unchanged from r34287, branches/upstream/libhttp-request-ascgi-perl/current/LICENSE
    trunk/libhttp-request-ascgi-perl/dist.ini
      - copied unchanged from r34287, branches/upstream/libhttp-request-ascgi-perl/current/dist.ini
    trunk/libhttp-request-ascgi-perl/t/02unescape.t
      - copied unchanged from r34287, branches/upstream/libhttp-request-ascgi-perl/current/t/02unescape.t
Modified:
    trunk/libhttp-request-ascgi-perl/Changes
    trunk/libhttp-request-ascgi-perl/MANIFEST
    trunk/libhttp-request-ascgi-perl/META.yml
    trunk/libhttp-request-ascgi-perl/Makefile.PL
    trunk/libhttp-request-ascgi-perl/README
    trunk/libhttp-request-ascgi-perl/debian/changelog
    trunk/libhttp-request-ascgi-perl/debian/compat
    trunk/libhttp-request-ascgi-perl/debian/control
    trunk/libhttp-request-ascgi-perl/debian/copyright
    trunk/libhttp-request-ascgi-perl/debian/rules
    trunk/libhttp-request-ascgi-perl/lib/HTTP/Request/AsCGI.pm
    trunk/libhttp-request-ascgi-perl/t/05env.t

Modified: trunk/libhttp-request-ascgi-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/Changes?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/Changes (original)
+++ trunk/libhttp-request-ascgi-perl/Changes Tue Apr 28 21:36:45 2009
@@ -1,20 +1,40 @@
 This file documents the revision history for Perl extension HTTP::Request::AsCGI.
 
-0.5  2006-01-20 00:00:00 2005
+0.9 2009-04-27
+    - unescape PATH_INFO more safely
+
+0.8 2009-04-27
+    - revert PATH_INFO change, Catalyst tests were failing
+
+0.7 2009-04-26
+    - PATH_INFO is now uri_unescaped
+
+0.6 2009-04-26
+    - Fix long-standing 'enviroment' typo
+    - Switch to Dist::Zilla
+
+0.5_03 2009-04-26
+    - RT#18075: Play more nicely with Perl 5.6's open(). (hdp)
+
+0.5_02 2009-04-26
+    - Avoid mixing buffered and unbuffered IO and flush STDIN after writing
+      request content to it. (hdp)
+
+0.5  2006-01-20
     - Fixed bug where content was overridden on 500 responses.
 
-0.4  2006-01-19 00:00:00 2005
+0.4  2006-01-19
     - Fixed #15999 return a 500 response when message is empty, reported by Chris Dolan <cdolan at cpan.org>
     - Fixed Status header bug
     - Bumped HTTP::Response requirement to 1.53 and drop our own message parsing.
 
-0.3  2006-01-06 00:00:00 2005
+0.3  2006-01-06
     - Silence uninitialized warnings when restoring %ENV
     - Fixed dup and restore of STDIN.
 
-0.2  2005-10-31 00:55:00 2005
+0.2  2005-10-31
     - Added test for response.
 
-0.1  2005-10-21 00:00:00 2005
+0.1  2005-10-21
     - First release.
 

Modified: trunk/libhttp-request-ascgi-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/MANIFEST?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/MANIFEST (original)
+++ trunk/libhttp-request-ascgi-perl/MANIFEST Tue Apr 28 21:36:45 2009
@@ -1,14 +1,17 @@
 Changes
+LICENSE
+MANIFEST
+META.yml
+Makefile.PL
+README
+dist.ini
 examples/daemon.pl
 examples/synopsis.pl
 lib/HTTP/Request/AsCGI.pm
-Makefile.PL
-MANIFEST			This list of files
-META.yml
-README
 t/01use.t
+t/02unescape.t
 t/04io.t
 t/05env.t
 t/06response.t
 t/07forking.t
-t/08error.t
+t/08error.t

Modified: trunk/libhttp-request-ascgi-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/META.yml?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/META.yml (original)
+++ trunk/libhttp-request-ascgi-perl/META.yml Tue Apr 28 21:36:45 2009
@@ -1,16 +1,17 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         HTTP-Request-AsCGI
-version:      0.5
-version_from: lib/HTTP/Request/AsCGI.pm
-installdirs:  site
+---
+abstract: Set up a CGI environment from an HTTP::Request
+author:
+- Christian Hansen <ch at ngmedia.com>
+- Hans Dieter Pearcey <hdp at cpan.org>
+generated_by: Dist::Zilla::Plugin::MetaYaml version 1.007
+license: perl
+name: HTTP-Request-AsCGI
 requires:
-    Carp:                          0
-    Class::Accessor:               0
-    HTTP::Request:                 0
-    HTTP::Response:                1.53
-    IO::File:                      0
-    Test::More:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+  Carp: '0'
+  Class::Accessor: '0'
+  HTTP::Request: '0'
+  HTTP::Response: '1.53'
+  IO::File: '0'
+  Test::More: '0'
+  URI::Escape: '0'
+version: '0.9'

Modified: trunk/libhttp-request-ascgi-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/Makefile.PL?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/Makefile.PL (original)
+++ trunk/libhttp-request-ascgi-perl/Makefile.PL Tue Apr 28 21:36:45 2009
@@ -1,16 +1,24 @@
-#!perl
+
+use strict;
+use warnings;
 
 use ExtUtils::MakeMaker;
 
 WriteMakefile(
-    NAME         => 'HTTP::Request::AsCGI',
-    VERSION_FROM => 'lib/HTTP/Request/AsCGI.pm',
-    PREREQ_PM    => {
-        Carp             => 0,
-        Class::Accessor  => 0,        
-        HTTP::Request    => 0,
-        HTTP::Response   => 1.53,
-        IO::File         => 0,
-        Test::More       => 0
-    }
+  DISTNAME  => 'HTTP-Request-AsCGI',
+  NAME      => 'HTTP::Request::AsCGI',
+  AUTHOR    => 'Christian\ Hansen\ \<ch\@ngmedia\.com\>\,\ Hans\ Dieter\ Pearcey\ \<hdp\@cpan\.org\>',
+  ABSTRACT  => 'Set up a CGI environment from an HTTP::Request',
+  VERSION   => '0.9',
+  EXE_FILES => [ qw() ],
+  (eval { ExtUtils::MakeMaker->VERSION(6.21) } ? (LICENSE => 'perl') : ()),
+  PREREQ_PM    => {
+    "Test::More" => '0',
+    "IO::File" => '0',
+    "HTTP::Response" => '1.53',
+    "URI::Escape" => '0',
+    "Class::Accessor" => '0',
+    "HTTP::Request" => '0',
+    "Carp" => '0',
+  },
 );

Modified: trunk/libhttp-request-ascgi-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/README?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/README (original)
+++ trunk/libhttp-request-ascgi-perl/README Tue Apr 28 21:36:45 2009
@@ -1,86 +1,12 @@
-NAME
-    HTTP::Request::AsCGI - Setup a CGI enviroment from a HTTP::Request
 
-SYNOPSIS
-        use CGI;
-        use HTTP::Request;
-        use HTTP::Request::AsCGI;
-    
-        my $request = HTTP::Request->new( GET => 'http://www.host.com/' );
-        my $stdout;
-    
-        {
-            my $c = HTTP::Request::AsCGI->new($request)->setup;
-            my $q = CGI->new;
-        
-            print $q->header,
-                  $q->start_html('Hello World'),
-                  $q->h1('Hello World'),
-                  $q->end_html;
-        
-            $stdout = $c->stdout;
-        
-            # enviroment and descriptors will automatically be restored 
-            # when $c is destructed.
-        }
-    
-        while ( my $line = $stdout->getline ) {
-            print $line;
-        }
-    
-DESCRIPTION
-    Provides a convinient way of setting up an CGI enviroment from a
-    HTTP::Request.
 
-METHODS
-    new ( $request [, key => value ] )
-        Contructor, first argument must be a instance of HTTP::Request
-        followed by optional pairs of environment key and value.
+This archive contains the distribution HTTP-Request-AsCGI, version
+0.9:
 
-    enviroment
-        Returns a hashref containing the environment that will be used in
-        setup. Changing the hashref after setup has been called will have no
-        effect.
+  Set up a CGI environment from an HTTP::Request
 
-    setup
-        Setups the environment and descriptors.
+This software is copyright (c) 2009 by Christian Hansen <ch at ngmedia.com>.
 
-    restore
-        Restores the enviroment and descriptors. Can only be called after
-        setup.
+This is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
 
-    request
-        Returns the request given to constructor.
-
-    response
-        Returns a HTTP::Response. Can only be called after restore.
-
-    stdin
-        Accessor for handle that will be used for STDIN, must be a real
-        seekable handle with an file descriptor. Defaults to a tempoary
-        IO::File instance.
-
-    stdout
-        Accessor for handle that will be used for STDOUT, must be a real
-        seekable handle with an file descriptor. Defaults to a tempoary
-        IO::File instance.
-
-    stderr
-        Accessor for handle that will be used for STDERR, must be a real
-        seekable handle with an file descriptor.
-
-SEE ALSO
-    examples directory in this distribution.
-    WWW::Mechanize::CGI
-    Test::WWW::Mechanize::CGI
-
-THANKS TO
-    Thomas L. Shinnick for his valuable win32 testing.
-
-AUTHOR
-    Christian Hansen, "ch at ngmedia.com"
-
-LICENSE
-    This library is free software. You can redistribute it and/or modify it
-    under the same terms as perl itself.
-

Modified: trunk/libhttp-request-ascgi-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/debian/changelog?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/debian/changelog (original)
+++ trunk/libhttp-request-ascgi-perl/debian/changelog Tue Apr 28 21:36:45 2009
@@ -1,10 +1,17 @@
-libhttp-request-ascgi-perl (0.5-3) UNRELEASED; urgency=low
+libhttp-request-ascgi-perl (0.9-1) UNRELEASED; urgency=low
 
+  [ Krzysztof Krzyżaniak (eloy) ]
+  * New upstream release
+  * debian/rules: converte to new schema
+  * debian/control: Standards-Version update to 3.8.1
+  * update package to debhelper 7, use debian/rules from debhelper 7
+
+  [ gregor herrmann ]
   * debian/watch: use dist-based URL.
   * debian/control: Changed: Switched Vcs-Browser field to ViewSVN
     (source stanza).
-
- -- gregor herrmann <gregoa at debian.org>  Wed, 06 Aug 2008 18:23:36 -0300
+  
+ -- Krzysztof Krzyżaniak (eloy) <eloy at debian.org>  Tue, 28 Apr 2009 23:25:26 +0200
 
 libhttp-request-ascgi-perl (0.5-2) unstable; urgency=low
 

Modified: trunk/libhttp-request-ascgi-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/debian/compat?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/debian/compat (original)
+++ trunk/libhttp-request-ascgi-perl/debian/compat Tue Apr 28 21:36:45 2009
@@ -1,2 +1,2 @@
-6
+7
 

Modified: trunk/libhttp-request-ascgi-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/debian/control?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/debian/control (original)
+++ trunk/libhttp-request-ascgi-perl/debian/control Tue Apr 28 21:36:45 2009
@@ -1,11 +1,11 @@
 Source: libhttp-request-ascgi-perl
 Section: perl
 Priority: optional
-Build-Depends: debhelper (>= 6)
+Build-Depends: debhelper (>= 7)
 Build-Depends-Indep: perl (>= 5.8.0-7), libwww-perl (>= 5.805), libclass-accessor-perl
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
 Uploaders: Krzysztof Krzyżaniak (eloy) <eloy at debian.org>,
-Standards-Version: 3.7.3
+Standards-Version: 3.8.1
 Homepage: http://search.cpan.org/dist/HTTP-Request-AsCGI/
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libhttp-request-ascgi-perl/
 Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/

Modified: trunk/libhttp-request-ascgi-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/debian/copyright?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/debian/copyright (original)
+++ trunk/libhttp-request-ascgi-perl/debian/copyright Tue Apr 28 21:36:45 2009
@@ -1,24 +1,24 @@
-This is the debian package for the HTTP-Request-AsCGI module.
-It was created by Krzysztof Krzyzaniak (eloy) <eloy at debian.org>.
+Format-Specification:
+    http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
+Upstream-Authors: Christian Hansen <ch at ngmedia.com>
+    Hans Dieter Pearcey <hdp at cpan.org>
+Packaged-By: Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
+Upstream-Name: HTTP::Request::AsCGI
+Original-Source-Location: http://search.cpan.org/dist/HTTP-Request-AsCGI/
+Original-Source-Command: uscan --force-download
+Original-Source-Depends: devscripts
 
-It was downloaded from:
-http://search.cpan.org/~mramberg/HTTP-Request-AsCGI-0.2/
+Files: *
+Copyright: © 2005-2009 by Christian Hansen
+License: GPL-1+ | Artistic
+ This program is free software, you can redistribute it and/or modify it under
+ the same terms as Perl itself.
 
-The upstream author is: Christian Hansen, ch at ngmedia.com.
+Files: debian/*
+Copyright: © 2006-2009 Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
+	   © 2008-2009 gregor herrmann <gregoa at debian.org>
 
-Copyright 2005-2006, Christian Hansen
-
-This program is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-Perl is distributed under licenses:
-
-    a) the GNU General Public License as published by the Free Software
-       Foundation; either version 1, or (at your option) any later
-       version, or
-  
-    b) the "Artistic License" which comes with Perl.
-  
-    On Debian GNU/Linux systems, the complete text of the GNU General
-    Public License can be found in /usr/share/common-licenses/GPL' and
-    the Artistic Licence in /usr/share/common-licenses/Artistic'.
+Perl is distributed under your choice of the GNU General Public License or
+the Artistic License.  On Debian GNU/Linux systems, the complete text of the
+GNU General Public License can be found in `/usr/share/common-licenses/GPL'
+and the Artistic Licence in `/usr/share/common-licenses/Artistic'.

Modified: trunk/libhttp-request-ascgi-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/debian/rules?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/debian/rules (original)
+++ trunk/libhttp-request-ascgi-perl/debian/rules Tue Apr 28 21:36:45 2009
@@ -1,70 +1,23 @@
 #!/usr/bin/make -f
-# This debian/rules file is provided as a template for normal perl
-# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
-# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
-# be used freely wherever it is useful.
-
-# Uncomment this to turn on verbose mode.
-#export DH_VERBOSE=1
-
-# If set to a true value then MakeMaker's prompt function will
-# always return the default without waiting for user input.
-export PERL_MM_USE_DEFAULT=1
-
-PACKAGE=$(shell dh_listpackages)
-
-ifndef PERL
-PERL = /usr/bin/perl
-endif
-
-TMP     =$(CURDIR)/debian/$(PACKAGE)
 
 build: build-stamp
 build-stamp:
-	dh_testdir
-	$(PERL) Makefile.PL INSTALLDIRS=vendor
-	$(MAKE) OPTIMIZE="-Wall -O2 -g"
-
-	touch build-stamp
+	dh build
+	touch $@
 
 clean:
-	dh_testdir
-	dh_testroot
-	[ ! -f Makefile ] || $(MAKE) realclean
-	dh_clean build-stamp install-stamp
+	dh $@
 
-install: build install-stamp
-install-stamp:
-	dh_testdir
-	dh_testroot
-	dh_clean -k
-	$(MAKE) test
-	$(MAKE) install DESTDIR=$(TMP) PREFIX=/usr
-	[ ! -d $(TMP)/usr/lib/perl5 ] || rmdir --ignore-fail-on-non-empty --parents $(TMP)/usr/lib/perl5
-
-	touch install-stamp
+install: install-stamp
+install-stamp: build-stamp
+	dh install
+	touch $@
 
 binary-arch:
-# We have nothing to do by default.
 
-binary-indep: build install
-	dh_testdir
-	dh_testroot
-	dh_installexamples examples/*.pl
-	dh_installdocs README
-	dh_installchangelogs Changes
-	dh_perl
-	dh_link
-	dh_strip
-	dh_compress
-	dh_fixperms
-	dh_installdeb
-	dh_gencontrol
-	dh_md5sums
-	dh_builddeb
+binary-indep: install
+	dh $@
 
-source diff:                                                                  
-	@echo >&2 'source and diff are obsolete - use dpkg-source -b'; false
+binary: binary-arch binary-indep
 
-binary: binary-indep binary-arch
-.PHONY: build clean binary-indep binary-arch binary
+.PHONY: binary binary-arch binary-indep install clean build

Modified: trunk/libhttp-request-ascgi-perl/lib/HTTP/Request/AsCGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/lib/HTTP/Request/AsCGI.pm?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/lib/HTTP/Request/AsCGI.pm (original)
+++ trunk/libhttp-request-ascgi-perl/lib/HTTP/Request/AsCGI.pm Tue Apr 28 21:36:45 2009
@@ -1,5 +1,7 @@
 package HTTP::Request::AsCGI;
-
+our $VERSION = '0.9';
+
+# ABSTRACT: Set up a CGI environment from an HTTP::Request
 use strict;
 use warnings;
 use bytes;
@@ -9,10 +11,21 @@
 use HTTP::Response;
 use IO::Handle;
 use IO::File;
-
-__PACKAGE__->mk_accessors(qw[ enviroment request stdin stdout stderr ]);
-
-our $VERSION = 0.5;
+use URI ();
+use URI::Escape ();
+
+__PACKAGE__->mk_accessors(qw[ environment request stdin stdout stderr ]);
+
+# old typo
+
+*enviroment = \&environment;
+
+my %reserved = map { sprintf('%02x', ord($_)) => 1 } split //, $URI::reserved;
+sub _uri_safe_unescape {
+    my ($s) = @_;
+    $s =~ s/%([a-fA-F0-9]{2})/$reserved{lc($1)} ? "%$1" : chr(hex($1))/ge;
+    $s;
+}
 
 sub new {
     my $class   = shift;
@@ -36,11 +49,11 @@
 
     $uri = $uri->canonical;
 
-    my $enviroment = {
+    my $environment = {
         GATEWAY_INTERFACE => 'CGI/1.1',
         HTTP_HOST         => $uri->host_port,
         HTTPS             => ( $uri->scheme eq 'https' ) ? 'ON' : 'OFF',  # not in RFC 3875
-        PATH_INFO         => $uri->path,
+        PATH_INFO         => _uri_safe_unescape($uri->path),
         QUERY_STRING      => $uri->query || '',
         SCRIPT_NAME       => '/',
         SERVER_NAME       => $uri->host,
@@ -61,17 +74,17 @@
         $key =~ tr/-/_/;
         $key =~ s/^HTTP_// if $field =~ /^Content-(Length|Type)$/;
 
-        unless ( exists $enviroment->{$key} ) {
-            $enviroment->{$key} = $request->headers->header($field);
+        unless ( exists $environment->{$key} ) {
+            $environment->{$key} = $request->headers->header($field);
         }
     }
 
-    unless ( $enviroment->{SCRIPT_NAME} eq '/' && $enviroment->{PATH_INFO} ) {
-        $enviroment->{PATH_INFO} =~ s/^\Q$enviroment->{SCRIPT_NAME}\E/\//;
-        $enviroment->{PATH_INFO} =~ s/^\/+/\//;
-    }
-
-    $self->enviroment($enviroment);
+    unless ( $environment->{SCRIPT_NAME} eq '/' && $environment->{PATH_INFO} ) {
+        $environment->{PATH_INFO} =~ s/^\Q$environment->{SCRIPT_NAME}\E/\//;
+        $environment->{PATH_INFO} =~ s/^\/+/\//;
+    }
+
+    $self->environment($environment);
 
     return $self;
 }
@@ -79,33 +92,36 @@
 sub setup {
     my $self = shift;
 
-    $self->{restore}->{enviroment} = {%ENV};
+    $self->{restore}->{environment} = {%ENV};
 
     binmode( $self->stdin );
 
     if ( $self->request->content_length ) {
 
-        syswrite( $self->stdin, $self->request->content )
+        $self->stdin->print($self->request->content)
           or croak("Can't write request content to stdin handle: $!");
 
-        sysseek( $self->stdin, 0, SEEK_SET )
+        $self->stdin->seek(0, SEEK_SET)
           or croak("Can't seek stdin handle: $!");
-    }
-
-    open( $self->{restore}->{stdin}, '<&', STDIN->fileno )
+
+        $self->stdin->flush
+          or croak("Can't flush stdin handle: $!");
+    }
+
+    open( $self->{restore}->{stdin}, '<&'. STDIN->fileno )
       or croak("Can't dup stdin: $!");
 
-    open( STDIN, '<&=', $self->stdin->fileno )
+    open( STDIN, '<&='. $self->stdin->fileno )
       or croak("Can't open stdin: $!");
 
     binmode( STDIN );
 
     if ( $self->stdout ) {
 
-        open( $self->{restore}->{stdout}, '>&', STDOUT->fileno )
+        open( $self->{restore}->{stdout}, '>&'. STDOUT->fileno )
           or croak("Can't dup stdout: $!");
 
-        open( STDOUT, '>&=', $self->stdout->fileno )
+        open( STDOUT, '>&='. $self->stdout->fileno )
           or croak("Can't open stdout: $!");
 
         binmode( $self->stdout );
@@ -114,10 +130,10 @@
 
     if ( $self->stderr ) {
 
-        open( $self->{restore}->{stderr}, '>&', STDERR->fileno )
+        open( $self->{restore}->{stderr}, '>&'. STDERR->fileno )
           or croak("Can't dup stderr: $!");
 
-        open( STDERR, '>&=', $self->stderr->fileno )
+        open( STDERR, '>&='. $self->stderr->fileno )
           or croak("Can't open stderr: $!");
 
         binmode( $self->stderr );
@@ -126,7 +142,7 @@
 
     {
         no warnings 'uninitialized';
-        %ENV = %{ $self->enviroment };
+        %ENV = %{ $self->environment };
     }
 
     if ( $INC{'CGI.pm'} ) {
@@ -224,10 +240,10 @@
 
     {
         no warnings 'uninitialized';
-        %ENV = %{ $self->{restore}->{enviroment} };
-    }
-
-    open( STDIN, '<&', $self->{restore}->{stdin} )
+        %ENV = %{ $self->{restore}->{environment} };
+    }
+
+    open( STDIN, '<&'. fileno($self->{restore}->{stdin}) )
       or croak("Can't restore stdin: $!");
 
     sysseek( $self->stdin, 0, SEEK_SET )
@@ -238,7 +254,7 @@
         STDOUT->flush
           or croak("Can't flush stdout: $!");
 
-        open( STDOUT, '>&', $self->{restore}->{stdout} )
+        open( STDOUT, '>&'. fileno($self->{restore}->{stdout}) )
           or croak("Can't restore stdout: $!");
 
         sysseek( $self->stdout, 0, SEEK_SET )
@@ -250,7 +266,7 @@
         STDERR->flush
           or croak("Can't flush stderr: $!");
 
-        open( STDERR, '>&', $self->{restore}->{stderr} )
+        open( STDERR, '>&'. fileno($self->{restore}->{stderr}) )
           or croak("Can't restore stderr: $!");
 
         sysseek( $self->stderr, 0, SEEK_SET )
@@ -269,43 +285,56 @@
 
 1;
 
-__END__
+
+
+
+=pod
 
 =head1 NAME
 
-HTTP::Request::AsCGI - Setup a CGI enviroment from a HTTP::Request
+HTTP::Request::AsCGI - Set up a CGI environment from an HTTP::Request
+
+=head1 VERSION
+
+version 0.9
+
+=begin Pod::Coverage
+
+    enviroment
+
+=end Pod::Coverage
 
 =head1 SYNOPSIS
 
-    use CGI;
-    use HTTP::Request;
-    use HTTP::Request::AsCGI;
-    
-    my $request = HTTP::Request->new( GET => 'http://www.host.com/' );
-    my $stdout;
-    
-    {
-        my $c = HTTP::Request::AsCGI->new($request)->setup;
-        my $q = CGI->new;
-        
-        print $q->header,
-              $q->start_html('Hello World'),
-              $q->h1('Hello World'),
-              $q->end_html;
-        
-        $stdout = $c->stdout;
-        
-        # enviroment and descriptors will automatically be restored 
-        # when $c is destructed.
-    }
-    
-    while ( my $line = $stdout->getline ) {
-        print $line;
-    }
-    
+      use CGI;
+      use HTTP::Request;
+      use HTTP::Request::AsCGI;
+
+      my $request = HTTP::Request->new( GET => 'http://www.host.com/' );
+      my $stdout;
+
+      {
+          my $c = HTTP::Request::AsCGI->new($request)->setup;
+          my $q = CGI->new;
+
+          print $q->header,
+                $q->start_html('Hello World'),
+                $q->h1('Hello World'),
+                $q->end_html;
+
+          $stdout = $c->stdout;
+
+          # environment and descriptors will automatically be restored
+          # when $c is destructed.
+      }
+
+      while ( my $line = $stdout->getline ) {
+          print $line;
+      }
+
 =head1 DESCRIPTION
 
-Provides a convinient way of setting up an CGI enviroment from a HTTP::Request.
+Provides a convenient way of setting up an CGI environment from an HTTP::Request.
 
 =head1 METHODS
 
@@ -313,21 +342,21 @@
 
 =item new ( $request [, key => value ] )
 
-Contructor, first argument must be a instance of HTTP::Request
-followed by optional pairs of environment key and value.
-
-=item enviroment
+Constructor.  The first argument must be a instance of HTTP::Request, followed
+by optional pairs of environment key and value.
+
+=item environment
 
 Returns a hashref containing the environment that will be used in setup. 
 Changing the hashref after setup has been called will have no effect.
 
 =item setup
 
-Setups the environment and descriptors.
+Sets up the environment and descriptors.
 
 =item restore
 
-Restores the enviroment and descriptors. Can only be called after setup.
+Restores the environment and descriptors. Can only be called after setup.
 
 =item request
 
@@ -352,7 +381,7 @@
 Accessor for handle that will be used for STDERR, must be a real seekable
 handle with an file descriptor.
 
-=back
+=back 
 
 =head1 SEE ALSO
 
@@ -364,19 +393,27 @@
 
 =item L<Test::WWW::Mechanize::CGI>
 
-=back
+=back 
 
 =head1 THANKS TO
 
 Thomas L. Shinnick for his valuable win32 testing.
 
-=head1 AUTHOR
-
-Christian Hansen, C<ch at ngmedia.com>
-
-=head1 LICENSE
-
-This library is free software. You can redistribute it and/or modify 
-it under the same terms as perl itself.
-
-=cut
+=head1 AUTHORS
+
+  Christian Hansen <ch at ngmedia.com>
+  Hans Dieter Pearcey <hdp at cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2009 by Christian Hansen <ch at ngmedia.com>.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as perl itself.
+
+=cut 
+
+
+
+__END__
+

Modified: trunk/libhttp-request-ascgi-perl/t/05env.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libhttp-request-ascgi-perl/t/05env.t?rev=34288&op=diff
==============================================================================
--- trunk/libhttp-request-ascgi-perl/t/05env.t (original)
+++ trunk/libhttp-request-ascgi-perl/t/05env.t Tue Apr 28 21:36:45 2009
@@ -8,7 +8,7 @@
 use HTTP::Request;
 use HTTP::Request::AsCGI;
 
-my $r = HTTP::Request->new( GET => 'http://www.host.com/cgi-bin/script.cgi/my/path/?a=1&b=2', [ 'X-Test' => 'Test' ] );
+my $r = HTTP::Request->new( GET => 'http://www.host.com/cgi-bin/script.cgi/my%20path%2F?a=1&b=2', [ 'X-Test' => 'Test' ] );
 my %e = ( SCRIPT_NAME => '/cgi-bin/script.cgi' );
 my $c = HTTP::Request::AsCGI->new( $r, %e );
 $c->stdout(undef);
@@ -18,7 +18,7 @@
 is( $ENV{GATEWAY_INTERFACE}, 'CGI/1.1', 'GATEWAY_INTERFACE' );
 is( $ENV{HTTP_HOST}, 'www.host.com:80', 'HTTP_HOST' );
 is( $ENV{HTTP_X_TEST}, 'Test', 'HTTP_X_TEST' );
-is( $ENV{PATH_INFO}, '/my/path/', 'PATH_INFO' );
+is( $ENV{PATH_INFO}, '/my path%2F', 'PATH_INFO' );
 is( $ENV{QUERY_STRING}, 'a=1&b=2', 'QUERY_STRING' );
 is( $ENV{SCRIPT_NAME}, '/cgi-bin/script.cgi', 'SCRIPT_NAME' );
 is( $ENV{REQUEST_METHOD}, 'GET', 'REQUEST_METHOD' );




More information about the Pkg-perl-cvs-commits mailing list