File Coverage

blib/lib/App/FakeCDN.pm

Criterion	Covered	Total	%
statement	24	70	34.2
branch	0	18	0.0
condition	0	20	0.0
subroutine	8	17	47.0
pod	0	8	0.0
total	32	133	24.0

package App::FakeCDN;
use 5.010001;
use strict;
use warnings;

our $VERSION = "0.01";

use Path::Tiny;
use Plack::MIME;

use Mouse;
use Mouse::Util::TypeConstraints;

subtype 'App::FakeCDN::Path' => as class_type('Path::Tiny');
coerce 'App::FakeCDN::Path'
    => from 'Str'
    => via { Path::Tiny::path($_) };

has cache => (
    is => 'ro',
    isa => 'Object',
    default => sub {
        require Cache::Memory::Simple;
        Cache::Memory::Simple->new;
    },
);

has root => (
    is       => 'ro',
    isa      => 'App::FakeCDN::Path',
    required => 1,
    coerce   => 1,
);

has expiration => (
    is  => 'ro',
    isa => 'Int',
);

no Mouse;

sub to_app {
    my $self = shift;

    sub {
        my $env = shift;

        my $path  = $env->{PATH_INFO} // '';
        my $query = $env->{QUERY_STRING} // '';

        if ($path =~ /\0/ || $query =~ /\0/) {
            return $self->res_400;
        }
        $path =~ s!^/!!;

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

        return $self->res_404 unless $data;

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

sub res_400 {
    [400, ['Content-Type' => 'text/plain', 'Content-Length' => 11], ['Bad Request']];
}

sub res_404 {
    [404, ['Content-Type' => 'text/plain', 'Content-Length' => 9], ['not found']];
}

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

    my $mime_type = Plack::MIME->mime_type($path) // 'application/octet-stream';
    my $is_binary = is_binary($mime_type);

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

    my $content = $self->get_stuff($path, $query);

    ($content, $mime_type);
}

sub is_binary {
    my $mime_type = shift;

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

sub get_stuff {
    my ($self, $path, $query) = @_;
    my $key = $path . $query;

    if (my $val = $self->cache->get($key)) {
        return $val;
    }
    else {
        my $file = $self->root->child($path);
        return unless -e -f $file;

        my $val = $file->slurp;
        $self->cache->set($key, $val, $self->expiration || ());
        return $val;
    }
}

sub parse_options {
    my ($class, @argv) = @_;

    require Getopt::Long;
    require Pod::Usage;

    my $p = Getopt::Long::Parser->new(
        config => [qw/posix_default no_ignore_case auto_help pass_through bundling/]
    );
    $p->getoptionsfromarray(\@argv, \my %opt, qw/
        root=s
        expiration=i
    /) or Pod::Usage::pod2usage();
    Pod::Usage::pod2usage() if !$opt{root};

    (\%opt, \@argv);
}

sub run {
    my $self = shift;
    my %args = @_ == 1 ? %{$_[0]} : @_;
    if (!$args{listen} && !$args{port} && !$ENV{SERVER_STARTER_PORT}) {
        $args{port} = 4907;
    }
    require Plack::Loader;
    Plack::Loader->auto(%args)->run($self->to_app);
}

1;
__END__