File Coverage

blib/lib/Plack/App/WWW.pm

Criterion	Covered	Total	%
statement	39	42	92.8
branch	8	12	66.6
condition	1	3	33.3
subroutine	9	9	100.0
pod	1	2	50.0
total	58	68	85.2

package Plack::App::WWW;
use strict;
use warnings;
use parent qw/Plack::App::CGIBin/;
use Plack::App::File;
use Plack::App::WrapCGI;
use Plack::App::Directory;

our $VERSION = '0.02';

sub call {
    my $self = shift;
    my $env  = shift;

    # check if path info is a folder, if true add directory index
    return Plack::App::Directory->new(
        root => $self->root
    )->to_app->($env) if -d $self->root . $env->{PATH_INFO};

    my ($file, $path_info) = $self->locate_file($env);
    return $file if ref $file eq 'ARRAY';

    if ($path_info) {
        $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
        $env->{'plack.file.SCRIPT_NAME'} =~ s/\Q$path_info\E$//;
        $env->{'plack.file.PATH_INFO'}   = $path_info;
    } else {
        $env->{'plack.file.SCRIPT_NAME'} = $env->{SCRIPT_NAME} . $env->{PATH_INFO};
        $env->{'plack.file.PATH_INFO'}   = '';
    }

    return $self->serve_path($env, $file);
}

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

    local @{$env}{qw(SCRIPT_NAME PATH_INFO)} = @{$env}{qw( plack.file.SCRIPT_NAME plack.file.PATH_INFO )};

    if ($self->_valid_file_perl($file)) {
        my $app = $self->{_compiled}->{$file} ||= Plack::App::WrapCGI->new(
            script => $file, execute => $self->would_exec($file)
        )->to_app;
        $app->($env);
    } else {
        Plack::App::File->new(file => $file)->to_app->($env);
    }
}

sub _valid_file_perl {
    my ($self, $file) = @_;

    return 1 if $file =~ /.(pl|cgi)$/i;
    return 1 if $self->shebang_for($file) =~ /^\#\!.*perl/;

    return;
}

1;

__END__