File Coverage

blib/lib/Plack/App/DataSection.pm

Criterion	Covered	Total	%
statement	62	84	73.8
branch	8	18	44.4
condition	8	27	29.6
subroutine	16	18	88.8
pod	1	9	11.1
total	95	156	60.9

package Plack::App::DataSection;
use strict;
use warnings;
our $VERSION = '0.05';

use parent qw/Plack::Component/;
use MIME::Base64;
use Data::Section::Simple;
use Plack::MIME;
use HTTP::Date;

use Plack::Util::Accessor qw(encoding);

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

    my $path = $env->{PATH_INFO} || '';
    if ($path =~ /\0/) {
        return $self->return_400;
    }
    $path =~ s!^/!!;

    my ($data, $content_type) = $path ? $self->get_content($path) : ();

    return $self->return_404 unless $data;

    return [ 200, [
        'Content-Type'   => $content_type,
        'Content-Length' => length($data),
        'Last-Modified'  => $self->last_modified,
    ], [ $data ] ];
}

sub return_400 {
    my $self = shift;
    return [400, ['Content-Type' => 'text/plain', 'Content-Length' => 11], ['Bad Request']];
}

sub return_404 {
    my $self = shift;
    return [404, ['Content-Type' => 'text/plain', 'Content-Length' => 9], ['not found']];
}

sub data_section {
    my $self = shift;

    $self->{_reader} ||= Data::Section::Simple->new(ref $self);
}

sub get_data_section {
    my ($self, $path) = @_;
    $self->{_data_section_hash} ||= $self->data_section->get_data_section;
    if ($path) {
        $self->{_data_section_hash}{$path};
    }
    else {
        $self->{_data_section_hash};
    }
}

sub _cache { shift->{_cache} ||= {} }

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

    my $mime_type = Plack::MIME->mime_type($path);
    my $is_binary = is_binary($mime_type);

    unless ($is_binary) {
        my $encoding = $self->encoding || 'utf-8';
        $mime_type .= "; charset=$encoding";
    }

    my $content = $self->_cache->{$path} ||= do {
        my $content = $self->get_data_section($path);
        $content = decode_base64($content) if $content && $is_binary;
        $content;
    };

    ($content, $mime_type);
}

sub is_binary {
    my $mime_type = shift;

    $mime_type !~ /\b(?:text|xml|javascript|json)\b/;
}

sub last_modified {
    my $self = shift;

    $self->{last_modified} ||= do {
        my $mod = ref $self;
        $mod =~ s!::!/!g;
        $mod .= '.pm';
        my $full_path = $INC{$mod};

        my @stat = stat $full_path;
        HTTP::Date::time2str( $stat[9] )
    };
}

sub dump_dir {
    my ($self, $dir) = @_;
    require Errno;
    require Path::Class;

    my %data_section = %{ $self->get_data_section };
    my $base_dir = Path::Class::Dir->new($dir);

    $base_dir->mkpath or $! != Errno::EEXIST() or die "failed to create dir:$base_dir:$!";

    for my $key (keys %data_section) {
        my ($content) = $self->get_content($key);

        $key =~ s!^/!!g;
        my ($sub_dir, $file) = $key =~ m!^(.*?)([^/]+)$!;

        my $dir_path = $base_dir;
        if ($sub_dir) {
            $dir_path = $dir_path->subdir($sub_dir);
            $dir_path->mkpath or $! != Errno::EEXIST() or die "failed to create dir:$dir_path:$!";
        }

        $file = $dir_path->file($file);
        my $fh = $file->openw;
        $fh->print($content);
    }
}

1;
__DATA__