r4723 - in /packages/libwww-mechanize-cgi-perl: ./ branches/
branches/upstream/ branches/upstream/current/
branches/upstream/current/lib/ branches/upstream/current/lib/WWW/
branches/upstream/current/lib/WWW/Mechanize/ branches/upstream/current/t/
branches/upstream/current/t/cgi-bin/ tags/
jaldhar at users.alioth.debian.org
jaldhar at users.alioth.debian.org
Sun Jan 14 08:07:13 CET 2007
Author: jaldhar
Date: Sun Jan 14 08:07:13 2007
New Revision: 4723
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4723
Log:
[svn-inject] Installing original source of libwww-mechanize-cgi-perl
Added:
packages/libwww-mechanize-cgi-perl/
packages/libwww-mechanize-cgi-perl/branches/
packages/libwww-mechanize-cgi-perl/branches/upstream/
packages/libwww-mechanize-cgi-perl/branches/upstream/current/
packages/libwww-mechanize-cgi-perl/branches/upstream/current/Changes
packages/libwww-mechanize-cgi-perl/branches/upstream/current/MANIFEST
packages/libwww-mechanize-cgi-perl/branches/upstream/current/META.yml
packages/libwww-mechanize-cgi-perl/branches/upstream/current/Makefile.PL
packages/libwww-mechanize-cgi-perl/branches/upstream/current/README
packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/
packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/WWW/
packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/WWW/Mechanize/
packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/WWW/Mechanize/CGI.pm
packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/
packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/01use.t
packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/02basic.t
packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/03forking.t
packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/04application.t
packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/cgi-bin/
packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/cgi-bin/script.cgi (with props)
packages/libwww-mechanize-cgi-perl/tags/
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/Changes?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/Changes (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/Changes Sun Jan 14 08:07:13 2007
@@ -1,0 +1,12 @@
+This file documents the revision history for Perl extension WWW::Mechanize::CGI.
+
+0.3 2005-12-12 00:50:00 2005
+ - added support for relative paths in cgi_application(). (Chris Dolan <cdolan at cpan.org>)
+ - cgi_application() now sets SCRIPT_FILENAME. (Chris Dolan <cdolan at cpan.org>)
+
+0.2 2005-11-13 21:52:00 2005
+ - added support for external CGI applications.
+ - documented fork option.
+
+0.1 2005-10-31 00:59:00 2005
+ - first release.
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/MANIFEST?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/MANIFEST Sun Jan 14 08:07:13 2007
@@ -1,0 +1,11 @@
+Changes
+lib/WWW/Mechanize/CGI.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml Module meta-data (added by MakeMaker)
+README
+t/01use.t
+t/02basic.t
+t/03forking.t
+t/04application.t
+t/cgi-bin/script.cgi
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/META.yml?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/META.yml (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/META.yml Sun Jan 14 08:07:13 2007
@@ -1,0 +1,16 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: WWW-Mechanize-CGI
+version: 0.3
+version_from: lib/WWW/Mechanize/CGI.pm
+installdirs: site
+requires:
+ Carp: 0
+ File::Spec: 0
+ HTTP::Request::AsCGI: 0.2
+ IO::Pipe: 0
+ Test::More: 0
+ WWW::Mechanize: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/Makefile.PL?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/Makefile.PL Sun Jan 14 08:07:13 2007
@@ -1,0 +1,16 @@
+#!perl
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'WWW::Mechanize::CGI',
+ VERSION_FROM => 'lib/WWW/Mechanize/CGI.pm',
+ PREREQ_PM => {
+ Carp => 0,
+ File::Spec => 0,
+ HTTP::Request::AsCGI => 0.2,
+ IO::Pipe => 0,
+ Test::More => 0,
+ WWW::Mechanize => 0
+ }
+);
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/README?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/README (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/README Sun Jan 14 08:07:13 2007
@@ -1,0 +1,61 @@
+NAME
+ WWW::Mechanize::CGI - Use WWW::Mechanize with CGI applications.
+
+SYNOPSIS
+ use CGI;
+ use WWW::Mechanize::CGI;
+
+ # Using a external CGI application
+
+ $mech = WWW::Mechanize::CGI->new;
+ $mech->cgi_application('/path/to/cgi/executable.cgi');
+
+ $response = $mech->get('http://localhost/');
+
+ # Using a inline CGI callback
+
+ $mech = WWW::Mechanize::CGI->new;
+ $mech->cgi( sub {
+
+ my $q = CGI->new;
+
+ print $q->header,
+ $q->start_html('Hello World'),
+ $q->h1('Hello World'),
+ $q->end_html;
+ });
+
+ $response = $mech->get('http://localhost/');
+
+DESCRIPTION
+ Provides a convenient way of using CGI applications with WWW::Mechanize.
+
+METHODS
+ new Behaves like, and calls, WWW::Mechanize's "new" method. Any parms
+ passed in get passed to WWW::Mechanize's constructor.
+
+ cgi Coderef to be used to execute the CGI application.
+
+ cgi_application('/path/to/cgi/executable.cgi')
+ Path to CGI executable.
+
+ env( [, key => value ] )
+ Additional environment variables to be used in CGI.
+
+ $mech->env( DOCUMENT_ROOT=> '/export/www/myapp' );
+
+ fork
+ Set to a true value if you want to fork() before executing CGI.
+
+SEE ALSO
+ WWW::Mechanize
+ LWP::UserAgent
+ HTTP::Request::AsCGI
+
+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.
+
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/WWW/Mechanize/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/WWW/Mechanize/CGI.pm?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/WWW/Mechanize/CGI.pm (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/lib/WWW/Mechanize/CGI.pm Sun Jan 14 08:07:13 2007
@@ -1,0 +1,247 @@
+package WWW::Mechanize::CGI;
+
+use strict;
+use warnings;
+use base 'WWW::Mechanize';
+
+use Carp;
+use File::Spec;
+use HTTP::Request;
+use HTTP::Request::AsCGI;
+use HTTP::Response;
+use IO::Pipe;
+
+our $VERSION = 0.3;
+
+sub cgi {
+ my $self = shift;
+
+ if ( @_ ) {
+ $self->{cgi} = shift;
+ }
+
+ return $self->{cgi};
+}
+
+sub cgi_application {
+ my ( $self, $application ) = @_;
+
+ unless ( File::Spec->file_name_is_absolute($application) ) {
+ $application = File::Spec->rel2abs($application);
+ }
+
+ $self->env( SCRIPT_FILENAME => $application, $self->env );
+
+ unless ( -e $application ) {
+ croak( qq/Path to application '$application' does not exist./ );
+ }
+
+ unless ( -f _ ) {
+ croak( qq/Path to application '$application' is not a file./ );
+ }
+
+ unless ( -x _ ) {
+ croak( qq/Application '$application' is not executable./ );
+ }
+
+ my $cgi = sub {
+
+ my $status = system($application);
+ my $value = $status >> 8;
+
+ if ( $status == -1 ) {
+ croak( qq/Failed to execute application '$application'. Reason: '$!'/ );
+ }
+
+ if ( $value > 0 ) {
+ croak( qq/Application '$application' exited with value: $value/ );
+ }
+ };
+
+ $self->cgi($cgi);
+}
+
+sub fork {
+ my $self = shift;
+
+ if ( @_ ) {
+ $self->{fork} = shift;
+ }
+
+ return $self->{fork};
+}
+
+sub env {
+ my $self = shift;
+
+ if ( @_ ) {
+ $self->{env} = { @_ };
+ }
+
+ return %{ $self->{env} || {} };
+}
+
+sub _make_request {
+ my ( $self, $request ) = @_;
+
+ if ( $self->cookie_jar ) {
+ $self->cookie_jar->add_cookie_header($request);
+ }
+
+ my $c = HTTP::Request::AsCGI->new( $request, $self->env );
+
+ my ( $error, $kid, $pipe, $response );
+
+ if ( $self->fork ) {
+
+ $pipe = IO::Pipe->new;
+ $kid = CORE::fork();
+
+ unless ( defined $kid ) {
+ croak("Can't fork() kid: $!");
+ }
+ }
+
+ unless ( $kid ) {
+
+ $c->setup;
+
+ eval { $self->cgi->() };
+
+ $c->restore;
+
+ if ( $self->fork ) {
+
+ $pipe->writer;
+ $pipe->write($@) if $@;
+
+ exit(1) if $@;
+ exit(0);
+ }
+ }
+
+ $error = $@;
+
+ if ( $self->fork ) {
+
+ waitpid( $kid, 0 );
+
+ $pipe->reader;
+ $pipe->read( $error, 4096 ) if ( $? >> 8 ) > 0;
+ }
+
+ if ( $error ) {
+ $response = HTTP::Response->new( 500, 'Internal Server Error' );
+ $response->date( time() );
+ $response->header( 'X-Error' => $error );
+ $response->content( $response->error_as_HTML );
+ $response->content_type('text/html');
+ }
+ else {
+ $response = $c->response;
+ }
+
+ $response->header( 'Content-Base' => $request->uri );
+ $response->request($request);
+
+ if ( $self->cookie_jar ) {
+ $self->cookie_jar->extract_cookies($response);
+ }
+
+ return $response;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+WWW::Mechanize::CGI - Use WWW::Mechanize with CGI applications.
+
+=head1 SYNOPSIS
+
+ use CGI;
+ use WWW::Mechanize::CGI;
+
+ # Using a external CGI application
+
+ $mech = WWW::Mechanize::CGI->new;
+ $mech->cgi_application('/path/to/cgi/executable.cgi');
+
+ $response = $mech->get('http://localhost/');
+
+
+ # Using a inline CGI callback
+
+ $mech = WWW::Mechanize::CGI->new;
+ $mech->cgi( sub {
+
+ my $q = CGI->new;
+
+ print $q->header,
+ $q->start_html('Hello World'),
+ $q->h1('Hello World'),
+ $q->end_html;
+ });
+
+ $response = $mech->get('http://localhost/');
+
+=head1 DESCRIPTION
+
+Provides a convenient way of using CGI applications with L<WWW::Mechanize>.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+Behaves like, and calls, L<WWW::Mechanize>'s C<new> method. Any parms
+passed in get passed to WWW::Mechanize's constructor.
+
+=item cgi
+
+Coderef to be used to execute the CGI application.
+
+=item cgi_application('/path/to/cgi/executable.cgi')
+
+Path to CGI executable.
+
+=item env( [, key => value ] )
+
+Set/Get additional environment variables to be used in CGI. Takes a hash and
+returns a hash.
+
+ $mech->env( DOCUMENT_ROOT => '/export/www/myapp' );
+
+=item fork
+
+Set to a true value if you want to fork() before executing CGI.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::WWW::Mechanize::CGI>
+
+=item L<WWW::Mechanize>
+
+=item L<LWP::UserAgent>
+
+=item L<HTTP::Request::AsCGI>
+
+=back
+
+=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
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/01use.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/01use.t?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/01use.t (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/01use.t Sun Jan 14 08:07:13 2007
@@ -1,0 +1,8 @@
+#!perl
+
+use Test::More 'no_plan';
+
+use strict;
+use warnings;
+
+use_ok 'WWW::Mechanize::CGI';
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/02basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/02basic.t?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/02basic.t (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/02basic.t Sun Jan 14 08:07:13 2007
@@ -1,0 +1,51 @@
+#!perl
+
+use Test::More tests => 12;
+
+use strict;
+use warnings;
+
+use WWW::Mechanize::CGI;
+
+my $mech = WWW::Mechanize::CGI->new;
+$mech->env(
+ DOCUMENT_ROOT => '/export/www/myapp'
+);
+$mech->cgi( sub {
+ print "Content-Type: text/plain\n";
+ print "Status: 200\n";
+ print "X-Field: 1\n";
+ print "X-Field: 2\n";
+ print "\n";
+ print "$ENV{DOCUMENT_ROOT}";
+} );
+
+{
+ my $response = $mech->get('http://localhost/');
+
+ isa_ok( $response, 'HTTP::Response' );
+ is( $response->code, 200, 'Response Code' );
+ is( $response->message, 'OK', 'Response Message' );
+ is( $response->protocol, 'HTTP/1.1', 'Response Protocol' );
+ is( $response->content, '/export/www/myapp', 'Response Content' );
+ is( $response->content_length, 17, 'Response Content-Length' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is_deeply( [ $response->header('X-Field') ], [ 1, 2 ], 'Response Header X-Field' );
+}
+
+$mech->cgi( sub {
+ print "Content-Type: text/plain\n";
+ print "Status: 200\n";
+
+ die 'oooups';
+
+} );
+
+{
+ my $response = $mech->get('http://localhost/');
+
+ isa_ok( $response, 'HTTP::Response' );
+ is( $response->code, 500, 'Response Code' );
+ is( $response->message, 'Internal Server Error', 'Response Message' );
+ like( $response->header('X-Error'), qr/^oooups/, 'Response Error Message' );
+}
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/03forking.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/03forking.t?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/03forking.t (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/03forking.t Sun Jan 14 08:07:13 2007
@@ -1,0 +1,37 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Config;
+use Test::More;
+use WWW::Mechanize::CGI;
+
+unless ( $Config{d_fork} ) {
+ plan skip_all => 'This test requires a plattform that supports fork()';
+}
+
+plan tests => 5;
+
+my $mech = WWW::Mechanize::CGI->new;
+$mech->fork(1);
+$mech->cgi( sub {
+ print "Content-Type: text/plain\n";
+ print "Status: 200\n";
+ print "\n";
+} );
+
+{
+ my $response = $mech->get('http://localhost/');
+ isa_ok( $response, 'HTTP::Response' );
+ is( $response->code, 200, 'Response Code' );
+}
+
+$mech->cgi( sub { die 'oooups'; } );
+
+{
+ my $response = $mech->get('http://localhost/');
+ isa_ok( $response, 'HTTP::Response' );
+ is( $response->code, 500, 'Response Code' );
+ like( $response->header('X-Error'), qr/^oooups/, 'Response Error Message' );
+}
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/04application.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/04application.t?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/04application.t (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/04application.t Sun Jan 14 08:07:13 2007
@@ -1,0 +1,36 @@
+#!perl
+
+use Test::More tests => 12;
+
+use strict;
+use warnings;
+
+use WWW::Mechanize::CGI;
+
+my $mech = WWW::Mechanize::CGI->new;
+$mech->env( DOCUMENT_ROOT => '/export/www/myapp' );
+$mech->cgi_application('t/cgi-bin/script.cgi');
+
+{
+ my $response = $mech->get('http://localhost/');
+
+ isa_ok( $response, 'HTTP::Response' );
+ is( $response->code, 200, 'Response Code' );
+ is( $response->message, 'OK', 'Response Message' );
+ is( $response->protocol, 'HTTP/1.1', 'Response Protocol' );
+ is( $response->content, '/export/www/myapp', 'Response Content' );
+ is( $response->content_length, 17, 'Response Content-Length' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is_deeply( [ $response->header('X-Field') ], [ 1, 2 ], 'Response Header X-Field' );
+}
+
+$mech->env( $mech->env, DIE => 1 );
+
+{
+ my $response = $mech->get('http://localhost/');
+
+ isa_ok( $response, 'HTTP::Response' );
+ is( $response->code, 500, 'Response Code' );
+ is( $response->message, 'Internal Server Error', 'Response Message' );
+ like( $response->header('X-Error'), qr/^Application .+ exited with value: 255/, 'Response Error Message' );
+}
Added: packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/cgi-bin/script.cgi
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/cgi-bin/script.cgi?rev=4723&op=file
==============================================================================
--- packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/cgi-bin/script.cgi (added)
+++ packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/cgi-bin/script.cgi Sun Jan 14 08:07:13 2007
@@ -1,0 +1,10 @@
+#!/usr/bin/perl
+
+print "Content-Type: text/plain\n";
+print "Status: 200\n";
+print "X-Field: 1\n";
+print "X-Field: 2\n";
+print "\n";
+print "$ENV{DOCUMENT_ROOT}";
+
+die 'exception' if $ENV{DIE};
Propchange: packages/libwww-mechanize-cgi-perl/branches/upstream/current/t/cgi-bin/script.cgi
------------------------------------------------------------------------------
svn:executable =
More information about the Pkg-perl-cvs-commits
mailing list