File Coverage

blib/lib/Plack/App/DummyBox.pm

Criterion	Covered	Total	%
statement	76	88	86.3
branch	22	38	57.8
condition	12	26	46.1
subroutine	13	14	92.8
pod	3	3	100.0
total	126	169	74.5

package Plack::App::DummyBox;
use strict;
use warnings;
use Carp qw/croak/;
use parent qw/Plack::Component/;
use Imager;
use Image::Empty;
use HTTP::Status qw//;
use HTTP::Date qw//;
use Plack::Request;
use Plack::Util qw//;
use Plack::Util::Accessor qw/
    dot_gif
    dot_png
    font
    text
    filter
    cache
    cache_key
    max_width
    max_height
    stderr
/;

our $VERSION = '0.041';

sub prepare_app {
    my $self = shift;

    $self->max_width(5000) unless $self->max_width;
    $self->max_height(5000) unless $self->max_height;

    $self->dot_gif(Image::Empty->gif);
    $self->dot_png(Image::Empty->png);

    if ($self->font) {
        my $font = Imager::Font->new(
            file => $self->font->{file},
            type => $self->font->{type},
            size => $self->font->{size}   || 15,
            color => $self->font->{color} || 'darkgray',
        ) or croak(Imager->errstr);
        $self->font($font);
    }

    return $self;
}

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

    my $req  = Plack::Request->new($env);

    my $w = int($req->param('width') || $req->param('w') || 1);
    return $self->return_status(400) if $w > $self->max_width;
    my $h = int($req->param('height') || $req->param('h') || 1);
    return $self->return_status(400) if $h > $self->max_height;
    my $ext = $req->param('ext') || 'gif';
    return $self->return_status(400) if $ext !~ m!^(?:gif|png)$!;

    my $ext_obj = ($ext eq 'gif') ? $self->dot_gif : $self->dot_png;

    if ($w == 1 && $h == 1) {
        #----- dot image
        my $disposition = $ext_obj->disposition. '; filename="'
                            . $ext_obj->filename. '"';
        return [
            200,
            [
                'Content-Type'   => $ext_obj->type,
                'Content-Length' => $ext_obj->length,
                'Content-Disposition' => $disposition,
                'Last-Modified'  => HTTP::Date::time2str(time),
            ],
            [$ext_obj->content]
        ];
    }
    else {
        #----- box
        my $fill   = $req->param('fill')   || 'white';
        my $border = $req->param('border') || 'gray';
        my $line   = int($req->param('line') || 1); $line++;
        return $self->return_status(400) if $line > $w && $line > $h;

        if ($self->cache) {
            $self->cache_key(
                join ':',
                    $w, $h, $ext, $fill, $border, $line
            );
            if ( my $cache = $self->cache->get($self->cache_key) ) {
                return [ 200, @{$cache} ];
            }
        }

        my $img = Imager->new(xsize => $w, ysize => $h);
        $img->box(
            filled => 1,
            color  => $border
        );
        $img->box(
            xmin => $line-1,  ymin => $line-1,
            xmax => $w-$line, ymax => $h-$line,
            filled => 1,
            color => $fill,
        );

        if ($self->font) {
            $img->string(
                font => $self->font,
                x => 5,
                y => $self->font->{size}+5,
                string => "$w x $h",
                aa => 1,
            ) or return $self->return_status(500, Imager->errstr);

            if ($self->text) {
                $img->string(
                    font => $self->font,
                    x => 5,
                    y => $self->font->{size}*2+5+5,
                    string => $self->text,
                    aa => 1,
                ) or return $self->return_status(500, Imager->errstr);
            }
        }

        if (ref($self->filter) eq 'CODE') {
            $self->filter->($self, $img);
        }

        my $content = '';
        $img->write(data => \$content , type => $ext);
        my $disposition = $ext_obj->disposition. '; filename="'
                            . "${w}x$h\.$ext". '"';

        my $response = [
            [
                'Content-Type'   => $ext_obj->type,
                'Content-Length' => length $content,
                'Content-Disposition' => $disposition,
                'Last-Modified'  => HTTP::Date::time2str(time),
            ],
            [$content]
        ];

        if ($self->cache) {
            $self->cache->set($self->cache_key => $response);
        }
        return [ 200, @{$response} ];
    }
}

sub return_status {
    my $self        = shift;
    my $status_code = shift || 500;
    my $err         = shift || '';

    if ($self->stderr) {
        print STDERR "$err\n";
    }

    my $msg = HTTP::Status::status_message($status_code);

    return [
        $status_code,
        [
            'Content-Type' => 'text/plain',
            'Content-Length' => length $msg
        ],
        [$msg]
    ];
}

1;

__END__