HTML-Template-Compiled-Plugin-InlineImage
1 match

 view release on metacpan or  search on metacpan

lib/HTML/Template/Compiled/Plugin/InlineImage.pm  view on Meta::CPAN 

package HTML::Template::Compiled::Plugin::InlineImage;
# $Id: InlineImage.pm,v 1.14 2006/09/14 10:28:35 tinita Exp $
use strict;
use warnings;
use Carp qw(croak carp);
use HTML::Template::Compiled::Expression qw(:expressions);
use HTML::Template::Compiled;
use MIME::Base64;
our $VERSION = '0.03';
HTML::Template::Compiled->register(__PACKAGE__);
our $SIZE_WARNING = 1;


sub register {
    my ($class) = @_;
    my %plugs = (
        escape => {
            # <img <%= gd_object escape="INLINE_IMG"%> alt="blah">
            INLINE_IMG => sub {
                HTML::Template::Compiled::Plugin::InlineImage::inline(
                    type => 'png',
                    image => $_[0],
                );
            },
            INLINE_IMG_PNG => sub {
                HTML::Template::Compiled::Plugin::InlineImage::inline(
                    type => 'png',
                    image => $_[0],
                );
            },
            INLINE_IMG_GIF => sub {
                HTML::Template::Compiled::Plugin::InlineImage::inline(
                    type => 'gif',
                    image => $_[0],
                );
            },
            INLINE_IMG_JPEG => sub {
                HTML::Template::Compiled::Plugin::InlineImage::inline(
                    type => 'jpeg',
                    image => $_[0],
                );
            },
        },
    );
    return \%plugs;
}

sub inline {
    my (%args) = @_;
    my $image = $args{image};
    my $type = $args{type};
    my ($binary, $width, $height);
    unless (ref $image) {
        # we have raw data, try guessing mime type
        require File::MMagic;
        my $mm = File::MMagic->new;
        my $mtype = $mm->checktype_contents($image)
            or croak "Could not determine mime type";
        my ($type_a,$type_b) = split m#/#, $mtype;
        $type = $type_b;
        $binary = $image;
    }
    else {
        ($binary, $width, $height) = ref $image eq 'GD::Image'
            ? gd_to_binary($image,$type)
            : croak "unknown image type " . ref $image;
    }
    my $base64 = encode_base64($binary);
    my $string = "data:image/$type;base64,$base64";
    my $l = length $string;
    if ($l > 1024 && $SIZE_WARNING) {
        carp "Image is too big ($l characters > 1024)";
    }
    my $attributes = qq{src="$string"};
    if (defined $width) { $attributes .= qq{ width="$width"} }
    if (defined $height) { $attributes .= qq{ height="$height"} }
    return $attributes;
}

sub gd_to_binary {
    my $binary;
    if ($_[1] eq 'png') { $binary = $_[0]->png }
    if ($_[1] eq 'gif') { $binary = $_[0]->gif }
    if ($_[1] eq 'jpeg') { $binary = $_[0]->jpeg }
    my ($width,$height) = $_[0]->getBounds();
    return ($binary, $width, $height);
}

1;

__END__

=pod

=head1 NAME

HTML::Template::Compiled::Plugin::InlineImage - Inline-Images with HTML::Template::Compiled

=head1 SYNOPSIS

The Perl code:

    use HTML::Template::Compiled::Plugin::InlineImage;

    my $htc = HTML::Template::Compiled->new(
        plugin => [qw(HTML::Template::Compiled::Plugin::InlineImage)],
        filename => "template.htc",
        tagstyle => [qw(+tt)],
    );
    $htc->param(gd_object => $gd);
    $htc->param(raw_data => $data_from_image_file);
    print $htc->output;

The Template:

    <html>
        <body>
        <img [%= gd_object escape="INLINE_IMG" %] alt="[Rendered GD Image]">
        <img [%= raw_data escape="INLINE_IMG" %] alt="[Rendered Image]">



( run in 2.133 seconds using v1.01-cache-2.11-cpan-71847e10f99 )