view release on metacpan or  search on metacpan

lib/Dancer.pm  view on Meta::CPAN

      or ($script_dirs[$#script_dirs - 1] eq 't');

    my $appdir = $ENV{DANCER_APPDIR} || (
          $LAYOUT_PRE_DANCER_1_2
        ? $script_path
        : File::Spec->rel2abs(Dancer::path($script_path, '..'))
    );
    Dancer::setting(appdir => $appdir);

    # once the dancer_appdir have been defined, we export to env
    $ENV{DANCER_APPDIR} = $appdir;

    Dancer::Logger::core("initializing appdir to: `$appdir'");

    Dancer::setting(confdir => $ENV{DANCER_CONFDIR}
      || $appdir) unless Dancer::setting('confdir');

    Dancer::setting(public => $ENV{DANCER_PUBLIC}
      || Dancer::FileUtils::path($appdir, 'public'));

    Dancer::setting(views => $ENV{DANCER_VIEWS}
      || Dancer::FileUtils::path($appdir, 'views'));

    my ($res, $error) = Dancer::ModuleLoader->use_lib(Dancer::FileUtils::path($appdir, 'lib'));
    $res or raise core => "unable to set libdir : $error";
}


# Scheme grammar as defined in RFC 2396
#  scheme = alpha *( alpha | digit | "+" | "-" | "." )
my $scheme_re = qr{ [a-z][a-z0-9\+\-\.]* }ix;
sub _redirect {
    my ($destination, $status) = @_;

    # RFC 2616 requires an absolute URI with a scheme,
    # turn the URI into that if it needs it
    if ($destination !~ m{^ $scheme_re : }x) {
        my $request = Dancer::SharedData->request;
        $destination = $request->uri_for($destination, {}, 1);
    }
    my $response = Dancer::SharedData->response;
    $response->status($status || 302);
    $response->headers('Location' => $destination);
}

sub _session {
    engine 'session'
      or raise core => "Must specify session engine in settings prior to using 'session' keyword";
      @_ == 0 ? Dancer::Session->get
    : @_ == 1 ? Dancer::Session->read(@_)
    :           Dancer::Session->write(@_);
}

sub _send_file {
    my ($path, %options) = @_;
    my $env = Dancer::SharedData->request->env;

    my $request = Dancer::Request->new_for_request('GET' => $path);
    Dancer::SharedData->request($request);

    # if you asked for streaming but it's not supported in PSGI
    if ( $options{'streaming'} && ! $env->{'psgi.streaming'} ) {
        # TODO: throw a fit (AKA "exception") or a Dancer::Error?
        raise core => 'Sorry, streaming is not supported on this server.';
    }

    if (exists($options{content_type})) {
        $request->content_type($options{content_type});
    }

    # If we're given an IO::Scalar object, DTRT (take the scalar ref from it)
    if (Scalar::Util::blessed($path) && $path->isa('IO::Scalar')) {
        $path = $path->sref;
    }

    my $resp;
    if (ref($path) eq "SCALAR") {
        # send_data
        $resp = Dancer::SharedData->response() || Dancer::Response->new();
        $resp->header('Content-Type' => exists($options{content_type}) ?
                                        $options{content_type} : Dancer::MIME->default());
        $resp->content($$path);
    } else {
        # real send_file
        if ($options{system_path} && -f $path) {
            $resp = Dancer::Renderer->get_file_response_for_path($path);
        } else {
            $resp = Dancer::Renderer->get_file_response();
        }
    }

    if ($resp) {

        if (exists($options{filename})) {
            $resp->push_header('Content-Disposition' => 
                "attachment; filename=\"$options{filename}\""
            );
        }

        if ( $options{'streaming'} ) {
            # handle streaming
            $resp->streamed( sub {
                my ( $status, $headers ) = @_;
                my %callbacks = defined $options{'callbacks'} ?
                                %{ $options{'callbacks'} }    :
                                ();

                return sub {
                    my $respond = shift;
                    exists $callbacks{'override'}
                        and return $callbacks{'override'}->( $respond, $resp );

                    # get respond callback and set headers, get writer in return
                    my $writer = $respond->( [
                        $status,
                        $headers,
                    ] );

                    # get content from original response
                    my $content = $resp->content;

                    exists $callbacks{'around'}
                        and return $callbacks{'around'}->( $writer, $content );

                    if ( ref $content ) {
                        my $bytes = $options{'bytes'} || '43008'; # 42K (dams)
                        my $buf;
                        while ( ( my $read = sysread $content, $buf, $bytes ) != 0 ) {
                            if ( exists $callbacks{'around_content'} ) {
                                $callbacks{'around_content'}->( $writer, $buf );
                            } else {
                                $writer->write($buf);
                            }
                        }
                    } else {
                        $writer->write($content);
                    }
                };
            } );
        }

        return $resp;

    }

    Dancer::Error->new(
        code    => 404,
        message => "No such file: `$path'"
    )->render();
}

# Start/Run the application with the chosen apphandler
sub _start {
    my ($class, $request) = @_;
    Dancer::Config->load;

    # Backward compatibility for app.psgi that has sub { Dancer->dance($req) }
    if ($request) {
        Dancer::Handler->init_request_headers( $request->env );
        # TODO _build_headers should either not be private, or we should call
        # init