Permalink
Browse files

Merge branch 'release/1.3011'

  • Loading branch information...
2 parents 61aa0c0 + 6c9fd85 commit 7df377b03af840de7940b3933054f3c09c10f6a2 Alexis Sukrieh committed Feb 14, 2011
Showing with 87 additions and 30 deletions.
  1. +17 −0 CHANGES
  2. +3 −5 lib/Dancer.pm
  3. +26 −5 lib/Dancer/FileUtils.pm
  4. +23 −11 lib/Dancer/Logger/File.pm
  5. +1 −1 lib/Dancer/Test.pm
  6. +7 −3 script/dancer
  7. +6 −4 t/01_config/03_logger.t
  8. +4 −1 t/12_response/06_filter_halt_status.t
View
17 CHANGES
@@ -1,3 +1,20 @@
+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 ]
View
@@ -3,11 +3,11 @@ package Dancer;
use strict;
use warnings;
use Carp;
-use Cwd 'abs_path', 'realpath';
+use Cwd 'realpath';
use vars qw($VERSION $AUTHORITY @EXPORT);
-$VERSION = '1.3010_01';
+$VERSION = '1.3011';
$AUTHORITY = 'SUKRIA';
use Dancer::Config;
@@ -30,7 +30,6 @@ use Dancer::Handler;
use Dancer::ModuleLoader;
use Dancer::MIME;
use File::Spec;
-use File::Basename 'basename';
use base 'Exporter';
@@ -186,7 +185,6 @@ sub load_app {
$app->prefix($options{prefix}) if $options{prefix};
$app->settings($options{settings}) if $options{settings};
-
# load the application
my ($package, $script) = caller;
_init($script);
@@ -240,7 +238,7 @@ sub _init {
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 = File::Spec->catdir($script_vol, $script_dirs);
+ my $script_path = Dancer::FileUtils::d_catdir($script_vol, $script_dirs);
my $LAYOUT_PRE_DANCER_1_2 = 1;
View
@@ -13,16 +13,37 @@ 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)
- return realpath(File::Spec->catdir(@nodes[0 .. ($#nodes - 1)])) . '/'
- . $nodes[-1];
+ 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(@_) }
@@ -44,7 +65,7 @@ sub read_file_content {
if ($file) {
$fh = open_file('<', $file);
-
+
return wantarray ? read_glob_content($fh) : scalar read_glob_content($fh);
}
else {
View
@@ -6,31 +6,43 @@ use base 'Dancer::Logger::Abstract';
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 $appdir = setting('appdir');
my $altpath = setting('log_path');
- my $logroot = $appdir || File::Spec->tmpdir();
- return ($altpath ? $altpath : path($logroot, 'logs'));
+ return $altpath if($altpath);
+ my $appdir = setting('appdir');
+ 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;
View
@@ -327,7 +327,7 @@ Asserts that the response content is equal to the C<$expected> string.
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)
View
@@ -60,7 +60,7 @@ sub validate_app_name {
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;
}
}
@@ -209,6 +209,7 @@ sub write_data_to_file {
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;
}
@@ -487,12 +488,14 @@ set apphandler => 'PSGI';
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;
@@ -505,10 +508,11 @@ set environment => 'production';
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" =>
View
@@ -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(debug($message), "debug sent");
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,14 +39,13 @@ unlink $logfile;
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');
ok(!debug($message), 'debug message is dropped');
@@ -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

0 comments on commit 7df377b

Please sign in to comment.