r25303 - in /branches/upstream/libcgi-application-server-perl: ./ current/ current/lib/ current/lib/CGI/ current/lib/CGI/Application/ current/t/ current/t/htdocs/ current/t/lib/ current/t/lib/MyCGIApp/
jaldhar at users.alioth.debian.org
jaldhar at users.alioth.debian.org
Thu Sep 18 03:11:25 UTC 2008
Author: jaldhar
Date: Thu Sep 18 03:11:18 2008
New Revision: 25303
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25303
Log:
[svn-inject] Installing original source of libcgi-application-server-perl
Added:
branches/upstream/libcgi-application-server-perl/
branches/upstream/libcgi-application-server-perl/current/
branches/upstream/libcgi-application-server-perl/current/Build.PL
branches/upstream/libcgi-application-server-perl/current/ChangeLog
branches/upstream/libcgi-application-server-perl/current/MANIFEST
branches/upstream/libcgi-application-server-perl/current/META.yml
branches/upstream/libcgi-application-server-perl/current/Makefile.PL
branches/upstream/libcgi-application-server-perl/current/README
branches/upstream/libcgi-application-server-perl/current/lib/
branches/upstream/libcgi-application-server-perl/current/lib/CGI/
branches/upstream/libcgi-application-server-perl/current/lib/CGI/Application/
branches/upstream/libcgi-application-server-perl/current/lib/CGI/Application/Server.pm
branches/upstream/libcgi-application-server-perl/current/t/
branches/upstream/libcgi-application-server-perl/current/t/000_load.t
branches/upstream/libcgi-application-server-perl/current/t/001_basic.t
branches/upstream/libcgi-application-server-perl/current/t/002_valid_entry_points.t
branches/upstream/libcgi-application-server-perl/current/t/003_dispatch.t
branches/upstream/libcgi-application-server-perl/current/t/004_object_as_entry_point.t
branches/upstream/libcgi-application-server-perl/current/t/005_mode_param_from_path_info.t
branches/upstream/libcgi-application-server-perl/current/t/htdocs/
branches/upstream/libcgi-application-server-perl/current/t/htdocs/index.html
branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.css
branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.js
branches/upstream/libcgi-application-server-perl/current/t/lib/
branches/upstream/libcgi-application-server-perl/current/t/lib/AppWithParams.pm
branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp/
branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp.pm
branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp/Dispatch.pm
branches/upstream/libcgi-application-server-perl/current/t/pod.t
branches/upstream/libcgi-application-server-perl/current/t/pod_coverage.t
Added: branches/upstream/libcgi-application-server-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/Build.PL?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/Build.PL (added)
+++ branches/upstream/libcgi-application-server-perl/current/Build.PL Thu Sep 18 03:11:18 2008
@@ -1,0 +1,34 @@
+use Module::Build;
+
+use strict;
+
+my $build = Module::Build->new(
+ module_name => 'CGI::Application::Server',
+ license => 'perl',
+ requires => {
+ 'Scalar::Util' => '1.18',
+ 'Carp' => '0.01',
+ 'HTTP::Request' => '0',
+ 'HTTP::Status' => '0',
+ 'CGI::Application' => '0',
+ 'HTTP::Server::Simple' => '0.18',
+ 'HTTP::Server::Simple::Static' => '0.02',
+ },
+ optional => {
+ },
+ build_requires => {
+ 'Test::More' => '0.47',
+ 'Test::Exception' => '0.21',
+ 'Test::HTTP::Server::Simple' => '0.02',
+ 'Test::WWW::Mechanize' => '1.08',
+ 'CGI::Application::Plugin::Redirect' => '0',
+ },
+ create_makefile_pl => 'traditional',
+ recursive_test_files => 1,
+ add_to_cleanup => [
+ 'META.yml', '*.bak', '*.gz', 'Makefile.PL',
+ ],
+);
+
+$build->create_build_script;
+
Added: branches/upstream/libcgi-application-server-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/ChangeLog?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/ChangeLog (added)
+++ branches/upstream/libcgi-application-server-perl/current/ChangeLog Thu Sep 18 03:11:18 2008
@@ -1,0 +1,22 @@
+Changes for CGI::Application::Server
+
+0.050 Sun. Oct 21, 2007
+ - add support for CGI::Application objects as entry points
+ - handle PATH_INFO munging for CGI::App, not just ::Dispatch
+ - both these changes thanks to JALDHAR
+
+0.04 Sun. Oct 21, 2007
+ - add support for CGI::Application::Dispatch classes
+
+0.03 Tues. Feb 20, 2007
+ - Fixed is_valid_entry_point to be more strict
+ in how it matched URIs
+ - added tests for this
+ - fixed the way the captured stdout is recombined
+ to make steaming non-HTML mime-types work
+
+0.02 Mon. April 10, 2006
+ - Added logging of every request (uri, entry-point, and params)
+
+0.01 Wed. March 15, 2006
+ - initial release of module
Added: branches/upstream/libcgi-application-server-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/MANIFEST?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/MANIFEST (added)
+++ branches/upstream/libcgi-application-server-perl/current/MANIFEST Thu Sep 18 03:11:18 2008
@@ -1,0 +1,21 @@
+Build.PL
+ChangeLog
+lib/CGI/Application/Server.pm
+Makefile.PL
+MANIFEST
+META.yml
+README
+t/000_load.t
+t/001_basic.t
+t/002_valid_entry_points.t
+t/003_dispatch.t
+t/004_object_as_entry_point.t
+t/005_mode_param_from_path_info.t
+t/htdocs/index.html
+t/htdocs/test.css
+t/htdocs/test.js
+t/lib/AppWithParams.pm
+t/lib/MyCGIApp.pm
+t/lib/MyCGIApp/Dispatch.pm
+t/pod.t
+t/pod_coverage.t
Added: branches/upstream/libcgi-application-server-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/META.yml?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/META.yml (added)
+++ branches/upstream/libcgi-application-server-perl/current/META.yml Thu Sep 18 03:11:18 2008
@@ -1,0 +1,33 @@
+---
+name: CGI-Application-Server
+version: 0.050
+author:
+ - 'Stevan Little E<lt>stevan at iinteractive.comE<gt>'
+ - 'Rob Kinyon E<lt>rob.kinyon at iinteractive.comE<gt>'
+ - 'Ricardo SIGNES E<lt>rjbs at cpan.orgE<gt>'
+abstract: A simple HTTP server for developing with CGI::Application
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ CGI::Application: 0
+ Carp: 0.01
+ HTTP::Request: 0
+ HTTP::Server::Simple: 0.18
+ HTTP::Server::Simple::Static: 0.02
+ HTTP::Status: 0
+ Scalar::Util: 1.18
+build_requires:
+ CGI::Application::Plugin::Redirect: 0
+ Test::Exception: 0.21
+ Test::HTTP::Server::Simple: 0.02
+ Test::More: 0.47
+ Test::WWW::Mechanize: 1.08
+provides:
+ CGI::Application::Server:
+ file: lib/CGI/Application/Server.pm
+ version: 0.050
+generated_by: Module::Build version 0.280801
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libcgi-application-server-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/Makefile.PL?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/Makefile.PL (added)
+++ branches/upstream/libcgi-application-server-perl/current/Makefile.PL Thu Sep 18 03:11:18 2008
@@ -1,0 +1,25 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.2808_01
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'CGI::Application::Server',
+ 'VERSION_FROM' => 'lib/CGI/Application/Server.pm',
+ 'PREREQ_PM' => {
+ 'CGI::Application' => '0',
+ 'CGI::Application::Plugin::Redirect' => '0',
+ 'Carp' => '0.01',
+ 'HTTP::Request' => '0',
+ 'HTTP::Server::Simple' => '0.18',
+ 'HTTP::Server::Simple::Static' => '0.02',
+ 'HTTP::Status' => '0',
+ 'Scalar::Util' => '1.18',
+ 'Test::Exception' => '0.21',
+ 'Test::HTTP::Server::Simple' => '0.02',
+ 'Test::More' => '0.47',
+ 'Test::WWW::Mechanize' => '1.08'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'EXE_FILES' => [],
+ 'PL_FILES' => {}
+ )
+;
Added: branches/upstream/libcgi-application-server-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/README?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/README (added)
+++ branches/upstream/libcgi-application-server-perl/current/README Thu Sep 18 03:11:18 2008
@@ -1,0 +1,41 @@
+CGI::Application::Server version 0.04
+=====================================
+
+See the individual module documentation for more information
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ HTTP::Request
+ HTTP::Status
+ CGI::Application
+ HTTP::Server::Simple
+ HTTP::Server::Simple::Static
+
+And requires these modules for testing:
+
+ Test::More
+ Test::Exception
+ Test::HTTP::Server::Simple
+ Test::WWW::Mechanize
+ CGI::Application::Plugin::Redirect
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2006 Infinity Interactive, Inc.
+
+http://www.iinteractive.com
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
Added: branches/upstream/libcgi-application-server-perl/current/lib/CGI/Application/Server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/lib/CGI/Application/Server.pm?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/lib/CGI/Application/Server.pm (added)
+++ branches/upstream/libcgi-application-server-perl/current/lib/CGI/Application/Server.pm Thu Sep 18 03:11:18 2008
@@ -1,0 +1,271 @@
+
+package CGI::Application::Server;
+
+use strict;
+use warnings;
+
+use Carp qw( confess );
+use CGI qw( param );
+use Scalar::Util qw( blessed reftype );
+use HTTP::Response;
+use HTTP::Status;
+
+our $VERSION = '0.050';
+
+use base qw(
+ HTTP::Server::Simple::CGI
+ HTTP::Server::Simple::Static
+);
+
+# HTTP::Server::Simple methods
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->{entry_points} = {};
+ $self->{document_root} = '.';
+ return $self;
+}
+
+# accessors
+
+sub document_root {
+ my ($self, $document_root) = @_;
+ if (defined $document_root) {
+ (-d $document_root)
+ || confess "The server root ($document_root) is not found";
+ $self->{document_root} = $document_root;
+ }
+ $self->{document_root};
+}
+
+sub entry_points {
+ my ($self, $entry_points) = @_;
+ if (defined $entry_points) {
+ (reftype($entry_points) && reftype($entry_points) eq 'HASH')
+ || confess "The entry points map must be a HASH reference, not $entry_points";
+ $self->{entry_points} = $entry_points;
+ }
+ $self->{entry_points};
+}
+
+# check request
+
+sub is_valid_entry_point {
+ my ($self, $uri) = @_;
+
+ # Remove all parameters
+ $uri =~ s/\?.*//;
+
+ while ( $uri ) {
+ # Check to see if this is an exact match
+ if (exists $self->{entry_points}{$uri}) {
+ return ($uri, $self->{entry_points}{$uri});
+ }
+
+ # Remove the rightmost path element
+ $uri =~ s/\/[^\/]*$//;
+ }
+
+ # Didn't find anything. Oh, well.
+ return;
+}
+
+sub handle_request {
+ my ($self, $cgi) = @_;
+ if (my ($path, $target) = $self->is_valid_entry_point($ENV{REQUEST_URI})) {
+ warn "$ENV{REQUEST_URI} ($target)\n";
+ warn "\t$_ => " . param( $_ ) . "\n" for param();
+
+ my $stdout;
+ local $ENV{CGI_APP_RETURN_ONLY} = 1;
+ (local $ENV{PATH_INFO} = $ENV{PATH_INFO}) =~ s/\A\Q$path//;
+
+ if ($target->isa('CGI::Application::Dispatch')) {
+ $stdout = $target->dispatch;
+ } elsif ($target->isa('CGI::Application')) {
+ if (!defined blessed $target) {
+ $stdout = $target->new->run;
+ } else {
+ $stdout = $target->run;
+ }
+ } else {
+ confess "Target must be a CGI::Application or CGI::Application::Dispatch subclass\n";
+ }
+
+ my $response = $self->_build_response( $stdout );
+ print $response->as_string;
+ } else {
+ return $self->serve_static($cgi, $self->document_root);
+ }
+}
+
+# Shamelessly stolen from HTTP::Request::AsCGI by chansen
+sub _build_response {
+ my ( $self, $stdout ) = @_;
+
+ $stdout =~ s{(.*?\x0d?\x0a\x0d?\x0a)}{}xsm;
+ my $headers = $1;
+
+ unless ( defined $headers ) {
+ $headers = "HTTP/1.1 500 Internal Server Error\x0d\x0a";
+ }
+
+ unless ( $headers =~ /^HTTP/ ) {
+ $headers = "HTTP/1.1 200 OK\x0d\x0a" . $headers;
+ }
+
+ my $response = HTTP::Response->parse($headers);
+ $response->date( time() ) unless $response->date;
+
+ my $message = $response->message;
+ my $status = $response->header('Status');
+
+ $response->header( Connection => 'close' );
+
+ if ( $message && $message =~ /^(.+)\x0d$/ ) {
+ $response->message($1);
+ }
+
+ if ( $status && $status =~ /^(\d\d\d)\s?(.+)?$/ ) {
+
+ my $code = $1;
+ $message = $2 || HTTP::Status::status_message($code);
+
+ $response->code($code);
+ $response->message($message);
+ }
+
+ my $length = length $stdout;
+
+ if ( $response->code == 500 && !$length ) {
+
+ $response->content( $response->error_as_HTML );
+ $response->content_type('text/html');
+
+ return $response;
+ }
+
+ $response->add_content($stdout);
+ $response->content_length($length);
+
+ return $response;
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+CGI::Application::Server - A simple HTTP server for developing with CGI::Application
+
+=head1 SYNOPSIS
+
+ use CGI::Application::Server;
+
+ my $server = CGI::Application::Server->new();
+
+ my $object = MyOtherCGIApp->new(PARAMS => { foo => 1, bar => 2 });
+
+ $server->document_root('./htdocs');
+ $server->entry_points({
+ '/index.cgi' => 'MyCGIApp',
+ '/admin' => 'MyCGIApp::Admin',
+ '/account' => 'MyCGIApp::Account::Dispatch',
+ '/users' => $object,
+ });
+ $server->run();
+
+=head1 DESCRIPTION
+
+This is a simple HTTP server for for use during development with
+L<CGI::Appliaction>. At this moment, it serves our needs in a
+very basic way. The plan is to release early and release often,
+and add features when we need them. That said, we welcome any
+and all patches, tests and feature requests (the ones with which
+are accompanied by failing tests will get priority).
+
+=head1 METHODS
+
+=over 4
+
+=item B<new ($port)>
+
+This acts just like C<new> for L<HTTP::Server::Simple>, except it
+will initialize instance slots that we use.
+
+=item B<handle_request>
+
+This will check the request uri and dispatch appropriately, either
+to an entry point, or serve a static file (html, jpeg, gif, etc).
+
+=item B<entry_points (?$entry_points)>
+
+This accepts a HASH reference in C<$entry_points>, which maps server entry
+points (uri) to L<CGI::Application> or L<CGI::Application::Dispatch> class
+names or objects. See the L<SYNOPSIS> above for examples.
+
+=item B<is_valid_entry_point ($uri)>
+
+This attempts to match the C<$uri> to an entry point.
+
+=item B<document_root (?$document_root)>
+
+This is the server's document root where all static files will
+be served from.
+
+=back
+
+=head1 CAVEATS
+
+This is a subclass of L<HTTP::Server::Simple> and all of its caveats
+apply here as well.
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
+
+=head1 CODE COVERAGE
+
+I use L<Devel::Cover> to test the code coverage of my tests, below
+is the L<Devel::Cover> report on this module's test suite.
+
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ File stmt bran cond sub pod time total
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ ...CGI/Application/Server.pm 94.4 80.0 53.3 100.0 100.0 100.0 88.3
+ Total 94.4 80.0 53.3 100.0 100.0 100.0 88.3
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+
+=head1 ACKNOWLEDGEMENTS
+
+=over 4
+
+=item The HTTP response handling was shamelessly stolen from L<HTTP::Request::AsCGI> by chansen
+
+=back
+
+=head1 AUTHOR
+
+Stevan Little E<lt>stevan at iinteractive.comE<gt>
+
+Rob Kinyon E<lt>rob.kinyon at iinteractive.comE<gt>
+
+Ricardo SIGNES E<lt>rjbs at cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libcgi-application-server-perl/current/t/000_load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/000_load.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/000_load.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/000_load.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,10 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok('CGI::Application::Server');
+}
Added: branches/upstream/libcgi-application-server-perl/current/t/001_basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/001_basic.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/001_basic.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/001_basic.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,100 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib/';
+
+use Test::More tests => 34;
+
+use Test::Exception;
+use Test::HTTP::Server::Simple;
+use Test::WWW::Mechanize;
+
+BEGIN {
+ use_ok('CGI::Application::Server');
+ use_ok('MyCGIApp');
+}
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+isa_ok($server, 'CGI::Application::Server');
+isa_ok($server, 'HTTP::Server::Simple');
+
+is_deeply($server->entry_points, {}, '... no entry-point yet');
+$server->entry_points({
+ '/index.cgi' => 'MyCGIApp'
+});
+is_deeply($server->entry_points, { '/index.cgi' => 'MyCGIApp' }, '... we have an entry point now');
+
+dies_ok {
+ $server->entry_points([]);
+} '... entry points must be a HASH';
+
+dies_ok {
+ $server->entry_points('....');
+} '... entry points must be a HASH';
+
+is($server->document_root, '.', '... got the default server root');
+$server->document_root('./t/htdocs');
+is($server->document_root, './t/htdocs', '... got the new server root');
+
+dies_ok {
+ $server->document_root('./t/nothing');
+} '... cannot assign a doc root that does not exist';
+
+# ignore the warnings for now,
+# they are too hard to test really
+local $SIG{__WARN__} = sub { 1 };
+
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+# test our static index page
+
+$mech->get_ok($url_root.'/index.html', '... got the index.html page okay');
+$mech->title_is('Test Static Index Page', '... got the right page title for index.html');
+
+# test out entry point page
+
+$mech->get_ok($url_root.'/index.cgi', '... got the index.cgi page start-point okay');
+$mech->title_is('Hello', '... got the right page title for index.cgi');
+
+# test with query params
+
+$mech->get_ok($url_root.'/index.cgi?rm=mode1', '... got the index.cgi page okay');
+$mech->title_is('Hello', '... got the right page title for index.cgi (hello)');
+
+$mech->get_ok($url_root.'/index.cgi?rm=mode2', '... got the index.cgi page okay');
+$mech->title_is('Goodbye', '... got the right page title for index.cgi (goodbye)');
+
+$mech->get_ok($url_root.'/index.cgi?rm=mode4', '... got the index.cgi page okay');
+$mech->title_is('Redirect End', '... got the right page title for index.cgi (redirect end)');
+
+$mech->get_ok($url_root.'/index.cgi?rm=mode3', '... got the index.cgi page okay');
+$mech->title_is('Redirect End', '... got the right page title for index.cgi (redirect end)');
+
+# test with extra path info after the entry point
+
+$mech->get_ok($url_root.'/index.cgi/test', '... got the index.cgi page okay (even with extra path info)');
+$mech->title_is('Hello', '... got the right page title for index.cgi (even with extra path info)');
+
+$mech->get_ok($url_root.'/index.cgi/test?rm=mode1', '... got the index.cgi page okay (even with extra path info)');
+$mech->title_is('Hello', '... got the right page title for index.cgi (even with extra path info)');
+
+$mech->get_ok($url_root.'/index.cgi/test?rm=mode2', '... got the index.cgi page okay (even with extra path info)');
+$mech->title_is('Goodbye', '... got the right page title for index.cgi (even with extra path info)');
+
+$mech->get_ok($url_root.'/index.cgi/test?rm=mode4', '... got the index.cgi page okay (even with extra path info)');
+$mech->title_is('Redirect End', '... got the right page title for index.cgi (even with extra path info)');
+
+$mech->get_ok($url_root.'/index.cgi/test?rm=mode3', '... got the index.cgi page okay (even with extra path info)');
+$mech->title_is('Redirect End', '... got the right page title for index.cgi (even with extra path info)');
Added: branches/upstream/libcgi-application-server-perl/current/t/002_valid_entry_points.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/002_valid_entry_points.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/002_valid_entry_points.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/002_valid_entry_points.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,70 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 22;
+use Test::Exception;
+
+BEGIN {
+ use_ok('CGI::Application::Server');
+}
+
+=pod
+
+This could probably use some more tests, but it
+is good enough for now (i.e. - covers the bug
+which prompted this fix)
+
+=cut
+
+my $server = CGI::Application::Server->new();
+isa_ok($server, 'CGI::Application::Server');
+isa_ok($server, 'HTTP::Server::Simple');
+
+$server->entry_points({
+ '/foo' => 'Foo',
+ '/foo/bar' => 'Foo::Bar',
+ '/foo/bar/baz' => 'Foo::Bar::Baz',
+});
+
+foreach my $uri (qw(
+ /foo
+ /foo?say=hello
+ /foo/bling/bar
+ /foo/?bar=baz
+ /foo/barr
+ )) {
+ is($server->is_valid_entry_point($uri), 'Foo', '... got Foo where we expected');
+}
+
+foreach my $uri (qw(
+ /foo/bar
+ /foo/bar?say=hello
+ /foo/bar/bling/bar
+ /foo/bar/?bar=baz
+ /foo/bar/bazz
+ )) {
+ is($server->is_valid_entry_point($uri), 'Foo::Bar', '... got Foo::Bar where we expected');
+}
+
+foreach my $uri (qw(
+ /foo/bar/baz
+ /foo/bar/baz?say=hello
+ /foo/bar/baz/bling/bar
+ /foo/bar/baz/?bar=baz
+ /foo/bar/baz/../
+ )) {
+ is($server->is_valid_entry_point($uri), 'Foo::Bar::Baz', '... got Foo::Bar::Baz where we expected');
+}
+
+foreach my $uri (qw(
+ /fooo
+ /food?say=hello
+ /fooo/bar
+ /fooo/barr/baz
+ )) {
+ is($server->is_valid_entry_point($uri), undef, '... got undef where we expected');
+}
+
+
Added: branches/upstream/libcgi-application-server-perl/current/t/003_dispatch.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/003_dispatch.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/003_dispatch.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/003_dispatch.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,81 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib 't/lib/';
+
+use Test::More;
+
+use Test::Exception;
+use Test::HTTP::Server::Simple;
+use Test::WWW::Mechanize;
+
+unless (eval "require CGI::Application::Dispatch; 1") {
+ plan skip_all => "CGI::Application::Dispatch required for these tests";
+} else {
+ plan tests => 19;
+}
+
+use_ok('CGI::Application::Server');
+use_ok('MyCGIApp');
+use_ok('MyCGIApp::Dispatch');
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+isa_ok($server, 'CGI::Application::Server');
+isa_ok($server, 'HTTP::Server::Simple');
+
+is_deeply($server->entry_points, {}, '... no entry-point yet');
+$server->entry_points({
+ '/index.cgi' => 'MyCGIApp',
+ '/bar' => 'MyCGIApp::Dispatch',
+});
+
+is_deeply(
+ $server->entry_points,
+ {
+ '/index.cgi' => 'MyCGIApp',
+ '/bar' => 'MyCGIApp::Dispatch',
+ },
+ '... we have an entry point now',
+);
+
+$server->document_root('./t/htdocs');
+is($server->document_root, './t/htdocs', '... got the new server root');
+
+# ignore the warnings for now,
+# they are too hard to test really
+local $SIG{__WARN__} = sub { 1 };
+
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+# test our static index page
+
+$mech->get_ok($url_root.'/index.html', '... got the index.html page okay');
+$mech->title_is('Test Static Index Page', '... got the right page title for index.html');
+
+# test out entry point page
+
+$mech->get_ok($url_root.'/index.cgi', '... got the index.cgi page start-point okay');
+$mech->title_is('Hello', '... got the right page title for index.cgi');
+
+# test with query params
+
+$mech->get_ok($url_root.'/bar/foo/mode1', '... got mode1 via dispatch');
+$mech->title_is('Hello', '... got the right page title for mode1 (hello)');
+
+$mech->get_ok($url_root.'/bar/foo/mode2', '... got mode2 via dispatch');
+$mech->title_is('Goodbye', '... got the right page title for mode2 (bye)');
+
+$mech->get_ok($url_root.'/bar/foo/mode3', '... got mode3, get redir');
+$mech->title_is('Redirect End', '... got the right page title for mode4');
Added: branches/upstream/libcgi-application-server-perl/current/t/004_object_as_entry_point.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/004_object_as_entry_point.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/004_object_as_entry_point.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/004_object_as_entry_point.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::WWW::Mechanize;
+use CGI::Application::Server;
+use lib 't/lib';
+use AppWithParams;
+
+my $app1 = AppWithParams->new(PARAMS => {
+ message => 'Hello world!',
+});
+
+my $app2 = AppWithParams->new(PARAMS => {
+ message => 'Goodbye world!',
+});
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+$server->entry_points({
+ '/foo/index.cgi' => $app1,
+ '/bar/index.cgi' => $app2,
+});
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+$mech->get_ok($url_root . '/foo/index.cgi', '...got app1');
+$mech->title_is('Hello world!', '... got the right page title for app1');
+
+$mech->get_ok($url_root . '/bar/index.cgi', '...got app1');
+$mech->title_is('Goodbye world!', '... got the right page title for app2');
+
Added: branches/upstream/libcgi-application-server-perl/current/t/005_mode_param_from_path_info.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/005_mode_param_from_path_info.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/005_mode_param_from_path_info.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/005_mode_param_from_path_info.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+use Test::WWW::Mechanize;
+use CGI::Application::Server;
+
+{
+ package TestApp;
+ use base 'CGI::Application';
+
+ sub setup {
+ my ($self) = @_;
+
+ $self->mode_param(path_info => 1);
+ $self->run_modes([qw/ foo bar /]);
+ }
+
+ sub foo {
+ my ($self) = @_;
+
+ return '<HTML><HEAD><TITLE>Hello world!</TITLE></HEAD>'
+ . '<BODY><H1>Hello world!</H1><HR></BODY></HTML>';
+ }
+
+ sub bar {
+ my ($self) = @_;
+
+ return '<HTML><HEAD><TITLE>Goodbye world!</TITLE></HEAD>'
+ . '<BODY><H1>Goodbye world!</H1><HR></BODY></HTML>';
+ }
+
+}
+
+{
+ package TestServer;
+ use base qw/
+ Test::HTTP::Server::Simple
+ CGI::Application::Server
+ /;
+}
+
+my $server = TestServer->new();
+$server->entry_points({
+ '/index.cgi' => 'TestApp',
+});
+my $url_root = $server->started_ok("start up my web server");
+
+my $mech = Test::WWW::Mechanize->new();
+
+$mech->get_ok($url_root . '/index.cgi/foo', '...got run mode foo');
+$mech->title_is('Hello world!', '... got the right page title for foo');
+
+$mech->get_ok($url_root . '/index.cgi/bar', '...got run mode bar');
+$mech->title_is('Goodbye world!', '... got the right page title for bar');
+
Added: branches/upstream/libcgi-application-server-perl/current/t/htdocs/index.html
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/htdocs/index.html?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/htdocs/index.html (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/htdocs/index.html Thu Sep 18 03:11:18 2008
@@ -1,0 +1,14 @@
+<HTML>
+<HEAD>
+ <LINK REL="stylesheet" HREF="test.css" TYPE="text/css">
+ <TITLE>Test Static Index Page</TITLE>
+ <SCRIPT LANGUAGE="javascript" SRC="test.js" />
+</HEAD>
+<BODY>
+<H1>Index</H1>
+<HR>
+<A HREF="javascript:greet()">Javascript Check</A>
+<BR>
+<A HREF="index.cgi?rm=mode1">CGI::Application Check</A>
+</BODY>
+</HTML>
Added: branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.css
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.css?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.css (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.css Thu Sep 18 03:11:18 2008
@@ -1,0 +1,4 @@
+H1 {
+ font-family: arial;
+ font-size: 60pt;
+};
Added: branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.js
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.js?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.js (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/htdocs/test.js Thu Sep 18 03:11:18 2008
@@ -1,0 +1,4 @@
+
+function greet () {
+ alert("Hello World");
+}
Added: branches/upstream/libcgi-application-server-perl/current/t/lib/AppWithParams.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/lib/AppWithParams.pm?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/lib/AppWithParams.pm (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/lib/AppWithParams.pm Thu Sep 18 03:11:18 2008
@@ -1,0 +1,24 @@
+package AppWithParams;
+
+use base 'CGI::Application';
+
+sub setup {
+ my $self = shift;
+ $self->start_mode('mode1');
+ $self->mode_param('rm');
+ $self->run_modes(
+ 'mode1' => 'a_run_mode',
+ );
+}
+
+sub a_run_mode {
+ my ($self) = @_;
+
+ return '<HTML><TITLE>'
+ . $self->param('message')
+ . '</TITLE><BODY><H1>'
+ . $self->param('message')
+ . "</H1><HR></BODY></HTML>";
+}
+
+1;
Added: branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp.pm?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp.pm (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp.pm Thu Sep 18 03:11:18 2008
@@ -1,0 +1,43 @@
+package MyCGIApp;
+
+use base 'CGI::Application';
+
+use CGI::Application::Plugin::Redirect;
+
+sub setup {
+ my $self = shift;
+ $self->start_mode('mode1');
+ $self->mode_param('rm');
+ $self->run_modes(
+ 'mode1' => 'hello_world',
+ 'mode2' => 'goodbye_world',
+ 'mode3' => 'redirected',
+ 'mode4' => 'redirect_end',
+ );
+}
+
+sub hello_world {
+ return "<HTML><TITLE>Hello</TITLE><BODY><H1>Hello World!</H1><HR>" .
+ "<A HREF='index.cgi?rm=mode2'>Goodbye</A>" .
+ "<A HREF='index.cgi?rm=mode3'>Redirected</A>" .
+ "</BODY></HTML>";
+}
+
+sub goodbye_world {
+ return "<HTML><TITLE>Goodbye</TITLE><BODY><H1>Goodbye World!</H1><HR>" .
+ "<A HREF='index.cgi?rm=mode1'>Hello</A>" .
+ "</BODY></HTML>";
+}
+
+sub redirected {
+ my $self = shift;
+ return $self->redirect( "/index.cgi?rm=mode4" );
+}
+
+sub redirect_end {
+ return "<HTML><TITLE>Redirect End</TITLE><BODY><H1>Redirected!</H1><HR>" .
+ "<A HREF='index.cgi?rm=mode1'>Back to Hello</A>" .
+ "</BODY></HTML>";
+}
+
+1;
Added: branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp/Dispatch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp/Dispatch.pm?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp/Dispatch.pm (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/lib/MyCGIApp/Dispatch.pm Thu Sep 18 03:11:18 2008
@@ -1,0 +1,15 @@
+use strict;
+use warnings;
+
+package MyCGIApp::Dispatch;
+use base 'CGI::Application::Dispatch';
+
+sub dispatch_args {
+ return {
+ table => [
+ '/foo/:rm' => { app => 'MyCGIApp' },
+ ]
+ }
+}
+
+1;
Added: branches/upstream/libcgi-application-server-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/pod.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/pod.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/pod.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+
+all_pod_files_ok();
Added: branches/upstream/libcgi-application-server-perl/current/t/pod_coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-server-perl/current/t/pod_coverage.t?rev=25303&op=file
==============================================================================
--- branches/upstream/libcgi-application-server-perl/current/t/pod_coverage.t (added)
+++ branches/upstream/libcgi-application-server-perl/current/t/pod_coverage.t Thu Sep 18 03:11:18 2008
@@ -1,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+
+all_pod_coverage_ok();
More information about the Pkg-perl-cvs-commits
mailing list