File Coverage

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

Criterion	Covered	Total	%
statement	93	119	78.1
branch	11	20	55.0
condition	8	23	34.7
subroutine	20	21	95.2
pod	2	7	28.5
total	134	190	70.5

package Plack::App::Directory::Markdown;
use strict;
use warnings;
use utf8;
our $VERSION = '0.09';

use parent 'Plack::App::Directory';
use Encode qw/encode_utf8/;
use Data::Section::Simple;
use Text::Xslate;
use HTTP::Date;
use URI::Escape qw/uri_escape/;
use Plack::Middleware::Bootstrap;
use Plack::Builder;

use Plack::Util::Accessor;
Plack::Util::Accessor::mk_accessors(__PACKAGE__, qw(title tx tx_path markdown_class markdown_ext));

sub new {
    my $cls = shift;

    my $self = $cls->SUPER::new(@_);
    $self->tx(
        Text::Xslate->new(
            path => [
                ($self->tx_path || ()),
                Data::Section::Simple->new->get_data_section,
            ],
            function => { process_path => \&process_path, }
        )
    );
    $self;
}

sub to_app {
    my $self = shift;

    my $app = $self->SUPER::to_app;

    builder {
        enable 'Bootstrap';
        $app;
    };
}

sub markdown {
    my $self = shift;

    my $md = $self->{_md} ||= do {
        my $cls = $self->markdown_class || 'Text::Markdown';
        Plack::Util::load_class($cls);

        $cls->new;
    };

    $md->markdown(@_);
}

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

    if (-f $dir) {
        if ($self->is_markdown($dir)) {
            my $content = do {local $/;open my $fh,'<:encoding(UTF-8)',$dir or die $!;<$fh>};
            $content = $self->markdown($content);

            my $path = $self->remove_root_path($dir);
            $path =~ s/\.(?:markdown|mk?dn?)$//;

            my $page = $self->tx->render('md.tx', {
                path    => $path,
                title   => ($self->title || 'Markdown'),
                content => $content,
            });
            $page = encode_utf8($page);

            my @stat = stat $dir;
            return [ 200, [
                'Content-Type'   => 'text/html; charset=utf-8',
                'Last-Modified'  => HTTP::Date::time2str( $stat[9] ),
            ], [ $page ] ];
        }
        else {
            return $self->SUPER::serve_path($env, $dir);
        }
    }

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

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

    my @files;
    push @files, ({ link => "../", name => "Parent Directory" }) if $env->{PATH_INFO} ne '/';

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

    for my $basename (sort { $a cmp $b } @children) {
        my $file = "$dir/$basename";
        my $url = $dir_url . $basename;

        my $is_dir = -d $file;
        next if !$is_dir && !$self->is_markdown($file);

        my @stat = stat _;

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

        if ($is_dir) {
            $basename .= "/";
            $url      .= "/";
        }
        push @files, { link => $url, name => $basename, mtime => HTTP::Date::time2str($stat[9]) };
    }

    my $path = Plack::Util::encode_html( $env->{PATH_INFO} );
    $path =~ s{^/}{};
    my $page  = $self->tx->render('index.tx', {
        title   => ($self->title || 'Markdown'),
        files => \@files,
        path => $path
    });
    $page = encode_utf8($page);
    return [ 200, ['Content-Type' => 'text/html; charset=utf-8'], [ $page ] ];
}

sub is_markdown {
    my ($self, $file) = @_;
    if ($self->markdown_ext) {
        my $ext = quotemeta $self->markdown_ext;
        $file =~ /$ext$/;
    }
    else {
        $file =~ /\.(?:markdown|mk?dn?)$/;
    }
}

sub remove_root_path {
    my ($self, $path) = @_;

    $path =~ s!^\./?!!;
    my $root = $self->root || '';
    $root =~ s!^\./?!!;
    $root .= '/' if $root && $root !~ m!/$!;
    $root = quotemeta $root;
    $path =~ s!^$root!!;

    $path;
}

sub process_path {
    my $path = shift;

    my @out;
    my $i = 0;
    foreach my $part (reverse(split('/',$path))) {
        my $link = '../' x $i;

        push @out,
            {
            name => $part,
            link => "${link}",
            };
        $i++;
    }
    $out[0]->{link} = '';    # Last element should link to itself
    return [ reverse @out ];
}

1;

__DATA__