Merge branch 'devel'

AUTHORS

@@ -26,6 +26,7 @@ A huge thank you to all of them!
 
                 [ CONTRIBUTORS ]
 
+    a-adam <ac@univie.ac.at>
     Achim Adam <achim.adam@(none).com>
     Adam J. Foxson <afoxson@pobox.com>
     Akash Ayare <akash@hairynandgate.com>
@@ -36,14 +37,17 @@ A huge thank you to all of them!
     Andrei <dread.deimos@gmail.com>
     Anirvan Chatterjee <anirvan@base.mx.org>
     Anton Gerasimov <me@zyxmasta.com>
+    asergei <asergei@gmail.com>
     Ask Bjørn Hansen <ask@develooper.com>
+    Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>
     boris shomodjvarac <shomodj@oginwm09.(none)>
     Brian E. Lozier <brian@massassi.com>
     Brian Phillips <brian@thephillips.info>
     burnersk <burnersk@(none.com)>
     Chris Andrews <chrisandrews@venda.com>
     chromatic <chromatic@wgz.org>
     Colin Keith <colinmkeith@gmail.com>
+    Colin Kuskie <colink@perldreamer.com>
     Craig <craig.treptow@gmail.com>
     Craig Treptow <craig.treptow@gmail.com>
     Daniel Perett <daniel.perett@(none)>

CHANGES

@@ -1,5 +1,24 @@
 Revision history for Dancer
 
+1.3122 10.04.2014
+
+   [ DOCUMENTATION ]
+   * GH #995: Documentation improvements. (Colin Kuskie)
+
+   [ BUG FIXES ]
+   * Serializer::Mutable now consider 'Accept' before 'Content-Type'.
+    (GH#996, Bernhard Reutner-Fischer)
+   * Serializer::Mutable now correctly deals with content-types
+        with charsets. (GH#996, Bernhard Reutner-Fischer)
+   * Without Clone(), Dancer::Error::dumper() could clobber
+        values in deep structures. (GH#1006, fix by asergei)
+   * 'session_name' in Dancer::Session::Abstract couldn't be
+        redefined. (GH#1004, patch by Lee Carmichael)
+
+   [ MISC ]
+   * Unused function 'path_no_verify' removed. (GH#998, 
+        reported by mjemmeson)
+
 1.3121 2.02.2014
 
     [ ENHANCEMENTS ]

lib/Dancer.pm

@@ -5,7 +5,7 @@ use warnings;
 use Carp;
 use Cwd 'realpath';
 
-our $VERSION   = '1.3121';
+our $VERSION   = '1.3122';
 our $AUTHORITY = 'SUKRIA';
 
 $VERSION = eval $VERSION;

lib/Dancer/Error.pm

@@ -118,13 +118,16 @@ sub dumper {
 
 
     # Take a copy of the data, so we can mask sensitive-looking stuff:
-    my %data     = Dancer::ModuleLoader->load('Clone') ?
-                   %{ Clone::clone($obj) }             :
-                   %$obj;
-    my $censored = _censor(\%data);
+    my $data     = Dancer::ModuleLoader->load('Clone') ?
+                   Clone::clone($obj)
+                   : eval Data::Dumper->new([$obj])->Purity(1)->Terse(1)->Deepcopy(1)->Dump;
+
+    $data = {%$data} if blessed($data); 
+
+	my $censored = _censor($data);
 
     #use Data::Dumper;
-    my $dd = Data::Dumper->new([\%data]);
+    my $dd = Data::Dumper->new([$data]);
     $dd->Terse(1)->Quotekeys(0)->Indent(1)->Sortkeys(1);
     my $content = $dd->Dump();
     $content =~ s{(\s*)(\S+)(\s*)=>}{$1<span class="key">$2</span>$3 =&gt;}g;

lib/Dancer/FileUtils.pm

@@ -40,22 +40,6 @@ sub path_or_empty {
     return -e $path ? $path : '';
 }
 
-sub path_no_verify {
-    my @nodes = File::Spec->splitpath(d_catdir(@_)); # 0=vol,1=dirs,2=file
-    my $path = '';
-
-    # [0->?] path(must exist),[last] file(maybe exists)
-    if($nodes[1]) {
-        $path = realpath(File::Spec->catpath(@nodes[0 .. 1],'')) . '/';
-    } else {
-        $path = Cwd::cwd . '/';
-    }
-
-    $path .= $nodes[2];
-
-    return $path;
-}
-
 sub dirname { File::Basename::dirname(@_) }
 
 sub set_file_mode {

lib/Dancer/Handler.pm

@@ -154,8 +154,10 @@ sub render_response {
             $response->header( 'Content-Type' => "$ctype; charset=$charset" )
               if $ctype !~ /$charset/;
         }
-        $response->header( 'Content-Length' => length($content) )
-          if !defined $response->header('Content-Length');
+        if (!defined $response->header('Content-Length')) {
+            use bytes; # turn off character semantics
+            $response->header( 'Content-Length' => length($content) );
+        }
         $content = [$content];
     }
     else {

lib/Dancer/Request.pm

@@ -665,6 +665,10 @@ parameters to be added to the current request parameters, and the key
 C<options> that points to a hash of options about the redirect (for
 instance, C<method> pointing to a new request method).
 
+=head2 is_forward
+
+Flag that will be set to true if the request has been L<forwarded|forward>.
+
 =head2 to_string()
 
 Return a string representing the request object (eg: C<"GET /some/path">)
@@ -839,6 +843,10 @@ Return the value of the given header, if present. If the header has multiple
 values, returns an the list of values if called in list context, the first one
 in scalar.
 
+=head2 headers()
+
+Returns the L<HTTP::Header> object used to store all the headers.
+
 =head2 body()
 
 Return the raw body of the request, unparsed.

lib/Dancer/Response.pm

@@ -256,7 +256,7 @@ set or get the content of the current response object
     $response->status(201);
     Dancer::SharedData->response->status(201);
 
-set or get the status of the current response object
+Set or get the status of the current response object.  The default status is 200.
 
 =head2 content_type
 
@@ -268,14 +268,14 @@ set or get the status of the current response object
     $response->content_type('application/json');
     Dancer::SharedData->response->content_type('application/json');
 
-set or get the status of the current response object
+Set or get the status of the current response object.
 
 =head2 pass
 
     $response->pass;
     Dancer::SharedData->response->pass;
 
-set the pass value to one for this response
+Set the pass value to one for this response.
 
 =head2 has_passed
 
@@ -287,13 +287,15 @@ set the pass value to one for this response
         ...
     }
 
-test if the pass value is set to true
+Test if the pass value is set to true.
 
-=head2 halt
+=head2 halt($content)
 
     Dancer::SharedData->response->halt();
     $response->halt;
 
+Stops the processing of the current request.  See L<Dancer/halt>.
+
 =head2 halted
 
     if (Dancer::SharedData->response->halted) {
@@ -304,6 +306,8 @@ test if the pass value is set to true
         ...
     }
 
+This flag will be true if the current response has been halted.
+
 =head2 header
 
     # set the header
@@ -314,20 +318,20 @@ test if the pass value is set to true
     my $header = $response->header('X-Foo');
     my $header = Dancer::SharedData->response->header('X-Foo');
 
-get or set the value of a header
+Get or set the value of a header.
 
 =head2 headers
 
     $response->headers('X-Foo' => 'fff', 'X-Bar' => 'bbb');
     Dancer::SharedData->response->headers('X-Foo' => 'fff', 'X-Bar' => 'bbb');
 
-return the list of headers for the current response
+Return the list of headers for the current response.
 
 =head2 headers_to_array
 
     my $headers_psgi = $response->headers_to_array();
     my $headers_psgi = Dancer::SharedData->response->headers_to_array();
 
-this method is called before returning a L<< PSGI >> response. It transforms the list of headers to an array reference.
+This method is called before returning a L<< PSGI >> response. It transforms the list of headers to an array reference.
 
 

lib/Dancer/Serializer/Mutable.pm

@@ -22,7 +22,7 @@ my $_content_type;
 sub template_or_serialize {
     my( $template, $data ) = @_;
 
-    my( $content_type ) = @{ _find_content_type(Dancer::SharedData->request) };
+    my( $content_type ) = @{ _response_content_types(Dancer::SharedData->request) };
 
     # TODO the accept value coming from the browser can 
     # be quite complex (e.g., 
@@ -36,7 +36,7 @@ sub template_or_serialize {
     return $data;
 }
 
-sub _find_content_type {
+sub _request_content_types {
     my $request = shift;
 
     my $params;
@@ -45,28 +45,42 @@ sub _find_content_type {
         $params = $request->params;
     }
 
-    # first content type, second accept and final default
     # we push in @content_types by order of desirability
     # I.e.: we want $content_types[0] more than $content_types[1]
     my @content_types;
 
     my $method = $request->method;
 
-    if ($method =~ /^(?:POST|PUT|GET)$/) {
+    if ($method =~ /^(?:POST|PUT|GET|DELETE)$/) {
         push @content_types, $request->{content_type} 
             if $request->{content_type};
 
         push @content_types, $params->{content_type} 
             if $params && $params->{content_type};
     }
-
-    push @content_types, $request->{accept} 
+    push @content_types, 'application/json';
+
+    # remove duplicates
+    my %seen;
+    return [ grep { not $seen{$_}++ } @content_types ];
+}
+
+sub _response_content_types {
+    my $request = shift;
+    my @content_types;
+
+    push @content_types, $request->{accept}
         if $request->{accept};
-    
-    push @content_types, $request->{accept_type} 
+
+    push @content_types, $request->{accept_type}
         if $request->{'accept_type'};
 
-    push @content_types, 'application/json';
+    # Both above could be '*/*' which means it is our choice.
+
+    # Default to the same format as in the request:
+    for (@{_request_content_types($request)}) {
+        push @content_types, $_;
+    }
 
     # remove duplicates
     my %seen;
@@ -76,14 +90,16 @@ sub _find_content_type {
 sub serialize {
     my ($self, $entity) = @_;
     my $request    = Dancer::SharedData->request;
-    my $serializer = $self->_load_serializer($request);
+    my $content_types = _response_content_types($request);
+    my $serializer = $self->_load_serializer($request, $content_types);
     return $serializer->serialize($entity);
 }
 
 sub deserialize {
     my ($self, $content) = @_;
     my $request    = Dancer::SharedData->request;
-    my $serializer = $self->_load_serializer($request);
+    my $content_types = _request_content_types($request);
+    my $serializer = $self->_load_serializer($request, $content_types);
     return $serializer->deserialize($content);
 }
 
@@ -98,10 +114,12 @@ sub support_content_type {
 }
 
 sub _load_serializer {
-    my ($self, $request) = @_;
+    my ($self, $request, $content_types) = @_;
 
-    my $content_types = _find_content_type($request);
     foreach my $ct (@$content_types) {
+        # 'content_type' => 'text/xml; charset=utf-8'
+        my $oct = $ct;
+        $ct = (split ';', $ct)[0];
         if (exists $serializer->{$ct}) {
             my $module = "Dancer::Serializer::" . $serializer->{$ct};
             if (!exists $loaded_serializer->{$module}) {
@@ -110,7 +128,7 @@ sub _load_serializer {
                     $loaded_serializer->{$module} = $serializer_object;
                 }
             }
-            $_content_type = $ct;
+            $_content_type = $oct;
             return $loaded_serializer->{$module};
         }
     }

lib/Dancer/Session/Abstract.pm

@@ -83,15 +83,17 @@ sub build_id {
 }
 
 sub read_session_id {
-    my $name = session_name();
-    my $c = Dancer::Cookies->cookies->{$name};
+    my ($class) = @_;
+
+    my $name = $class->session_name();
+    my $c    = Dancer::Cookies->cookies->{$name};
     return (defined $c) ? $c->value : undef;
 }
 
 sub write_session_id {
     my ($class, $id) = @_;
 
-    my $name = session_name();
+    my $name = $class->session_name();
     my %cookie = (
         name   => $name,
         value  => $id,
@@ -131,8 +133,8 @@ needed to manipulate a session, whatever its storing engine is.
 
 =item B<id>
 
-The session id will be written to a cookie, by default named C<dancer.session>, 
-it is assumed that a client must accept cookies to be able to use a 
+The session id will be written to a cookie, by default named C<dancer.session>,
+it is assumed that a client must accept cookies to be able to use a
 session-aware Dancer webapp. (The cookie name can be change using the
 C<session_name> config setting.)
 

lib/Dancer/Test.pm

@@ -365,6 +365,15 @@ sub dancer_response {
         $extra_env->{'CONTENT_TYPE'} = $headers->header('Content-Type');
     }
 
+    # handle all the keys of Request::_build_request_env():
+    for my $key (qw( user_agent host accept_language accept_charset
+        accept_encoding keep_alive connection accept accept_type referer
+        x_requested_with )) {
+        my $k = sprintf("HTTP_%s", uc $key);
+        $extra_env->{$k} = $headers->{$key}
+            if exists $headers->{$key};
+    }
+
     # fake the REQUEST_URI
     # TODO deal with the params
     unless( $extra_env->{REQUEST_URI} ) {