CatalystX::Usul::Model::Imager - Manipulate images

   my $model = $c->model( q(Imager) );

   my ($data, $type, $mtime) = eval {
      $model->transform( [ @args ], $c->req->query_parameters );
   };

   # For a thumbnail image
   # http://localhost:3000/en/imager/scale/static/images/catalyst_logo.png?scalefactor=0.5

# @(#)$Id: Imager.pm 576 2009-06-09 23:23:46Z pjf $

package CatalystX::Usul::Model::Imager;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.3.%d', q$Rev: 576 $ =~ /\d+/gmx );
use parent qw(CatalystX::Usul::Model);

use Imager;
use MIME::Types;

my @METHODS = qw(scale scaleX scaleY crop flip rotate convert map);

__PACKAGE__->config( cache_depth => 2,
                     types       => MIME::Types->new( only_complete => 1 ) );

__PACKAGE__->mk_accessors( qw(cache_depth cache_root doc_root types) );

sub new {
   my ($self, $app, @rest) = @_;

   my $new = $self->next::method( $app, @rest );

   $new->cache_root( $new->catdir( $new->tempdir, q(imager_cache) ) );
   $new->doc_root  ( $app->config->{root}                           );

   return $new;
}

sub transform {
   my ($self, $args, $query) = @_; my $data; $query ||= {};

   $self->throw( 'No method specified' ) unless ($args->[ 0 ]);

   my $methods = shift @{ $args }; my @methods = split m{ \+ }mx, $methods;

   for my $method (@methods) {
      unless ($self->is_member( $method, @METHODS )) {
         $self->throw( error => 'Method [_1] unknown', args => [ $method ] );
      }
   }

   $self->throw( 'No file path specified' ) unless ($args->[ 0 ]);

   my $stat  = delete $query->{stat};
   my $force = delete $query->{force};
   my $path  = $self->catfile( @{ $args } );
   my $key   = $self->_make_key( $methods, $path, $query );

   $path = $self->catfile( $self->doc_root, $path );

   unless (-f $path) {
      $self->throw( error => 'File [_1] not found', args => [ $path ] );
   }

   my $mtime = $stat ? $self->status_for( $path )->{mtime} : undef;
   my $type  = $self->types->mimeTypeOf( $self->basename( $path ) )->type;

   if ($force or not $data = $self->_cache( $mtime, $key )) {
      $data = $self->_get_image( \@methods, $path, $query );
      $self->_cache( undef, $key, $data );
   }

   return ($data, $type, $mtime);
}

# Private methods

sub _bucket {
   my ($self, $key, $depth) = @_; $depth ||= $self->cache_depth;

   my $file = $self->create_token( $key );

   return $self->catfile( $self->cache_root,
                          (map { substr $file, 0, $_ + 1 } (0 .. $depth - 1)),
                          $file );
}

sub _cache {
   my ($self, $mtime, $key, $data) = @_; my $e;

   return unless ($key);

   my $path = $self->_bucket( $key );

   if ($data) { $self->io( $path )->assert->lock->print( $data ) }
   elsif (-f $path) {
      if (!$mtime || $mtime <= $self->status_for( $path )->{mtime}) {
         $data = $self->io( $path )->lock->all;
      }
   }

   return $data;
}

sub _get_image {
   my ($self, $methods, $path, $query) = @_; my $data;

   my $img  = Imager->new;

   $self->throw( $img->errstr ) unless ($img->read( file => $path ));

   my $type = $img->tags( name => q(i_format) );

   for my $method (@{ $methods }) { $img = $img->$method( %{ $query } ) }

   unless ($img->write( data => \$data, type => $type )) {
      $self->throw( $img->errstr );
   }

   return $data;
}

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

   return $methods.q(/).$path.q(?).(join  q(&),
                                    map   { $_.q(=).$query->{ $_ } }
                                    keys %{ $query });
}

1;

__END__

# Local Variables:
# mode: perl
# tab-width: 3
# End: