view release on metacpan or  search on metacpan

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

    # read basic input
    my %img_args;
    $img_args{w} = int( $r->param($widthparm) );
    $img_args{h} = int( $r->param($heightparm) );
    return OK unless $img_args{w} || $img_args{h};

    $img_args{cropto} = $r->param('cropto');
    $img_args{reshape} = $r->param('reshape');
    $img_args{enlarge} = $r->param('enlarge') || 0 ;
    $img_args{crop_aspect_ratio} = defined $r->param('cropAR') ? $r->param('cropAR') : $crop_aspect_ratio;
    $img_args{proportional} = $r->param('proportional');
    $img_args{proportional} = 1 if not defined $img_args{proportional} or $img_args{proportional} eq '';
    my $quality = $r->param('quality') || $default_quality;
    $img_args{scale_type} = $r->param('scaletype');
    $img_args{qtype} = $r->param('qtype') || $default_qtype;

    my $shrunk;
    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/$cachedir/ if $cachedir;
        $path =~ s/\/\//\//;
        $shrunk = $path . $name . '_' . ( $img_args{w} || 'x' ) . '_' . ( $img_args{h} || 'x' );
        $shrunk .= "_q$quality";

        if ($img_args{reshape} eq 'crop') {
            $shrunk .= '_crop';
        }

        if ($img_args{cropto} && $img_args{cropto} =~ /^(left|right|top|bottom)$/i) {
            $shrunk .= "_".$img_args{cropto};
        }

        if ($img_args{enlarge}) {
            $shrunk .= "_enlarge";
        }

        if ($img_args{proportional}) {
            $shrunk .= "_proportional";
        }

        if ($img_args{crop_aspect_ratio}) {
            $shrunk .= "_cropAR";
        }

        if ($img_args{scale_type}) {
            $shrunk .= "_scaletype".$img_args{scale_type};
        }

        if ($img_args{qtype}) {
            $shrunk .= "_qtype".$img_args{qtype};
        }

        $shrunk .= $suffix;

        if (file_ok( $shrunk, $filename )) {
            $r->filename($shrunk);
            $r->finfo(APR::Finfo::stat($shrunk, APR::Const::FINFO_NORM, $r->pool));
            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);
    $im = resize($im, \%img_args);

    # if the cache is disabled, we write the results directly back to the request.
    # You shouldn't do this during fixup - though it works - so if running without a cache we ought to a perlhandler

    if ($nocache) {
        my $type = $suffix;
        $type =~ s/^\.//;
        $type = 'jpeg' if $type eq 'jpg';

        my $imagedata;
        $im->write(
            type => $type,
            jpegquality => $quality,
            data => \$imagedata,
        ) or return fail( "Failed to return image data: " . $im->errstr );

        $r->headers_out->{'Content-Length'} = length($imagedata);
        $r->content_type("image/$type");
        $r->print($imagedata);
        return OK;

    # otherwise we write out the cache file and tell the request to use that filename

    } else {

        $im->write(
            file => $shrunk,
            jpegquality => $quality,
        ) or return fail("Cannot write $shrunk: " . $im->errstr);

        $r->filename($shrunk);
        $r->finfo(APR::Finfo::stat($shrunk, APR::Const::FINFO_NORM, $r->pool));
        return OK;
    }
}

sub resize {
    my $im = shift;
    my $args = shift;

    my $imgwidth = $im->getwidth;
    my $imgheight = $im->getheight;
    my (%scale, %crop);

    ##############
    # scale the image
    if ($args->{w} && $args->{h}) {
        if ($args->{reshape} eq 'crop') {
            %scale = ();
        }
        else {
            # Imager automatically resizes to make the larger image specified by the two dimensions
            $scale{xpixels} = $args->{w};
            $scale{ypixels} = $args->{h};
        }

    } elsif ($args->{w}) {
        $scale{xpixels} = $args->{w};

    } else {
        $scale{ypixels} = $args->{h};
    }

    if ($args->{qtype}) {
        $scale{qtype} = $args->{qtype};
    }

    if ($args->{scale_type}) {
        $scale{type} = $args->{scale_type};
    }

    # enlarge images only if the enlarge argument is set
    if (
        not $args->{enlarge}
        and (
            ( $scale{xpixels} and ($scale{xpixels} > $imgwidth) )
            or ( $scale{ypixels} and ($scale{ypixels} > $imgheight) )
        )
        and (
            ($args->{scale_type} ne 'min')
            or (
                ( $scale{xpixels} and ($scale{xpixels} > $imgwidth) )
                and ( $scale{ypixels} and ($scale{ypixels} > $imgheight) )
            )
        )
    ) {
        %scale = ();
    }

    if ( not $args->{proportional} and $scale{xpixels} and $scale{ypixels} ) {
        $im = $im->scaleX(pixels=>$scale{xpixels})->scaleY(pixels=>$scale{ypixels});
    }