view release on metacpan or  search on metacpan

plugins/demo/gallery  view on Meta::CPAN

our $DEFAULT_SIZE = '133 640 800 1024';

sub hook_xmlresponse {
    my ($self, $input) = @_;
    
    $self->log(LOGINFO, "running");
    
    my $client = $self->client;
    
    my $file = $client->headers_in->filename;
    if (-d $file) {
        return $self->serve_dir($input);
    }
    
    $self->log(LOGINFO, "checking content type and format");
    
    my $mm = File::MMagic->new;
    my $ct = $mm->checktype_filename($file);
    
    # we're only interested in images
    return DECLINED unless $ct =~ /^image\//i;
    
    my $format = $client->param('format') || 'html';
    
    if ($format eq 'html') {
        return $self->serve_image_page($input, $ct);
    }
    
    # Now we just serve the raw image, possibly resized
    $self->log(LOGINFO, "serving raw image");
    
    # Make sure the specified size is one we're configured to
    # support.  If it isn't then use the default size
    my $sizelist = $self->get_cfg('GallerySizes') || $DEFAULT_SIZE;
    my @sizes = split(/\s+/, $sizelist);
    my $size = $client->param('size') || '';
    
    # If the size is 'full' then we're sending back the full size
    # image.  There's no work to do, so just return DECLINED
    if ($size eq 'full') {
        open(my $fh, $file) || die "open($file): $!";
        $client->headers_out->header('Content-Length', -s $file);
        $client->headers_out->header('Content-Type', $ct);
        $client->send_http_headers;
        local $/;
        my $out = <$fh>;
        $client->write(\$out);
        return OK;
    }
    
    if ($size eq 'thumb') {
        $size = $sizes[0];
    }
    else {
        $size = $sizes[1] unless grep { $_ eq $size } @sizes;
    }
    
    my $cache = $self->cache;
    if (my $cache_obj = $cache->get_object("$file+$size")) {
        if ($cache_obj->get_created_at() >= (stat($file))[9]) {
            my $out = $cache->get("$file+$size");
            $self->log(LOGINFO, "Serving cached image");
            $client->headers_out->header('Content-Length', bytelength($out));
            $client->headers_out->header('Content-Type', $ct);
            $client->send_http_headers;
            # using ->get here makes sure Cache::Cache expires stuff
            $client->write(\$out);
            return OK;
        }
    }
    
    $self->log(LOGINFO, "Resizing image $file to size $size");
    
    my ($type) = $ct =~ /\/(.*)$/;
    
    my $out;
    
    $self->resize_image($size, $file, $type, \$out);
    
    $cache->set("$file+$size", $out);
    
    $client->headers_out->header('Content-Length', bytelength($out));
    $client->headers_out->header('Content-Type', $ct);
    $client->send_http_headers;
    # using ->get here makes sure Cache::Cache expires stuff
    $client->write(\$out);
    return OK;
}

sub resize_image {
    my ($self, $size, $file, $type, $out) = @_;
    
    my $image = Imager->new;
    
    $image->open(file => $file)
        or die $image->errstr();

    my($w, $h) = ($image->getwidth(), $image->getheight());
    
    $self->log(LOGINFO, "Original width x height: $w x $h");
    
    my $quality = $self->get_cfg('GalleryThumbQuality') || 'preview';
    $quality = 'normal' if $quality ne 'preview';
    $quality = 'normal' if $self->client->param('size') ne 'thumb';
    
    $self->log(LOGINFO, "Scaling to $size with quality: $quality");
    
    my $doublesize = $size < (($w > $h ? $w : $h)/2);
    
    if ($quality eq 'normal' && $doublesize) {
        $self->log(LOGINFO, "Doing an initial shrinkage in preview mode");
        my $thumb = $image->scale(qtype => "preview",
                                  $w > $h ? (xpixels => $w/2)
                                          : (ypixels => $h/2)
                                 );
        
        $image = $thumb;
    }
    
    my $thumb = $image->scale(qtype => $quality, 
                               $w > $h ?
                                   (xpixels => $size)
                                 : (ypixels => $size)
                             );
    
    if ($doublesize) {
        $self->log(LOGINFO, "sharpening $thumb");
        
        # Sharpen a bit with a convolve filter
        $thumb->filter(
            type=>'conv',
            coef => [-0.2, 1, -0.2]
            ) if $quality eq 'normal';
    }
    
    $thumb->write(data => $out, type => $type)
        or die "Cannot write to scalar: ", $thumb->errstr;
}

sub serve_image_page {
    my ($self, $input, $ct) = @_;
    
    $self->log(LOGINFO, "Serving Imagesheet");
    
    my $file = $self->client->headers_in->filename;
    
    my $filesize = (stat($file))[7];
    my $mod  = (stat(_))[9];
    
    my $path;
    ($path, $file) = $file =~ /(.*)\/(.*)/;    # Extract the path/file info
    
    my $mm = File::MMagic->new;
    
    opendir(DIR, $path);
    my ($prev, $next);
    my $found = 0;
    for my $entry (sort readdir(DIR)) {
        next if $entry =~ /^\./;
        next if -d $entry;
        if ($entry eq $file) {
            $found++;
            next;
        }
        my $type = $mm->checktype_filename("$path/$entry");
        next unless $type =~ /^image\//;
        if ($found) {
            $next = $entry;
            last;
        }
        else {
            $prev = $entry;
        }
    }
    
    my $uri = $self->client->headers_in->request_uri;
    $uri =~ s/\?.*//;
    
    # generate path and config data.
    my ($uri_path) = $uri =~ /(.*)\//;
    $uri =~ s/^\///;            # Trim the leading '/'
    $uri = "<full><e>$uri</e><u>" . uri_decode($uri) . "</u></full>\n" .
           "<path><e>$uri_path</e><u>" . uri_decode($uri_path) . "</u></path>\n" .
        join("\n", 
        map { "<component><e>$_</e><u>" . uri_decode($_) . "</u></component>" } split(/\//, $uri));
    
    my $xml = <<EOXML;
<?xml version="1.0"?>
<imagesheet>
  <config>
    <perl-vars>
EOXML
    
    foreach my $var (qw(ProofsheetColumns ImagesPerProofsheet
                        GalleryCache GalleryThumbQuality))
    {
        no warnings 'uninitialized';
        $xml .= "<var name='$var'>" . $self->get_cfg($var) . "</var>\n";
    }

    my $size = $self->client->param('size') || '';

    # Make sure the specified size is one we're configured to
    # support.  If it isn't then use the default size
    my $sizelist = $self->get_cfg('GallerySizes');
    $sizelist = $DEFAULT_SIZE unless defined $sizelist;
    my @sizes = split(/\s+/, $sizelist);