# Copyright 2001-2005 Six Apart.# SCRiPTMAFiA 2005 - THE DiRTY HANDS ON YOUR SCRiPTS## $Id: Image.pm 10197 2005-03-09 00:27:57Z ezra $package MT::Image;use strict;use MT;use MT::ConfigMgr;use MT::ErrorHandler;@MT::Image::ISA = qw( MT::ErrorHandler );sub new {    my $class = shift;    $class .= "::" . MT::ConfigMgr->instance->ImageDriver;    my $image = bless {}, $class;    $image->load_driver        or return $class->error( $image->errstr );    if (@_) {        $image->init(@_)            or return $class->error( $image->errstr );    }    $image;}sub get_dimensions {    my $image = shift;    my %param = @_;    my($w, $h) = ($image->{width}, $image->{height});    if (my $pct = $param{Scale}) {        ($w, $h) = (int($w * $pct / 100), int($h * $pct / 100));    } else {        if ($param{Width} && $param{Height}) {            ($w, $h) = ($param{Width}, $param{Height});        } else {            my $x = $param{Width} || $w;            my $y = $param{Height} || $h;            my $w_pct = $x / $w;            my $h_pct = $y / $h;            my $pct = $x ? $w_pct : $h_pct;            ($w, $h) = (int($w * $pct), int($h * $pct));        }    }    ($w, $h);}package MT::Image::ImageMagick;@MT::Image::ImageMagick::ISA = qw( MT::Image );sub load_driver {    my $image = shift;    eval { require Image::Magick };    return $image->error(MT->translate("Can't load Image::Magick: [_1]", $@))        if $@;    1;}sub init {    my $image = shift;    my %param = @_;    my %arg = ();    if (my $type = $param{Type}) {        %arg = (magick => lc($type));    } elsif (my $file = $param{Filename}) {        (my $ext = $file) =~ s/.*\.//;        %arg = (magick => lc($ext));    }    my $magick = $image->{magick} = Image::Magick->new(%arg);    if (my $file = $param{Filename}) {        my $x = $magick->Read($file);        return $image->error(MT->translate(            "Reading file '[_1]' failed: [_2]", $file, $x)) if $x;        ($image->{width}, $image->{height}) = $magick->Get('width', 'height');    } elsif ($param{Data}) {        my $x = $magick->BlobToImage($param{Data});        return $image->error(MT->translate(            "Reading image failed: [_1]", $x)) if $x;        ($image->{width}, $image->{height}) = $magick->Get('width', 'height');    }    $image;}sub scale {    my $image = shift;    my($w, $h) = $image->get_dimensions(@_);    my $magick = $image->{magick};    my $err = $magick->can('Resize') ?              $magick->Resize(width => $w, height => $h) :              $magick->Scale(width => $w, height => $h);    return $image->error(MT->translate(        "Scaling to [_1]x[_2] failed: [_3]", $w, $h, $err)) if $err;    $magick->Profile("*") if $magick->can('Profile');    wantarray ? ($magick->ImageToBlob, $w, $h) : $magick->ImageToBlob;}package MT::Image::NetPBM;@MT::Image::NetPBM::ISA = qw( MT::Image );sub load_driver {    my $image = shift;    eval { require IPC::Run };    return $image->error(MT->translate("Can't load IPC::Run: [_1]", $@))        if $@;    my $pbm = $image->_find_pbm or return;    1;}sub init {    my $image = shift;    my %param = @_;    if (my $file = $param{Filename}) {        $image->{file} = $file;        if (!defined $param{Type}) {            (my $ext = $file) =~ s/.*\.//;            $param{Type} = uc $ext;        }    } elsif (my $blob = $param{Data}) {        $image->{data} = $blob;    }    my %Types = (jpg => 'jpeg', gif => 'gif');    my $type = $image->{type} = $Types{ lc $param{Type} };    my($out, $err);    my $pbm = $image->_find_pbm or return;    my @in = ("$pbm${type}topnm", ($image->{file} ? $image->{file} : ()));    my @out = ("${pbm}pnmfile", '-allimages');    IPC::Run::run(\@in, '<', ($image->{file} ? \undef : \$image->{data}), '|',        \@out, \$out, \$err)        or return $image->error(MT->translate(            "Reading image failed: [_1]", $err));    ($image->{width}, $image->{height}) = $out =~ /(\d+)\s+by\s+(\d+)/;    $image;}sub scale {    my $image = shift;    my($w, $h) = $image->get_dimensions(@_);    my $type = $image->{type};    my($out, $err);    my $pbm = $image->_find_pbm or return;    my @in = ("$pbm${type}topnm", ($image->{file} ? $image->{file} : ()));    my @scale = ("${pbm}pnmscale", '-width', $w, '-height', $h);    my @out;    for my $try (qw( ppm pnm )) {        my $prog = "${pbm}${try}to$type";        @out = ($prog), last if -x $prog;    }    my(@quant);    if ($type eq 'gif') {        push @quant, ([ "${pbm}ppmquant", 256 ], '|');    }    IPC::Run::run(\@in, '<', ($image->{file} ? \undef : \$image->{data}), '|',        \@scale, '|',        @quant,        \@out, \$out, \$err)        or return $image->error(MT->translate(            "Scaling to [_1]x[_2] failed: [_3]", $w, $h, $err));    wantarray ? ($out, $w, $h) : $out;}sub _find_pbm {    my $image = shift;    return $image->{__pbm_path} if $image->{__pbm_path};    my @NetPBM = qw( /usr/local/netpbm/bin /usr/local/bin /usr/bin );    my $pbm;    for my $path (MT::ConfigMgr->instance->NetPBMPath, @NetPBM) {        next unless $path;        $path .= '/' unless $path =~ m!/$!;        $pbm = $path, last if -x "${path}pnmscale";    }    return $image->error(MT->translate(        "You do not have a valid path to the NetPBM tools on your machine."))        unless $pbm;    $image->{__pbm_path} = $pbm;}1;__END__=head1 NAMEMT::Image - Movable Type image manipulation routines=head1 SYNOPSIS    use MT::Image;    my $img = MT::Image->new( Filename => '/path/to/image.jpg' );    my($blob, $w, $h) = $img->scale( Width => 100 );    open FH, ">thumb.jpg" or die $!;    binmode FH;    print FH $blob;    close FH;=head1 DESCRIPTIONI<MT::Image> contains image manipulation routines using either theI<NetPBM> tools or the I<ImageMagick> and I<Image::Magick> Perl module.The backend framework used (NetPBM or ImageMagick) depends on the value ofthe I<ImageDriver> setting in the F<mt.cfg> file (or, correspondingly, seton an instance of the I<MT::ConfigMgr> class).Currently all this is used for is to create thumbnails from uploaded images.=head1 USAGE=head2 MT::Image->new(%arg)Constructs a new I<MT::Image> object. Returns the new object on success; onerror, returns C<undef>, and the error message is in C<MT::Image-E<gt>errstr>.I<%arg> can contain:=over 4=item * FilenameThe path to an image to load.=item * DataThe actual contents of an image, already loaded from a file, a database,etc.=item * TypeThe image format of the data in I<Data>. This should be either I<JPG> orI<GIF>.=back=head2 $img->scale(%arg)Creates a thumbnail from the image represented by I<$img>; on success, returnsa list containing the binary contents of the thumbnail image, the width of thescaled image, and the height of the scaled image. On error, returns C<undef>,and the error message is in C<$img-E<gt>errstr>.I<%arg> can contain:=over 4=item * Width=item * HeightThe width and height of the final image, respectively. If you provide only oneof these arguments, the other dimension will be scaled appropriately. If youprovide neither, the image will be scaled to C<100%> of the original (that is,the same size). If you provide both, the image will likely look ratherdistorted.=item * ScaleTo be used instead of I<Width> and I<Height>; the value should be a percentage(ie C<100> to return the original image without resizing) by which both thewidth and height will be scaled equally.=back=head1 AUTHOR & COPYRIGHTPlease see the I<MT> manpage for author, copyright, and license information.=cut