Image::Magick results from the CPAN

Image::Magick

Apache-ImgIndex

view release on metacpan or search on metacpan

# Apache::ImgIndex

#
# James Pavlick, 2000
# mod_perl module for indexing directories of images
#

=head1 NAME

Apache::ImgIndex

=head1 SYNOPSIS

Add the following to your httpd.conf and restart. Then point your browser to
http://yoursite/photos


  <Location /photos>
    AllowOverride None
    #Options -Indexes -Includes -FollowSymLinks
    Order allow,deny
    Allow from all

    SetHandler perl-script
    PerlHandler Apache::ImgIndex
    PerlSetVar Rows 10
    PerlSetVar Cols 5
    PerlSetVar Thumb-size 50x20
    PerlSetVar Show-names 1
    PerlSetVar Hide-dirs 1
  </Location>

Make sure /photos contains the full size images that you want to display.

=head1 DESCRIPTION

I<Apache::ImgIndex> is a simple mod_perl application for displaying photos. 
I<Apache::ImgIndex> will automatically build thumbnails of the images. You 
can also rotate and scale the images from the web interface.

=head1 CAVEATS

=over 2

=item B<*> Lots of work still to do

=cut



package Apache::ImgIndex;
use strict;
use Apache2;
#use Apache::compat;
use Apache::RequestRec;
use Apache::RequestIO;
use Apache::Const qw(:common HTTP_OK);
use Apache::Log;
use APR::Const qw(:filetype);
use APR::Finfo;
use Image::Magick ();
use DirHandle ();
use FileHandle ();
use File::Basename qw(fileparse);

use vars qw(%gOptions @gOutput $gOutputStarted $VERSION);

$VERSION = 0.02;

%gOptions = (
	     'thumb-size' => '100x75',    # set thumbnail size
             'force'      => 0,           # always rebuild thumbnails
             'rows'       => 5,           # rows to display
             'cols'       => 4,           # columns to display
             'show-names' => 0,           # show thumbnail names
             'hide-dirs'  => 0,           # hide the photo directories list
             'filter'     => '.*',        # display only directories that match 
	    );



sub handler {
    my($r) = shift;

    # store output in this array
    @gOutput = ();

    $gOutputStarted = 0;

    # set config values
    my $val = '';
    $gOptions{'thumb-size'} = $val if($val = $r->dir_config('Thumb-size'));
    $gOptions{'force'}      = $val if($val = $r->dir_config('Force'));  
    $gOptions{'rows'}       = $val if($val = $r->dir_config('Rows'));
    $gOptions{'cols'}       = $val if($val = $r->dir_config('Cols'));
    $gOptions{'show-names'} = $val if($val = $r->dir_config('Show-names')); 
    $gOptions{'hide-dirs'}  = $val if($val = $r->dir_config('Hide-dirs'));
    $gOptions{'doc-root'}   = $r->document_root . $r->location;
    $gOptions{'base-url'}   = $r->location;
    $gOptions{'filter'}     = $val if($val = $r->dir_config('Filter'));


    # do processing for a directory of images
    if($r->finfo->filetype == DIR) {

        if($r->args =~ /name=/) {
           # show image detail html page
           showImgDetail($r);

        } else {
          # show the thumbnail index html page
          my ($name, $path, $ext) = fileparse($r->filename, qr{\.\w*$});
          mkdir("$path/.thumbs") unless(-d "$path/.thumbs");
          showImgThumbs($r);
        }
    }

    # do processing on the image file itself
    if($r->filename =~ /-thumb/) {
           showThumbFile($r);
    }

ImgIndex.pm view on Meta::CPAN

             );
 
       for(my $y = 0; $y <= int((@filelist - 1)/$perpage); $y++) {
          $index = $perpage * $y;
          my $pagenum = $y + 1;

          ($index == $start) ?
              output(qq|              <option value="$index" selected>page $pagenum\n|):
              output(qq|              <option value="$index">page $pagenum\n|);
       }

       output(
              qq|          </SELECT><BR>\n|,
              qq|          <font size="-1"><i>Total: </i>|, scalar @filelist, qq| images</font>\n|,
              qq|          </FORM>\n|,
              qq|        </TD>\n|
             );
    }
    
    # next page
    if($start + $perpage < $#filelist) {
       $index = $start + $perpage; 
       output(qq|        <TD width=100 align="center"><A href="$baseUri?start=$index">[next]</A></TD>\n|);

    } else {
       output(qq|        <TD width=100>&nbsp;</TD>\n|);
    }


    output(
           "      </TR>\n",
           "    </TABLE>\n",
           "  </TD></TR>\n",
           "</TABLE>\n",
           "</CENTER>\n",
	   "</BODY>\n",
           "</HTML>\n"
          );

}



# showThumbFile
#
#
sub showThumbFile {
    my $r = shift || return;

    my %mimeType = 
       (jpg => 'image/jpeg', gif => 'image/gif', png => 'image/png');
    my ($name, $path, $ext) = fileparse($r->filename, qr{\.\w*$});
    my($w, $h) = split('x', $gOptions{'thumb-size'});

    $name =~ s/^\.//g;
    $path =~ s/\/$//g;
    $ext =~ s/^\.//g;
 
    (my $imgName = $name) =~ s/-thumb$//i;
    my($thumbName) = "$name.$ext";
    my($Img) = Image::Magick->new();
    my($tw, $th) = (0, 0);

    if(-f "$path/$thumbName") {
        ($tw, $th) = $Img->Ping("$path/$thumbName");
    }

    # build the thumbnail if it doesn't exist
    if( ($w != $tw && $h != $th) || $gOptions{'force'} ) {
        $Img->Read("$path/../$imgName.$ext");
        $Img->Resize(geometry=>"$gOptions{'thumb-size'}"); 
        $Img->Write("$path/$thumbName");
    }

    my $Fh = FileHandle->new();
    $Fh->open("$path/$thumbName") || die("Can't open image file $path/$thumbName");

    $r->content_type($mimeType{lc $ext});
    output(<$Fh>);

    undef $Img; 
    $Fh->close();
}



# showImgDetail
#
#
#
sub showImgDetail {
    my($r) = shift;

    my(%in) = map { my($key, $val) = split('=', $_); $key => $val } 
                  (split('&', $r->args));
    my($baseUri) = $r->uri; 

    # only rotate up to 360 degrees 
    if($in{'rot'} >= 360) { $in{'rot'} -= 360 };

    # only allow scaling to 25% and 200% of image size
    if($in{'scale'} < -75) { $in{'scale'} = -75 };
    if($in{'scale'} > 100) { $in{'scale'} = 100 };

    my $scale = $in{'scale'} + 100;

    my $rotText = ($in{'rot'}) ? "(Rotated: $in{'rot'}&deg;)" : ''; 
    my $scaleText = ($in{'scale'}) ? "(Scaled: $scale%)" : '';
 
    $r->content_type("text/html"); 
    output(
              "<HTML>\n",
              "<HEAD>\n",
              "  <TITLE>Image: $in{'name'} $rotText $scaleText</TITLE>\n",
              "</HEAD>\n",
              qq|<BODY bgcolor="#ffffff">\n\n|,
              "<CENTER>\n",
              qq|<TABLE border=1>\n|,
              qq| <TR><TD>&nbsp;</TD><TD align="center"><A href="$baseUri?start=$in{'start'}"><B>Image Index</B></A></TD><TD>&nbsp;</TR>\n|,
              qq| <TR><TD align="center"><A href="$baseUri?start=$in{'start'}&name=$in{'name'}&rot=|,
              $in{'rot'} + 270, qq|&scale=$in{'scale'}"><B>270</B></A></TD>|,
              qq|<TD align="center"><A href="$baseUri?start=$in{'start'}&name=$in{'name'}&rot=$in{'rot'}&scale=|, $in{'scale'} - 25, qq|">-</A> Zoom <A href="$baseUri?start=$in{'start'}&name=$in{'name'}&rot=$in{'rot'}&scale=|, $in{'scale'} + 25, qq|"...
              qq|<TD align="center"><A href="$baseUri?start=$in{'start'}&name=$in{'name'}&rot=|,
              $in{'rot'} + 90, qq|&scale=$in{'scale'}"><B>90</B></A></TD></TR>\n|,
              qq| <TR><TD>&nbsp;</TD><TD align="center"><A href="$baseUri?start=$in{'start'}&name=$in{'name'}&rot=|,
              $in{'rot'} + 180, qq|&scale=$in{'scale'}"><B>180</B></A></TD><TD>&nbsp;</TD></TR>\n|,
              "</TABLE>\n",
              qq|<TABLE border=1 width="100%">\n|,
            );


        output(qq|  <TR><TD align="center"><IMG src="$baseUri/$in{'name'}?|);
        output(qq|rot=$in{'rot'}|) if($in{'rot'});
        output(qq|&scale=$in{'scale'}|) if($in{'scale'});
        output(qq|" border=0></TD></TR>\n|);

    output(
           "</TABLE>\n",
           "</CENTER>\n",
           "</BODY>\n",
           "</HTML>\n",
          );
}


# processImg
#
#
#
sub processImg {
    my($r) = shift;

    my(%in) = map { my($key, $val) = split('=', $_); $key => $val }                             (split('&', $r->args));

    my($imgfile) = $r->filename;
    my ($name, $path, $ext) = fileparse($imgfile, qr{\..*});

    $path =~ s/\/$//g;
    $ext =~ s/^\.//g;

    # only rotate up to 360 degrees
    if($in{'rot'} >= 360) { $in{'rot'} -= 360 };


    # only allow scaling to 25% and 200% of image size
    if($in{'scale'} < -75) { $in{'scale'} = -75 };
    if($in{'scale'} > 100) { $in{'scale'} = 100 };

    if(%in) {
       my($tmpfile) = "/tmp/$name." . time . ".$$.$ext";
      
       my $scale = $in{'scale'} + 100; 
 
       my($Img) = Image::Magick->new;
       $Img->Read($imgfile);
       $Img->Rotate(degrees=>$in{'rot'}) if($in{'rot'});
       $Img->Scale(geometry=>"${scale}%x${scale}%") if($in{'scale'});
       $Img->Write("$tmpfile");

       my($fh)  = FileHandle->new("$tmpfile");

       unless($fh) {
          $r->log_error("Couldn't open file '$tmpfile'");
          return SERVER_ERROR;
       }
 
       local $/;
       output(<$fh>);
       $fh->close;

       unlink $tmpfile;

    } else {
       return DECLINED;
    }

}


# dirIndex
#
#
sub dirIndex {
   my($dirlist) = shift;
   my($dir) = shift;

   my($filter) = $gOptions{'filter'};
   my($dh) = DirHandle->new($dir);
   my(@contents) = $dh->read;
   $dh->close;  

   foreach my $item (sort @contents) {
       # skip directories containing .private files
       next if(-e "$dir/$item/.private");

       # skip files/directories starting with .
       next if($item =~ /^\.+/);

       # skip directories that aren't in the "filter" list 
       next unless("$dir/$item" =~ /$filter/);

       # Add the item to the the directory list if it's a directory 
       next unless(-d "$dir/$item");
       $dirlist->{"$dir/$item"}{'name'} = $item;
   }
}



# listDirectory
#
#
sub listDirectory {
    my($dir) = shift;

( run in 1.516 second using v1.01-cache-2.11-cpan-fe3c2283af0 )