view release on metacpan or  search on metacpan

lib/Dancer/Handler.pm  view on Meta::CPAN

sub init_request_headers {
    my ($self, $env) = @_;

    my $psgi_headers = HTTP::Headers->new(
        map {
            (my $field = $_) =~ s/^HTTPS?_//;
            ($field => $env->{$_});
          }
          grep {/^(?:HTTP|CONTENT|COOKIE)/i} keys %$env
    );
    Dancer::SharedData->headers($psgi_headers);
}

# render a PSGI-formatted response from a response built by
# handle_request()
sub render_response {
    my $self     = shift;
    my $response = Dancer::SharedData->response();

    my $content = $response->content;

    unless ( ref($content) eq 'GLOB' ) {
        my $charset = setting('charset');
        my $ctype   = $response->header('Content-Type');

        if ( $charset && $ctype && _is_text($ctype) ) {
            $content = Encode::encode( $charset, $content ) unless $response->_already_encoded;
            $response->header( 'Content-Type' => "$ctype; charset=$charset" )
              if $ctype !~ /$charset/;
        }
        if (!defined $response->header('Content-Length')) {
            use bytes; # turn off character semantics
            $response->header( 'Content-Length' => length($content) );
        }
        $content = [$content];
    }
    else {
        if ( !defined $response->header('Content-Length') ) {
            my $stat = stat $content;
            $response->header( 'Content-Length' => $stat->size );
        }
    }

    # drop content if request is HEAD
    $content = ['']
      if ( defined Dancer::SharedData->request
        && Dancer::SharedData->request->is_head() );

    # drop content AND content_length if response is 1xx or (2|3)04
    if ($response->status =~ (/^[23]04$/ )) {
        $content = [''];
        $response->header('Content-Length' => 0);
    }

    Dancer::Logger::core("response: " . $response->status);

    my $status  = $response->status();
    my $headers = $response->headers_to_array();

    # reverse streaming
    if ( ref $response->streamed and ref $response->streamed eq 'CODE' ) {
        return $response->streamed->(
            $status, $headers
        );
    }

    return [ $status, $headers, $content ];
}

sub _is_text {
    my ($content_type) = @_;
    return $content_type =~ /(\bx(?:ht)?ml\b|text|json|javascript)/;
}

# Fancy banner to print on startup
sub print_banner {
    if (setting('startup_info')) {
        my $env = setting('environment');
        print "== Entering the $env dance floor ...\n";
    }
}

sub dance { (shift)->start(@_) }

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Dancer::Handler - Dancer request handler

=head1 VERSION

version 1.3521

=head1 AUTHOR

Dancer Core Developers

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2010 by Alexis Sukrieh.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut