r70534 - in /trunk/libdancer-perl: CHANGES META.yml debian/changelog lib/Dancer.pm lib/Dancer/FileUtils.pm lib/Dancer/Request/Upload.pm lib/Dancer/Session/YAML.pm lib/Dancer/Test.pm t/02_request/14_uploads.t

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Sat Mar 5 20:22:52 UTC 2011


Author: gregoa
Date: Sat Mar  5 20:22:43 2011
New Revision: 70534

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70534
Log:
New upstream release.

Modified:
    trunk/libdancer-perl/CHANGES
    trunk/libdancer-perl/META.yml
    trunk/libdancer-perl/debian/changelog
    trunk/libdancer-perl/lib/Dancer.pm
    trunk/libdancer-perl/lib/Dancer/FileUtils.pm
    trunk/libdancer-perl/lib/Dancer/Request/Upload.pm
    trunk/libdancer-perl/lib/Dancer/Session/YAML.pm
    trunk/libdancer-perl/lib/Dancer/Test.pm
    trunk/libdancer-perl/t/02_request/14_uploads.t

Modified: trunk/libdancer-perl/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/CHANGES?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/CHANGES (original)
+++ trunk/libdancer-perl/CHANGES Sat Mar  5 20:22:43 2011
@@ -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 ]

Modified: trunk/libdancer-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/META.yml?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/META.yml (original)
+++ trunk/libdancer-perl/META.yml Sat Mar  5 20:22:43 2011
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Dancer
-version:            1.3013
+version:            1.3014
 abstract:           A minimal-effort oriented web application framework
 author:  []
 license:            perl

Modified: trunk/libdancer-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/debian/changelog?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/debian/changelog (original)
+++ trunk/libdancer-perl/debian/changelog Sat Mar  5 20:22:43 2011
@@ -1,3 +1,9 @@
+libdancer-perl (1.3014+dfsg-1) UNRELEASED; urgency=low
+
+  * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org>  Sat, 05 Mar 2011 21:21:47 +0100
+
 libdancer-perl (1.3013+dfsg-1) unstable; urgency=low
 
   [ Jonathan Yu ]

Modified: trunk/libdancer-perl/lib/Dancer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/lib/Dancer.pm?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/lib/Dancer.pm (original)
+++ trunk/libdancer-perl/lib/Dancer.pm Sat Mar  5 20:22:43 2011
@@ -7,7 +7,7 @@
 
 use vars qw($VERSION $AUTHORITY @EXPORT);
 
-$VERSION   = '1.3013';
+$VERSION   = '1.3014';
 $AUTHORITY = 'SUKRIA';
 
 use Dancer::App;

Modified: trunk/libdancer-perl/lib/Dancer/FileUtils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/lib/Dancer/FileUtils.pm?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/lib/Dancer/FileUtils.pm (original)
+++ trunk/libdancer-perl/lib/Dancer/FileUtils.pm Sat Mar  5 20:22:43 2011
@@ -11,7 +11,7 @@
 use base 'Exporter';
 use vars '@EXPORT_OK';
 
- at EXPORT_OK = qw(path dirname read_file_content read_glob_content open_file);
+ at 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 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 {

Modified: trunk/libdancer-perl/lib/Dancer/Request/Upload.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/lib/Dancer/Request/Upload.pm?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/lib/Dancer/Request/Upload.pm (original)
+++ trunk/libdancer-perl/lib/Dancer/Request/Upload.pm Sat Mar  5 20:22:43 2011
@@ -58,6 +58,14 @@
     File::Basename::basename($self->filename);
 }
 
+sub type {
+    my $self = shift;
+
+    return $self->headers->{'Content-Type'};
+}
+
+
+
 # private
 
 =pod
@@ -112,6 +120,18 @@
 
     $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

Modified: trunk/libdancer-perl/lib/Dancer/Session/YAML.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/lib/Dancer/Session/YAML.pm?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/lib/Dancer/Session/YAML.pm (original)
+++ trunk/libdancer-perl/lib/Dancer/Session/YAML.pm Sat Mar  5 20:22:43 2011
@@ -8,7 +8,7 @@
 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 @@
     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));

Modified: trunk/libdancer-perl/lib/Dancer/Test.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/lib/Dancer/Test.pm?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/lib/Dancer/Test.pm (original)
+++ trunk/libdancer-perl/lib/Dancer/Test.pm Sat Mar  5 20:22:43 2011
@@ -183,9 +183,22 @@
 
     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;
     }
 
@@ -223,6 +236,12 @@
 }
 
 # 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) = @_;

Modified: trunk/libdancer-perl/t/02_request/14_uploads.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdancer-perl/t/02_request/14_uploads.t?rev=70534&op=diff
==============================================================================
--- trunk/libdancer-perl/t/02_request/14_uploads.t (original)
+++ trunk/libdancer-perl/t/02_request/14_uploads.t Sat Mar  5 20:22:43 2011
@@ -13,7 +13,6 @@
     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 @@
 $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(
@@ -75,6 +76,15 @@
     like $uploads[1]->content, qr|^SHOGUN|, "... content for second as well";
     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',
@@ -112,4 +122,3 @@
 
     unlink($file) if ($^O eq 'MSWin32');
 };
-




More information about the Pkg-perl-cvs-commits mailing list