Merge branch 'release/1.3011'

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 ]

lib/Dancer.pm

@@ -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;
 

lib/Dancer/FileUtils.pm

@@ -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 {

lib/Dancer/Logger/File.pm

@@ -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;

lib/Dancer/Test.pm

@@ -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)

script/dancer

@@ -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" =>
 

t/01_config/03_logger.t

@@ -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');

t/12_response/06_filter_halt_status.t

@@ -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