root/branches/athena/lib/MT/Image.pm @ 1092

# Copyright 2001-2007 Six Apart. This code cannot be redistributed without
# permission from www.sixapart.com.  For more information, consult your
# Movable Type license.
#
# $Id$

package MT::Image;

use strict;
use MT;
use base qw( MT::ErrorHandler );

sub new {
    my $class = shift;
    $class .= "::" . MT->config->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 = $param{Width} ? $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 };
    if (my $err = $@) {
        return $image->error(MT->translate("Can't load Image::Magick: [_1]", $err));
    }
    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 };
    if (my $err = $@) {
        return $image->error(MT->translate("Can't load IPC::Run: [_1]", $err));
    }
    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', 'png' => 'png');
    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->config->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 NAME

MT::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 DESCRIPTION

I<MT::Image> contains image manipulation routines using either the
I<NetPBM> tools or the I<ImageMagick> and I<Image::Magick> Perl module.
The backend framework used (NetPBM or ImageMagick) depends on the value of
the I<ImageDriver> setting in the F<mt.cfg> file (or, correspondingly, set
on 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; on
error, returns C<undef>, and the error message is in C<MT::Image-E<gt>errstr>.

I<%arg> can contain:

=over 4

=item * Filename

The path to an image to load.

=item * Data

The actual contents of an image, already loaded from a file, a database,
etc.

=item * Type

The image format of the data in I<Data>. This should be either I<JPG> or
I<GIF>.

=back

=head2 $img->scale(%arg)

Creates a thumbnail from the image represented by I<$img>; on success, returns
a list containing the binary contents of the thumbnail image, the width of the
scaled 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 * Height

The width and height of the final image, respectively. If you provide only one
of these arguments, the other dimension will be scaled appropriately. If you
provide 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 rather
distorted.

=item * Scale

To 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 the
width and height will be scaled equally.

=back

=head2 $img->get_dimensions(%arg)

This utility method returns a width and height value pair after applying
the given arguments. Valid arguments are the same as the L<scale> method.
If 'Width' is given, a proportionate height will be calculated. If a
'Height' is given, the width will be calculated. If 'Scale' is given
the height and width will be calculated based on that scale (a value
between 1 to 100).

=head1 AUTHOR & COPYRIGHT

Please see the I<MT> manpage for author, copyright, and license information.

=cut