view release on metacpan or  search on metacpan

lib/Apache/ImageShoehorn.pm  view on Meta::CPAN

   PerlSetVar   ScaledDir       /path/to/some/dir

   PerlSetVar	SetScaleSmall	25%
   PerlSetVar	SetScaleMedium	50%
   PerlSetVar	SetScaleLarge	75%
   PerlSetVar	SetScaleThumb	x50

   PerlSetVar   SetValid        png
   PerlSetVar   Convert         On

   PerlSetVar   ScaleAllOnCleanup  Off

   <FilesMatch "\.html$">
    # Do something with HTML files here
   </FilesMatch>
  </Directory>

  # This image would actually be converted and
  # sent to the browser as a PNG file. Woot!

  http://www.foo.com/images/bar.jpg?scale=medium

=head1 DESCRIPTION

Apache mod_perl wrapper for Image::Shoehorn.

=head1 CONFIG DIRECTIVES

=over

=item *

ScaledDir          I<string>

A path on the filesystem where the handler will save images that have been scaled

Remember, this directory needs to be writable by whatever user is running the http daemon.

=item *

SetScaleI<Name>    I<string>

Define the names and dimensions of scaled images. I<name> will be converted to lower-case and compared with the I<scale> CGI query parameter. If no matching config directive is located, the handler will return DECLINED.

If there are multiple SetScale directives then they will be processed, if necessary, during the handler's cleanup stage.

If a scaled image already exists, it will not be rescaled until the lastmodified time for the source file is greater than that of the scaled version.

Valid dimensions are identical as those listed in I<Image::Shoehorn>.

=item *

SetValid       I<string>

Define one or more file types that are considered valid for sending to the browser, notwithstanding any issues of scaling, "as-is".

=item *

Convert        I<(On|Off)>

If an image fails a validity test, then the image will be be converted using the first type defined by the I<SetValid> configs that the package (read: Image::Magick) can understand.

=item *

ScaleAllOnCleanup   I<(On|Off)>

Toggle setting for scaling all size definitions for an image during the cleanup phase of a request. Default is "On".

=back

This package does not support all of the options available to the I<Image::Shoehorn> constructor. They will likely be added in later releases. The current list of unsupported configuration options is :

=over

=item *

I<max_height>

=item *

I<max_width>

=item *

I<overwrite>

=back

=cut

package Apache::ImageShoehorn;
use strict;

$Apache::ImageShoehorn::VERSION = '0.9.2';

use Apache;
use Apache::Constants qw (:common);
use Apache::File;
use Apache::Log;

use Image::Shoehorn 1.2;

my %TYPES   = ();
my @FORMATS = ();

sub handler {
    my $apache = shift;

    # First we make sure that we are dealing
    # with a file we can understand.

    unless (&_valid_type($apache)) {
      return DECLINED;
    }

    # Check to see if need to deal with
    # validation and conversion.

    my $valid   = 1;
    my $convert = 0;

lib/Apache/ImageShoehorn.pm  view on Meta::CPAN

}

sub _scaleall {
  my $apache   = shift;
  my $shoehorn = shift;
  my $source   = shift;
  my $mtime    = shift;

  my %scales = ();

  foreach my $var (keys %{$apache->dir_config()}) {
    $var =~ /^SetScale(.*)/;
    next unless $1;
    
    my $name   = lc($1);
    my $scaled = &_scalepath($apache,[$source,$name]);

    next unless (&_modified([$mtime,$scaled]));
    $scales{$name} = $apache->dir_config($var);
  }

  if (keys %scales) {

    if (ref($shoehorn) ne "Image::Shoehorn") {
      $shoehorn = &_shoehorn($apache);
    }
    
    if (! $shoehorn) {
      $apache->log()->error(Image::Shoehorn->last_error());
      return 0;
    }
    
    if (! $shoehorn->import({
			     source  => $source,
			     scale   => \%scales,
			     convert => $apache->dir_config("Convert"),
			     valid   => (($apache->dir_config("SetValid")) ? 
					 [ $apache->dir_config->get("SetValid") ] : undef),
			    })) {

      $apache->log()->error("Failed to import ".Image::Shoehorn->last_error());
      return 0;
    }
  }

  return 1;
}

sub _valid_type {
  my $apache = shift;

  $apache->content_type() =~ /^(.*)\/(.*)$/;

  if (! $2) { return 0; }

  if (exists($TYPES{$apache->location()}->{$2})) {
    return $TYPES{$apache->location()}->{$2};
  }

  if (! @FORMATS) {
    @FORMATS = Image::Magick->QueryFormat();
  }
  
  $TYPES{$apache->location()}->{$2} = grep(/^($2)$/,@FORMATS);
  return $TYPES{$apache->location()}->{$2};
}

sub _scalepath {
  my $apache = shift;

  my $scaled = Image::Shoehorn->scaled_name($_[0]);
  $scaled    = $apache->dir_config("ScaledDir")."/$scaled";

  return $scaled;
}

sub _modified {
  my $args = shift;

  # $args->[0] - the mtime for the source file
  # $args->[1] - the path for the scale file

  if (! -f $args->[1]) { return 1; }

  if ($args->[0] > (stat($args->[1]))[9]) {
    return 1;
  }

  return 0;
}

=head1 VERSION

0.9.2

=head1 DATE

July 07, 2002

=head1 AUTHOR

Aaron Straup Cope

=head1 SEE ALSO 

L<Image::Shoehorn>

=head1 LICENSE

Copyright (c) 2002 Aaron Straup Cope. All Rights Reserved.

This is free software, you may use it and distribute it under the same terms as Perl itself.

=cut

return 1;

}