Merge branch 'release/1.3014'

CHANGES

@@ -1,3 +1,17 @@
+1.3014    04.03.2011
+
+    [ BUG FIXES ]
+    * YAML Session UTF-8 Fix
+      (Roman Galeev)
+    * Tests and documentations for Dancer::Request::Upload + type method in
+      Dancer::Request::Upload
+      (Michael G. Schwern)
+    * Dancer::Test::dancer_response handles correctly its 'body' parameter
+      We can now pass a hash ref as the body of dancer_response, it will
+      automatically be serialized as an URL-encoded string with the appropriate
+      content_type header.
+      (Alexis Sukrieh)
+
 1.3013    01.03.2011
 
     [ ENHANCEMENTS ]

lib/Dancer.pm

@@ -7,7 +7,7 @@ use Cwd 'realpath';
 
 use vars qw($VERSION $AUTHORITY @EXPORT);
 
-$VERSION   = '1.3013';
+$VERSION   = '1.3014';
 $AUTHORITY = 'SUKRIA';
 
 use Dancer::App;

lib/Dancer/FileUtils.pm

@@ -11,7 +11,7 @@ use Cwd 'realpath';
 use base 'Exporter';
 use vars '@EXPORT_OK';
 
-@EXPORT_OK = qw(path dirname read_file_content read_glob_content open_file);
+@EXPORT_OK = qw(path dirname read_file_content read_glob_content open_file set_file_mode);
 
 # Undo UNC special-casing catfile-voodoo on cygwin
 sub _trim_UNC {
@@ -54,15 +54,22 @@ sub path_no_verify {
 
 sub dirname { File::Basename::dirname(@_) }
 
+sub set_file_mode {
+    my ($fh) = @_;
+    require Dancer::Config;
+    my $charset = Dancer::Config::setting('charset') || 'utf-8';
+
+    if($charset) {
+        binmode($fh, ":encoding($charset)");
+    }
+    return $fh;
+}
+
 sub open_file {
     my ($mode, $filename) = @_;
-    require Dancer::Config;
-    my $charset = Dancer::Config::setting('charset');
-    length($charset || '')
-      and $mode .= ":encoding($charset)";
     open(my $fh, $mode, $filename)
       or croak "$! while opening '$filename' using mode '$mode'";
-    return $fh;
+    return set_file_mode($fh);
 }
 
 sub read_file_content {

lib/Dancer/Request/Upload.pm

@@ -58,6 +58,14 @@ sub basename {
     File::Basename::basename($self->filename);
 }
 
+sub type {
+    my $self = shift;
+
+    return $self->headers->{'Content-Type'};
+}
+
+
+
 # private
 
 =pod
@@ -112,6 +120,18 @@ false for failure.
 
     $upload->copy_to('/path/to/target')
 
+=item size
+
+The size of the upload, in bytes.
+
+=item headers
+
+Returns a hash ref of the headers associated with this upload.
+
+=item type
+
+The Content-Type of this upload.
+
 =back
 
 =head1 AUTHORS

lib/Dancer/Session/YAML.pm

@@ -8,7 +8,7 @@ use base 'Dancer::Session::Abstract';
 use Dancer::Logger;
 use Dancer::ModuleLoader;
 use Dancer::Config 'setting';
-use Dancer::FileUtils qw(path open_file);
+use Dancer::FileUtils qw(path set_file_mode);
 use File::Copy;
 use File::Temp qw(tempfile);
 
@@ -76,6 +76,7 @@ sub flush {
     my $self = shift;
     my ( $fh, $tmpname ) =
       tempfile( $self->id . '.XXXXXXXX', DIR => setting('session_dir') );
+    set_file_mode($fh);
     print {$fh} YAML::Dump($self);
     close $fh;
     move($tmpname, yaml_file($self->id));

lib/Dancer/Test.pm

@@ -183,9 +183,22 @@ sub dancer_response {
 
     if ($method =~ /^(?:PUT|POST)$/ && $args->{body}) {
         my $body = $args->{body};
-        my $l    = length $body;
+
+        # coerce hashref into an url-encoded string
+        if (ref($body) && (ref($body) eq 'HASH')) {
+            my @tokens;
+            while (my ($name, $value) = each %{$body}) {
+                $name  = _url_encode($name);
+                $value = _url_encode($value);
+                push @tokens, "${name}=${value}";
+            }
+            $body = join('&', @tokens);
+        }
+
+        my $l = length $body;
         open my $in, '<', \$body;
         $ENV{'CONTENT_LENGTH'} = $l;
+        $ENV{'CONTENT_TYPE'}   = 'application/x-www-form-urlencoded';
         $ENV{'psgi.input'}     = $in;
     }
 
@@ -224,6 +237,12 @@ sub get_response {
 
 # private
 
+sub _url_encode {
+    my $string = shift;
+    $string =~ s/([\W])/"%" . uc(sprintf("%2.2x",ord($1)))/eg;
+    return $string;
+}
+
 sub _get_file_response {
     my ($req) = @_;
     my ($method, $path, $params) = @$req;

t/02_request/14_uploads.t

@@ -13,7 +13,6 @@ sub test_path {
     is dirname($file), $dir, "dir of $file is $dir";
 }
 
-plan tests => 15;
 
 my $content = qq{------BOUNDARY
 Content-Disposition: form-data; name="test_upload_file"; filename="yappo.txt"
@@ -50,6 +49,8 @@ SHOGUN6
 $content =~ s/\r\n/\n/g;
 $content =~ s/\n/\r\n/g;
 
+plan tests => 17;
+
 do {
     open my $in, '<', \$content;
     my $req = Dancer::Request->new(
@@ -76,6 +77,15 @@ do {
     is $req->uploads->{'test_upload_file4'}[0]->content, 'SHOGUN4',
       "... content for other also good";
 
+    note "headers";
+    is_deeply $uploads[0]->headers, {
+        'Content-Disposition' => q[form-data; name="test_upload_file"; filename="yappo.txt"],
+        'Content-Type'        => 'text/plain',
+    };
+
+    note "type";
+    is $uploads[0]->type, 'text/plain';
+
     my $test_upload_file3 = $req->upload('test_upload_file3');
     is $test_upload_file3->content, 'SHOGUN3',
       "content for upload #3 as a scalar is good, via req->upload";
@@ -112,4 +122,3 @@ do {
 
     unlink($file) if ($^O eq 'MSWin32');
 };
-