r69051 - in /branches/upstream/libdancer-perl/current: ./ lib/ lib/Dancer/ lib/Dancer/Logger/ lib/Dancer/Request/ script/ t/01_config/ t/02_request/ t/03_route_handler/ t/04_static_file/ t/12_response/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Feb 19 03:29:50 UTC 2011
Author: jawnsy-guest
Date: Sat Feb 19 03:28:40 2011
New Revision: 69051
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=69051
Log:
[svn-upgrade] new version libdancer-perl (1.3011+dfsg)
Added:
branches/upstream/libdancer-perl/current/t/03_route_handler/31_infinite_loop.t
branches/upstream/libdancer-perl/current/t/04_static_file/003_mime_types_reinit.t
Modified:
branches/upstream/libdancer-perl/current/CHANGES
branches/upstream/libdancer-perl/current/MANIFEST
branches/upstream/libdancer-perl/current/META.yml
branches/upstream/libdancer-perl/current/lib/Dancer.pm
branches/upstream/libdancer-perl/current/lib/Dancer/FileUtils.pm
branches/upstream/libdancer-perl/current/lib/Dancer/Logger/File.pm
branches/upstream/libdancer-perl/current/lib/Dancer/MIME.pm
branches/upstream/libdancer-perl/current/lib/Dancer/Plugins.pod
branches/upstream/libdancer-perl/current/lib/Dancer/Renderer.pm
branches/upstream/libdancer-perl/current/lib/Dancer/Request/Upload.pm
branches/upstream/libdancer-perl/current/lib/Dancer/Test.pm
branches/upstream/libdancer-perl/current/script/dancer
branches/upstream/libdancer-perl/current/t/01_config/03_logger.t
branches/upstream/libdancer-perl/current/t/02_request/14_uploads.t
branches/upstream/libdancer-perl/current/t/12_response/06_filter_halt_status.t
Modified: branches/upstream/libdancer-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/CHANGES?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/CHANGES (original)
+++ branches/upstream/libdancer-perl/current/CHANGES Sat Feb 19 03:28:40 2011
@@ -1,3 +1,43 @@
+1.3011 14.02.2011
+
+ [ BUG FIXES ]
+ * Set binmode in write_data_to_file() to fix image corruption in
+ Windows
+ (Rowan Thorpe)
+ * GH#319, GH#278, GH#276, GH#217: Fix file issues on Cygwin and
+ Win32 platforms
+ (Rowan Thorpe)
+ * GH#322: Detect errors in scaffolded dispatchers
+ (Alberto Simões)
+ * Fix tests so that they don't fail if JSON is not installed
+ (Damien Krotkine)
+
+ [ DOCUMENTATION ]
+ * Small spaces fix (Alberto Simões).
+
+1.3010_01 12.02.2011
+
+ [ BUG FIXES ]
+ * GH#136: fix again Mime::Type issues in preforking environment
+ (Chris Andrews)
+ * GH#220: fix for path issues under MacOS X and Windows platforms.
+ A new function is provided by Dancer::FileUtils: path_no_verify()
+ (Rowan Thorpe)
+ * Fix for infinite loops detection in before filters
+ (Flavio Poletti)
+
+ [ ENHANCEMENTS ]
+ * Better detection of the application layout under non-UNIX platforms.
+ (Rowan Thorpe, Alexis Sukrieh)
+
+ [ DOCUMENTATION ]
+ * Fix a typo in Dancer::Request::Upload's POD
+ (Rowan Thorpe)
+ * Better documentation for the before filters, explanations about the
+ potential infinite loops that can happen when using before filters (and
+ what Dancer does in that case).
+ (Flavio Poletti)
+
1.3010 10.02.2011
[ BUG FIXES ]
Modified: branches/upstream/libdancer-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/MANIFEST?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/MANIFEST (original)
+++ branches/upstream/libdancer-perl/current/MANIFEST Sat Feb 19 03:28:40 2011
@@ -151,10 +151,12 @@
t/03_route_handler/29_forward.t
t/03_route_handler/29_redirect_immediately.t
t/03_route_handler/30_bug_gh190.t
+t/03_route_handler/31_infinite_loop.t
t/03_route_handler/public/404.html
t/03_route_handler/views/hello.tt
t/04_static_file/001_base.t
t/04_static_file/002_mime_types.t
+t/04_static_file/003_mime_types_reinit.t
t/04_static_file/03_get_mime_type.t
t/04_static_file/static/hello.foo
t/04_static_file/static/hello.txt
Modified: branches/upstream/libdancer-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/META.yml?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/META.yml (original)
+++ branches/upstream/libdancer-perl/current/META.yml Sat Feb 19 03:28:40 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Dancer
-version: 1.3010
+version: 1.3011
abstract: A minimal-effort oriented web application framework
author: []
license: perl
Modified: branches/upstream/libdancer-perl/current/lib/Dancer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer.pm?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer.pm (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer.pm Sat Feb 19 03:28:40 2011
@@ -3,11 +3,11 @@
use strict;
use warnings;
use Carp;
-use Cwd 'abs_path', 'realpath';
+use Cwd 'realpath';
use vars qw($VERSION $AUTHORITY @EXPORT);
-$VERSION = '1.3010';
+$VERSION = '1.3011';
$AUTHORITY = 'SUKRIA';
use Dancer::Config;
@@ -30,7 +30,6 @@
use Dancer::ModuleLoader;
use Dancer::MIME;
use File::Spec;
-use File::Basename 'basename';
use base 'Exporter';
@@ -186,7 +185,6 @@
$app->prefix($options{prefix}) if $options{prefix};
$app->settings($options{settings}) if $options{settings};
-
# load the application
my ($package, $script) = caller;
_init($script);
@@ -235,14 +233,19 @@
sub _init {
- my $script = shift;
- my $script_path = File::Spec->rel2abs(path(dirname($script)));
+ my $script = shift;
+
+ my ($script_vol, $script_dirs, $script_name) =
+ File::Spec->splitpath(File::Spec->rel2abs($script));
+ my @script_dirs = File::Spec->splitdir($script_dirs);
+ my $script_path = Dancer::FileUtils::d_catdir($script_vol, $script_dirs);
my $LAYOUT_PRE_DANCER_1_2 = 1;
+
+ # in bin/ or public/ we need to go one level upper to find the appdir
$LAYOUT_PRE_DANCER_1_2 = 0
- if ( basename($script) eq 'app.pl'
- || basename($script) eq 'dispatch.cgi'
- || basename($script) eq 'dispatch.fcgi');
+ if ($script_dirs[$#script_dirs - 1] eq 'bin')
+ or ($script_dirs[$#script_dirs - 1] eq 'public');
setting appdir => $ENV{DANCER_APPDIR}
|| (
@@ -261,14 +264,14 @@
|| setting('appdir');
setting public => $ENV{DANCER_PUBLIC}
- || path(setting('appdir'), 'public');
+ || Dancer::FileUtils::path_no_verify(setting('appdir'), 'public');
setting views => $ENV{DANCER_VIEWS}
- || path(setting('appdir'), 'views');
+ || Dancer::FileUtils::path_no_verify(setting('appdir'), 'views');
setting logger => 'file';
- my ($res, $error) = Dancer::ModuleLoader->use_lib(path(setting('appdir'), 'lib'));
+ my ($res, $error) = Dancer::ModuleLoader->use_lib(Dancer::FileUtils::path_no_verify(setting('appdir'), 'lib'));
$res or croak "unable to set libdir : $error";
}
@@ -374,7 +377,16 @@
};
The anonymous function which is given to C<before> will be executed before
-looking for a route handler to handle the request.
+executing a route handler to handle the request.
+
+If the function modifies the request's C<path_info> or C<method>, a new
+search for a matching route is performed and the filter is re-executed
+again. Considering that this can lead to an infinite loop, this mechanism
+is stopped after 10 times with an exception.
+
+The before filter can set a response with a redirection code (either
+301 or 302): in this case the matched route (if any) will be ignored and the
+redirection will be performed immediately.
You can define multiple before filters, using the C<before> helper as
many times as you wish; each filter will be executed in the order you added
Modified: branches/upstream/libdancer-perl/current/lib/Dancer/FileUtils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer/FileUtils.pm?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer/FileUtils.pm (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer/FileUtils.pm Sat Feb 19 03:28:40 2011
@@ -6,13 +6,46 @@
use File::Basename ();
use File::Spec;
use Carp;
+use Cwd 'realpath';
use base 'Exporter';
use vars '@EXPORT_OK';
@EXPORT_OK = qw(path dirname read_file_content read_glob_content open_file);
-sub path { File::Spec->catfile(@_) }
+# Undo UNC special-casing catfile-voodoo on cygwin in the next three functions
+sub d_catfile {
+ my $root = shift;
+ $root =~ s{^[/\\]+([/\\])}{$1};
+ File::Spec->catfile($root, @_);
+}
+sub d_catdir {
+ my $root = shift;
+ $root =~ s{^[/\\]+([/\\])}{$1};
+ File::Spec->catdir($root, @_);
+}
+sub d_canonpath {
+ my $root = shift;
+ $root =~ s{^[/\\]+([/\\])}{$1};
+ File::Spec->canonpath($root, @_);
+}
+
+sub path { d_catfile(@_) }
+
+sub path_no_verify {
+ my @nodes = @_;
+ my $path = '';
+
+ # [0->?] path(must exist),[last] file(maybe exists)
+ if($#nodes > 0) {
+ $path = realpath(d_catdir(@nodes[0 .. ($#nodes - 1)])).'/';
+ } elsif(not File::Spec->file_name_is_absolute($nodes[0])) {
+ $path = Cwd::cwd.'/';
+ }
+ $path .= d_canonpath($nodes[$#nodes]);
+ return $path;
+}
+
sub dirname { File::Basename::dirname(@_) }
sub open_file {
@@ -32,7 +65,7 @@
if ($file) {
$fh = open_file('<', $file);
-
+
return wantarray ? read_glob_content($fh) : scalar read_glob_content($fh);
}
else {
Modified: branches/upstream/libdancer-perl/current/lib/Dancer/Logger/File.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer/Logger/File.pm?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer/Logger/File.pm (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer/Logger/File.pm Sat Feb 19 03:28:40 2011
@@ -6,31 +6,43 @@
use File::Spec;
use Dancer::Config 'setting';
-use Dancer::FileUtils qw(path open_file);
+use Dancer::FileUtils qw(open_file);
use IO::File;
sub logdir {
+ my $altpath = setting('log_path');
+ return $altpath if($altpath);
my $appdir = setting('appdir');
- my $altpath = setting('log_path');
- my $logroot = $appdir || File::Spec->tmpdir();
- return ($altpath ? $altpath : path($logroot, 'logs'));
+ my $logroot = $appdir;
+ unless($logroot) {
+ $logroot = Dancer::FileUtils::d_canonpath(File::Spec->tmpdir().'/dancer-'.$$);
+ if (!-d $logroot and not mkdir $logroot) {
+ carp "log directory $logroot doesn't exist, unable to create";
+ return;
+ }
+ }
+ return Dancer::FileUtils::path_no_verify($logroot, 'logs');
}
sub init {
my ($self) = @_;
my $logdir = logdir();
- if (!-d $logdir) {
- if (not mkdir $logdir) {
- carp "log directory $logdir doesn't exist, unable to create";
- return;
- }
+ if (!-d $logdir && not mkdir $logdir) {
+ carp "log directory $logdir doesn't exist, unable to create";
+ return;
+ }
+ if (!-w $logdir or !-x $logdir) {
+ my $perm = (stat $logdir)[2] & 07777;
+ chmod($perm | 0700, $logdir);
+ carp "log directory $logdir isn't writable/executable, can't chmod it";
+ return;
}
my $logfile = setting('environment');
- $logfile = path($logdir, "$logfile.log");
+ $logfile = Dancer::FileUtils::path_no_verify($logdir, "$logfile.log");
- my $fh = open_file('>>', $logfile);
+ my $fh = open_file('>>', $logfile) or carp "unable to create or append to $logfile";
$fh->autoflush;
$self->{logfile} = $logfile;
Modified: branches/upstream/libdancer-perl/current/lib/Dancer/MIME.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer/MIME.pm?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer/MIME.pm (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer/MIME.pm Sat Feb 19 03:28:40 2011
@@ -5,6 +5,15 @@
use base 'Dancer::Object::Singleton';
use MIME::Types;
+
+# Initialise MIME::Types at compile time, to ensure it's done before
+# the fork in a preforking webserver like mod_perl or Starman. Not
+# doing this leads to all MIME types being returned as "text/plain",
+# as MIME::Types fails to load its mappings from the DATA handle. See
+# t/04_static_file/003_mime_types_reinit.t and GH#136.
+BEGIN {
+ MIME::Types->new(only_complete => 1);
+}
__PACKAGE__->attributes( qw/mime_type aliases/ );
Modified: branches/upstream/libdancer-perl/current/lib/Dancer/Plugins.pod
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer/Plugins.pod?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer/Plugins.pod (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer/Plugins.pod Sat Feb 19 03:28:40 2011
@@ -26,7 +26,7 @@
Provides easy acces to DBIx::Class database virtualization.
-=item L<Dancer::Plugin::Authorize>
+=item L<Dancer::Plugin::Auth::RBAC>
Dancer Authentication, Security and Role-Based Access Control Framework.
Modified: branches/upstream/libdancer-perl/current/lib/Dancer/Renderer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer/Renderer.pm?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer/Renderer.pm (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer/Renderer.pm Sat Feb 19 03:28:40 2011
@@ -83,7 +83,7 @@
}
sub get_action_response {
- my $response;
+ my $depth = shift || 1;
# save the request before the filters are ran
my $request = Dancer::SharedData->request;
@@ -99,19 +99,17 @@
$_->() for @{$app->registry->hooks->{before}};
# recurse if something has changed
- my $limit = 0;
my $MAX_RECURSIVE_LOOP = 10;
if ( ($path ne Dancer::SharedData->request->path_info)
|| ($method ne Dancer::SharedData->request->method))
{
- $limit++;
- if ($limit > $MAX_RECURSIVE_LOOP) {
+ if ($depth > $MAX_RECURSIVE_LOOP) {
croak "infinite loop detected, "
. "check your route/filters for "
. $method . ' '
. $path;
}
- return get_action_response();
+ return get_action_response($depth + 1);
}
# redirect immediately - skip route execution
@@ -130,7 +128,7 @@
# else, get the route handler's response
Dancer::App->current($handler->app);
- $response = $handler->run($request);
+ my $response = $handler->run($request);
$response = serialize_response_if_needed($response);
$_->($response) for (@{$app->registry->hooks->{after}});
return $response;
Modified: branches/upstream/libdancer-perl/current/lib/Dancer/Request/Upload.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer/Request/Upload.pm?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer/Request/Upload.pm (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer/Request/Upload.pm Sat Feb 19 03:28:40 2011
@@ -110,7 +110,7 @@
Copies the temporary file using File::Copy. Returns true for success,
false for failure.
- $upload->copy_to('/path/to/targe')
+ $upload->copy_to('/path/to/target')
=back
Modified: branches/upstream/libdancer-perl/current/lib/Dancer/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/lib/Dancer/Test.pm?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/lib/Dancer/Test.pm (original)
+++ branches/upstream/libdancer-perl/current/lib/Dancer/Test.pm Sat Feb 19 03:28:40 2011
@@ -327,7 +327,7 @@
Asserts that the response content is not equal to the C<$not_expected> string.
- response_content_is [GET => '/'], "Hello, World",
+ response_content_isnt [GET => '/'], "Hello, World",
"got expected response content for GET /";
=head2 response_content_is_deeply([$method, $path], $expected_struct, $test_name)
Modified: branches/upstream/libdancer-perl/current/script/dancer
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/script/dancer?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/script/dancer (original)
+++ branches/upstream/libdancer-perl/current/script/dancer Sat Feb 19 03:28:40 2011
@@ -60,7 +60,7 @@
if ($name =~ /[^\w:]/ || $name =~ /^\d/ || $name =~ /\b:\b|:{3,}/) {
print STDERR "Error: Invalid application name.\n";
print STDERR "Application names must not contain colons,"
- ." dots or start with a number.\n";
+ ." dots or start with a number.\n";
exit;
}
}
@@ -206,6 +206,7 @@
my ($data, $path) = @_;
open(my $fh, '>', $path)
or warn "Failed to write favicon to $path - $!" and return;
+ binmode($fh);
print {$fh} unpack 'u*', $data;
close $fh;
}
@@ -482,12 +483,14 @@
set environment => 'production';
my \$psgi = path(\$RealBin, '..', 'bin', 'app.pl');
+die \"Unable to read startup script: \$psgi\" unless -r \$psgi;
+
Plack::Runner->run(\$psgi);
",
"dispatch.fcgi" =>
-"$PERL_INTERPRETER
+qq{$PERL_INTERPRETER
use Dancer ':syntax';
use FindBin '\$RealBin';
use Plack::Handler::FCGI;
@@ -500,10 +503,11 @@
my \$psgi = path(\$RealBin, '..', 'bin', 'app.pl');
my \$app = do(\$psgi);
+die "Unable to read startup script: \$@" if \$@;
my \$server = Plack::Handler::FCGI->new(nproc => 5, detach => 1);
\$server->run(\$app);
-",
+},
"app.pl" =>
Modified: branches/upstream/libdancer-perl/current/t/01_config/03_logger.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/t/01_config/03_logger.t?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/t/01_config/03_logger.t (original)
+++ branches/upstream/libdancer-perl/current/t/01_config/03_logger.t Sat Feb 19 03:28:40 2011
@@ -1,8 +1,11 @@
use Test::More tests => 15, import => ['!pass'];
use Dancer ':syntax';
+use Dancer::FileUtils;
use File::Temp qw/tempdir/;
+use File::Spec qw/catfile/;
+
my $dir = tempdir(CLEANUP => 1);
set appdir => $dir;
@@ -17,10 +20,10 @@
ok(warning($message), "warning sent");
ok(error($message), "error sent");
-my $logdir = path(setting('appdir'), 'logs');
+my $logdir = Dancer::FileUtils::path_no_verify(setting('appdir'), 'logs');
ok((-d $logdir), "log directory exists");
-my $logfile = path($logdir, "development.log");
+my $logfile = Dancer::FileUtils::d_catfile($logdir, "development.log");
ok((-r $logfile), "logfile exists");
open LOGFILE, '<', $logfile;
@@ -36,13 +39,12 @@
set environment => 'test';
logger 'file';
-$logfile = path($logdir, "test.log");
+$logfile = Dancer::FileUtils::d_catfile($logdir, "test.log");
ok((-r $logfile), "environment logfile exists");
open LOGFILE, '<', $logfile;
@content = <LOGFILE>;
close LOGFILE;
-
ok(set(log => 'warning'), 'log level set to warning');
Modified: branches/upstream/libdancer-perl/current/t/02_request/14_uploads.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/t/02_request/14_uploads.t?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/t/02_request/14_uploads.t (original)
+++ branches/upstream/libdancer-perl/current/t/02_request/14_uploads.t Sat Feb 19 03:28:40 2011
@@ -3,6 +3,7 @@
use Dancer ':syntax';
use Dancer::Request;
+use Dancer::FileUtils;
use Test::More 'import' => ['!pass'];
@@ -95,11 +96,11 @@
$upload->copy_to($dest_file);
ok( ( -f $dest_file ), "file '$dest_file' has been copied" );
+ $upload->link_to( Dancer::FileUtils::path_no_verify( $dest_dir, "hardlink" ) );
+ ok( ( -f Dancer::FileUtils::path_no_verify( $dest_dir, "hardlink" ) ), "hardlink is created" );
+
SKIP: {
- skip "bogus upload tests on win32", 3 if ( $^O eq 'MSWin32' or $^O eq 'cygwin' );
-
- $upload->link_to( path( $dest_dir, "hardlink" ) );
- ok( ( -f path( $dest_dir, "hardlink" ) ), "hardlink is created" );
+ skip "bogus upload tests on win32", 2 if ( $^O eq 'MSWin32' or $^O eq 'cygwin' );
# make sure cleanup is performed when the HTTP::Body object is purged
my $file = $upload->tempname;
Added: branches/upstream/libdancer-perl/current/t/03_route_handler/31_infinite_loop.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/t/03_route_handler/31_infinite_loop.t?rev=69051&op=file
==============================================================================
--- branches/upstream/libdancer-perl/current/t/03_route_handler/31_infinite_loop.t (added)
+++ branches/upstream/libdancer-perl/current/t/03_route_handler/31_infinite_loop.t Sat Feb 19 03:28:40 2011
@@ -1,0 +1,26 @@
+use strict;
+use warnings;
+
+use Test::More tests => 7, import => ['!pass'];
+use Dancer ':syntax';
+use Dancer::Test;
+
+my $i = 0;
+
+
+ok(get('/:id', sub { "whatever " . params->{id} }), 'installed basic route handler');
+
+route_exists [GET => '/:id'];
+response_status_is [GET => "/$i"], 200, 'before not installed yet, response status is 200 looks good for GET /0';
+response_content_is [GET => "/$i"], "whatever $i";
+
+ok(
+ before(
+ sub {
+ ++$i;
+ request->path_info("/$i");
+ }
+ ), 'installed before hook',
+);
+ok(! eval { dancer_response(GET => "/$i") }, 'before messes all up, route not OK any more');
+like($@, qr{infinite loop}, 'infinite loop detected');
Added: branches/upstream/libdancer-perl/current/t/04_static_file/003_mime_types_reinit.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/t/04_static_file/003_mime_types_reinit.t?rev=69051&op=file
==============================================================================
--- branches/upstream/libdancer-perl/current/t/04_static_file/003_mime_types_reinit.t (added)
+++ branches/upstream/libdancer-perl/current/t/04_static_file/003_mime_types_reinit.t Sat Feb 19 03:28:40 2011
@@ -1,0 +1,46 @@
+use strict;
+use warnings;
+
+use IO::Handle;
+
+use Dancer::MIME;
+use Dancer ':syntax';
+use Dancer::ModuleLoader;
+
+use Test::More import => ['!pass'];
+
+plan tests => 3;
+
+# Test that MIME::Types gets initialised before the fork, as it'll
+# fail to read from DATA in all bar one child process in a
+# mod_perl-type preforking situation.
+#
+# See the comment near the top of Dancer/MIME.pm, and GH#136.
+
+my @cts;
+for (my $i = 0; $i < 3; $i++) {
+ my ($p, $c) = (IO::Handle->new, IO::Handle->new);
+ pipe($p, $c);
+
+ if (my $pid = fork()) {
+ # parent
+ $c->close;
+ my $ct = $p->getline;
+ $p->close();
+ waitpid($pid, 0);
+ push @cts, $ct;
+ }
+ else {
+ # child
+ $p->close;
+ my $mime = Dancer::MIME->instance();
+ my $type = $mime->mime_type_for('css');
+ $c->print($type);
+ $c->close;
+ exit 0;
+ }
+}
+
+ok($cts[0] eq 'text/css');
+ok($cts[1] eq 'text/css');
+ok($cts[2] eq 'text/css');
Modified: branches/upstream/libdancer-perl/current/t/12_response/06_filter_halt_status.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdancer-perl/current/t/12_response/06_filter_halt_status.t?rev=69051&op=diff
==============================================================================
--- branches/upstream/libdancer-perl/current/t/12_response/06_filter_halt_status.t (original)
+++ branches/upstream/libdancer-perl/current/t/12_response/06_filter_halt_status.t Sat Feb 19 03:28:40 2011
@@ -1,6 +1,9 @@
use strict;
use warnings;
-use Test::More;
+use Test::More import => ['!pass'];;
+
+plan skip_all => "JSON is needed to run this tests"
+ unless Dancer::ModuleLoader->load('JSON');
# make sure we keep the status when halt is used
More information about the Pkg-perl-cvs-commits
mailing list