view release on metacpan or  search on metacpan

lib/Apache/Imager/Resize.pm  view on Meta::CPAN

  [cachedir]/images/morecambe_120_x.jpg

If neither width nor height is specified we bail out immediately, so the original image will be returned.

There is currently no mechanism for cache cleanup, but we do touch the access date of each file each time it's used (leaving the modification date alone so that it can be to compare with the original file). You could fairly easily set up a cron job t...

=cut

sub handler {
	my $r = shift;
	my $filename = $r->filename;

	# for now we can manage quite well without libapreq
	# and might soon work under mod_perl 2, even

    my (%args) = $r->args;
	
	# pick up configuration directives via Apache::ModuleConfig

	my $cfg = Apache::ModuleConfig->get($r);
    my $nocache = $cfg->{ImgResizeNoCache};
    my $cachedir = $cfg->{ImgResizeCacheDir};
    my $widthparm = $cfg->{ImgResizeWidthParam} || 'w';
    my $heightparm = $cfg->{ImgResizeHeightParam} || 'h';
    
    # read basic input
    
	my $w = int( $args{$widthparm} );
	my $h = int( $args{$heightparm} );
	return OK unless $w || $h;

	my $cropto = $args{cropto};
	my $reshape = $args{reshape};
	my $quality = $args{quality} || '60';
	
	my ($shrunk, %scale, %crop);
	my ($name, $path, $suffix) = File::Basename::fileparse( $filename, '\.\w{2,5}' );

	unless ($nocache) {	
		my $docroot = $r->document_root;
		
		# interpolate the name of the cache directory if it has been supplied
		
		$path =~ s/^$docroot/$docroot\/$cachedir/ if $cachedir;
		$path =~ s/\/\//\//;
		$shrunk = $path . $name . '_' . ( $w || 'x' ) . '_' . ( $h || 'x' );

		if ($reshape eq 'crop') {
			$shrunk .= '_crop';			
		}
		
		if ($cropto && $cropto =~ /^(left|right|top|bottom)$/i) {
			$shrunk .= "_$cropto";
		}
		
		$shrunk .= $suffix;
		
		if (file_ok( $shrunk, $filename )) {
			$r->filename($shrunk);
			my $mtime = (stat( $shrunk ))[9];
			utime time, $mtime, $shrunk;
			return OK;
		}
		
		# if we're using a separate cache directory, the necessary subdirectory might not exist yet
		
		if ($cachedir) {
			eval {  File::Path::mkpath($path) };
			return fail( "mkpath failed for '$path': $@" ) if $@;
		}
	}
	
	# no cache hit, so we create an Imager object and go through the options
	
	my $im = Imager->new;
	$im->open( file => $filename ) or return fail("Cannot read $filename: " . $im->errstr);
		
	my $imgwidth = $im->getwidth;
	my $imgheight = $im->getheight;
	
    if ($w && $h) {
    	if ($reshape eq 'crop') {
    		%scale = ();
				
        } else {
			# Imager automatically resizes to make the larger image specified by the two dimensions
			$scale{xpixels} = $w;
			$scale{ypixels} = $h;
        }

    } elsif ($w) {
        $scale{xpixels} = $w;

    } else {
        $scale{ypixels} = $h;
    }
	
	# first we scale the image, if any scale parameters have been set.
	
	$im = $im->scale( %scale ) if %scale;

    if ($w && $h) {
	
		# $dw and $dh are the multipliers by which each dimension is changing
		
		my $dw = $imgwidth / $w if $w;
		my $dh = $imgheight / $h if $h;
		
		# cropto should really be a list parameter so that we can choose top left
		
		if ($reshape eq 'crop') {
			if ($cropto eq 'left') {
				$crop{left} = 0;
				$crop{width} = $w;
				$crop{height} = $h;
				
			} elsif ($cropto eq 'right') {
				$crop{right} = $imgwidth;
				$crop{width} = $w;
				$crop{height} = $h;