Apache-Album

 view release on metacpan or  search on metacpan

Album.pm  view on Meta::CPAN

# For detailed information on this module, please see
# the pod data at the bottom of this file
#
# Copyright 1998-2004 James D Woodgate.  All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file.  You may modify this module as you 
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.

use Image::Magick;
use vars qw($VERSION);

use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::SubRequest ();
use APR::Pool ();
use APR::URI ();
use Apache2::URI ();

use Apache2::Const -compile => qw(OK SERVER_ERROR REDIRECT);

Album.pm  view on Meta::CPAN

  # thumbnail
  foreach (@files) {
    unless ( -e "$thumb_dir/$path_info/tn__$_" && 
	     (stat(_))[9] > (stat("$album_dir/$path_info/$_"))[9] ) {

      # Make sure the thumbnail directory exists
      &mymkdir("$thumb_dir/$path_info", 0755) 
	unless -d "$thumb_dir/$path_info";

      # Create a new thumbnail
      my $q = new Image::Magick;
      unless ($q) {
	$r->log_error("Couldn't create a new Image::Magick object");
	return Apache2::Const::SERVER_ERROR;
      }
     
      # Setting the size before reading the image is dramatically
      # faster.  The trade-off is that the quality of the resized
      # image will be lower, which is OK for thumbnails.
      # The actual resize (below) could be done with ->Sample() for
      # similar reasons, but some limited testing revealed that the
      # cumulative benefit of setting the size and using Sample was
      # almost non-existant.  Using ->Scale() instead might have a

Album.pm  view on Meta::CPAN

      $q->Read("$album_dir/$path_info/$_");

      # Scale it down, and save the file
      $q->Scale( width => $t_width, height => $t_height );
      $q->Write("$thumb_dir/$path_info/tn__$_");

      undef $q;

      # Create smaller versions of the full size image if requested
      if ($settings{'AllowFinalResize'}) {
	my $q = new Image::Magick;
	unless ($q) {
	  $r->log_error("Couldn't create a new Image::Magick object");
	  return Apache2::Const::SERVER_ERROR;
	}

	my $filename = $_;
	push (@cleanup_subs, sub {&create_final_resize($r, \%settings, $album_dir, $thumb_dir, $path_info, $filename, $o_width, $o_height);});

      }
  
    }
  }

Album.pm  view on Meta::CPAN

</FORM>
EOF
  ;

  return $ret;
}

sub create_final_resize {
  my ($r, $settings, $album_dir, $thumb_dir, $path_info, $filename, $o_width, $o_height) = @_;

  my $q = new Image::Magick;
  $q->Read("$album_dir/$path_info/$filename");

  my $ratio = $o_width / $o_height if $o_height;

  # X-Large is 1600x1200
  if ($o_width > 1600) {
    my $f_height = 0;
    $f_height = 1600 / $ratio if $ratio;
    
    my $q = $q->Clone();
    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 1600, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/1600x1200_$filename");
  }
  
  # Large is 1024x768
  if ($o_width > 1024) {
    my $f_height = 0;
    $f_height = 1024 / $ratio if $ratio;
    
    my $q = $q->Clone();
    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 1024, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/1024x768_$filename");
  }
  
  # Med is 800x600
  if ($o_width > 800) {
    my $f_height = 0;
    $f_height = 800 / $ratio if $ratio;
    
    my $q = $q->Clone();
    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 800, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/800x600_$filename");
  }
  
  # Sm is 640x480
  if ($o_width > 640) {
    my $f_height = 0;
    $f_height = 640 / $ratio if $ratio;
    
    my $q = $q->Clone();
    unless ($q) {
      $r->log_error("Couldn't create a new Image::Magick object");
      return  Apache2::Const::SERVER_ERROR;
    }
    
    $q->Scale( width => 640, height => $f_height );
    $q->Write("$thumb_dir/$path_info/"
	      . "/640x480_$filename");
  }
  
}

Album.pm  view on Meta::CPAN

Copyright (c) 1998-2004 Jim Woodgate. All rights reserved. This
program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 AUTHOR

Jim Woodgate woody@realtime.net

=head1 SEE ALSO

perl(1), L<Image::Magick>(3).

=cut

Makefile.PL  view on Meta::CPAN

use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile( 'NAME'	      => 'Apache::Album',
	       'VERSION_FROM' => 'Album.pm', # finds $VERSION
	       'PREREQ_PM'    => { 'Image::Magick' => 1.45, 
				 },
	     );

README  view on Meta::CPAN

COPYRIGHT
    Copyright (c) 1998-2000 Jim Woodgate. All rights reserved. This
    program is free software; you can redistribute it and/or modify
    it under the same terms as Perl itself.

AUTHOR
    Jim Woodgate woody@bga.com

SEE ALSO
    perl(1), the Image::Magick manpage(3).