File Coverage

blib/lib/Plack/App/Directory/Template.pm

Criterion	Covered	Total	%
statement	81	105	77.1
branch	25	46	54.3
condition	14	17	82.3
subroutine	15	18	83.3
pod	2	3	66.6
total	137	189	72.4

use strict;
use warnings;
package Plack::App::Directory::Template;
#ABSTRACT: Serve static files from document root with directory index template
our $VERSION = '0.27'; #VERSION
use v5.10;

use parent qw(Plack::App::Directory);

use Plack::Middleware::TemplateToolkit;
use Plack::Util::Accessor qw(filter templates);

use File::ShareDir qw(dist_dir);
use File::stat;
use DirHandle;
use Cwd qw(abs_path);
use URI::Escape;

sub prepare_app {
    my $self = shift;

    $self->{_default_vars} = delete $self->{VARIABLES} // { };
    $self->{templates} = delete $self->{INCLUDE_PATH} if $self->{INCLUDE_PATH};
}

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

    if (-f $dir) {
        return $self->SUPER::serve_path($env, $dir, $fullpath);
    }

    if (defined $self->{dir_index}) {
        my $index_file = "$dir/".$self->{dir_index};
        if (-f $index_file) {
            return $self->SUPER::serve_path($env, $index_file, $fullpath);
        }
    }

    my $urlpath = $env->{SCRIPT_NAME} . $env->{PATH_INFO};

    if ($urlpath !~ m{/$}) {
        return $self->return_dir_redirect($env);
    }

    $urlpath = join('/', map {uri_escape($_)} split m{/}, $urlpath).'/';

    my $dh = DirHandle->new($dir);
    my @children;
    while (defined(my $ent = $dh->read)) {
        next if $ent eq '.' or $ent eq '..';
        push @children, $ent;
    }

    my $files = [ ];
    my @special = ('.');
    push @special, '..' if $env->{PATH_INFO} ne '/';

    foreach ( @special, sort { $a cmp $b } @children ) {
        my $name = $_;
        my $file = "$dir/$_";
        my $stat = stat($file);
        my $url  = $urlpath . uri_escape($_);

        my $is_dir = -d $file; # TODO: use Fcntl instead ?

        push @$files, bless {
            name        => $is_dir ? "$name/" : $name,
            url         => $is_dir ? "$url/" : $url,
            mime_type   => $is_dir ? 'directory' : ( Plack::MIME->mime_type($file) || 'text/plain' ),
            stat        => $stat,
        }, 'Plack::App::Directory::Template::File';
    }

    $files = [ map { $self->filter->($_) || () } @$files ] if $self->filter;

    my $default_vars = {
        %{ $self->{_default_vars} },
        path    => $env->{PATH_INFO},
        urlpath => $urlpath,
        root    => abs_path($self->root),
        dir     => abs_path($dir),
    };

    my $tt_vars = $self->template_vars( %$default_vars, files => $files );
    if ($env->{'tt.vars'}) {
        $env->{'tt.vars'}->{$_} = $tt_vars->{$_} for keys %$tt_vars;
    } else {
        $env->{'tt.vars'} = $tt_vars;
    }

    $env->{'tt.template'} = ref $self->templates ? $self->templates
                          : ($self->{PROCESS} // 'index.html');

    $self->{tt} //= Plack::Middleware::TemplateToolkit->new(
        INCLUDE_PATH => $self->templates
                        // eval { dist_dir('Plack-App-Directory-Template') }
                        // 'share',
        VARIABLES    => $default_vars,
        request_vars => [qw(scheme base parameters path user)],
        map { $_ => $self->{$_} } grep { $_ =~ /^[A-Z_]+$/ } keys %$self
    )->to_app;

    return $self->{tt}->($env);
}

sub template_vars {
    my ($self, %args) = @_;
    return { files => $args{files} };
}

package Plack::App::Directory::Template::File;

our $AUTOLOAD;
sub can { $_[0]->{$_[1]}; }

sub AUTOLOAD {
    my $self = shift;
    my $attr = $AUTOLOAD;
    $attr =~ s/.*://;
    $self->{$attr};
}

sub permission {
    ## no critic
    $_[0]->{stat} ? ($_[0]->{stat}->mode & 07777) : undef;
}

sub mode_string { # not tested or documented
    return '          ' unless $_[0]->{stat};
    my $mode = $_[0]->{stat}->mode;

    # Code copied from File::Stat::Ls by Geo Tiger
    # See also File::Stat::Bits, File::Stat::Ls, Stat::lsMode, File::Stat::ModeString

    my @perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
    my @ftype = qw(. p c ? d ? b ? - ? l ? s ? ? ?);
    $ftype[0] = '';
## no critic
    my $setids = ($mode & 07000)>>9;
## no critic
    my @permstrs = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007];
## no critic
    my $ftype = $ftype[($mode & 0170000)>>12];

    if ($setids) {
      if ($setids & 01) {         # Sticky bit
        $permstrs[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e;
      }
      if ($setids & 04) {         # Setuid bit
        $permstrs[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
      }
      if ($setids & 02) {         # Setgid bit
        $permstrs[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
      }
    }

    join '', $ftype, @permstrs;
}



1;

__END__