CGI::Application::PhotoGallery - module to provide a simple photo gallery

CGI-Application-PhotoGallery documentation Contained in the CGI-Application-PhotoGallery distribution.

Index

Code Index:

NAME

Top

CGI::Application::PhotoGallery - module to provide a simple photo gallery

SYNOPSIS

Top

    use CGI::Application::PhotoGallery;

    my $webapp = CGI::Application::PhotoGallery->new(
        PARAMS => {
            photos_dir  => '/path/to/photos'
        }
    );

    $webapp->run();

DESCRIPTION

Top

CGI::Application::PhotoGallery is a CGI::Application module allowing people to create their own simple photo gallery. There is no need to generate your own thumbnails since they are created on the fly (using either the GD or Image::Magick modules).

To use this module you need to create an instance script. It should look like:

    #!/usr/bin/perl

    use CGI::Application::PhotoGallery;

    my $webapp = CGI::Application::PhotoGallery->new(
        PARAMS => {
            photos_dir  => '/path/to/photos'
        }
    );

    $webapp->run();

You'll need to replace the "/path/to/photos" with the real path to your photos (see the photos_dir options below).

Put this somewhere where CGIs can run and name it something like index.cgi.

This gets you the default behavior and look. To get something more to your specifications you can use the options described below.

INSTALLATION

Top

    perl Makefile.PL
    make
    make test
    make install

OPTIONS

Top

CGI::Application modules accept options using the PARAMS arguement to new(). To give options for this module you change the new() call in the instance script shown above:

    my $webapp = CGI::Application::PhotoGallery->new(
        PARAMS => {
            photos_dir  => '/path/to/photos',
            title       => 'My Photos'
        }
    );

The title option tells PhotoGallery to use 'My Photos' as the title rather than the default value. See below for more information about title and other options.

photos_dir (required)

This parameter is used to specify where all of your photos are located.

Previous limitations of this directory have been lifted.

Your photos directory can have any number of images and sub-directories of images. This is applied recursively so a gallery can have any number of sub-galleries.

script_name

This parameter uses $0 by default, you can change it (or set it to the empty string) if you neeed to. It is needed for creating self referencial links.

title

By default every page will start with the title "My Photo Gallery". You can specify your own using the title parameter.

thumb_size

By default PhotoGallery displays thumbnail images that are 100 x 100 on the index page. You can change this by specifying a number (in pixels) for this option.

preview_thumbs

Before viewing the entire contents of a gallery, you are shown a few preview image. The default number of thumbnails is 4. You can change it by specifying your own value in the instance script.

graphics_lib

You can specifify which graphics library you wish to use to size your thumbnails. Included in this package are Magick (Image::Magick) and the default: GD. You can also create your own if you wish.

index_template

This application uses HTML::Template to generate its HTML pages. If you would like to customize the HTML you can copy the default form template and edit it to suite your needs. The default form template is called 'photos_index.tmpl' and you can get it from the distribution or from wherever this module ended up in your @INC. Pass in the path to your custom template as the value of this parameter.

See HTML::Template for more information about the template syntax.

single_template

The default template for an individual photo is called 'photos_single.tmpl' and you can get it from the distribution or from wherever this module ended up in your @INC. Pass in the path to your custom template as the value of this parameter.

See HTML::Template for more information about the template syntax.

max_width

Setting this value will force the browser to scale images down to this particular width and proportioned height. This is done by setting the width and height attributes on the image tag, thus saving the image will retain the full resolution.

max_height

Setting this value will force the browser to scale images down to this particular height and proportioned width. This is done by setting the width and height attributes on the image tag, thus saving the image will retain the full resolution.

cache_root

Specifies where the file cache data will be stored. Defaults to FileCache under the OS-specific temporary filesdirectory (e.g. /tmp/FileCache). You may want to move this to make the cache persist. Under selinux, however, be careful to put it in a webserver-writable directory.

cache_namespace

Specifies the namespace for this gallery's cache data. Defaults to the gallery title - or 'default'. Changing this will orphan the cache data.

cache_dirumask

Specifies the umask value to use when cache directories are created. Defaults to 0007 to avoid cache poisioning attacks.

cache_datumask

Specifies the umask value to use when cache data is written. Defaults to 006 to avoid cache poisioning attacks. Note that this becomes the umask for all files written by this script. (See Cache::FileCache documentation for why.)

CAPTIONS

Top

You can include captions for your photos by creating a tab-separated database named captions.txt in your photos_dir. The filename should be specified relative of your photos_dir.

    1.jpg   This is a caption.
    Test Gallery/1.jpg  This is another caption.

METHODS

Top

setup( )

This method sets the default options and makes sure all required parameteres are set.

get_photos( $dir )

This method finds all of the image/* files in the specified directory.

mime_types( )

This method will create (if needed) and return a new MIME::Types object.

gfx_lib( )

This method will create (if needed) and return the graphics adaptor specified by the user (default is GD).

cache( )

This method will create (if needed) and return a Cache::FileCache object,

RUN MODES

Top

Reads in the contents of your photos_dir and generates an index of photos.

thumbnail( )

Generates a thumbnail for the requested image using the selected graphics library.

show_image( )

Sends the contents of the image to the browser.

single_index( )

Fills and sends the template for viewing an individual image.

handle_error( )

Renders a template for any failed action.

SEE ALSO

Top

* CGI::Application
* HTML::Template
* CGI::Application::MailPage

AUTHOR

Top

Brian Cassidy <bricas@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2003-2009 by Brian Cassidy

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

CGI-Application-PhotoGallery documentation Contained in the CGI-Application-PhotoGallery distribution. 
package CGI::Application::PhotoGallery;


use base qw( CGI::Application );

use strict;
use warnings;

use File::Basename;
use Cache::FileCache;
use MIME::Types;
use File::Find::Rule;
use File::ShareDir;
use HTTP::Date ();

our $VERSION = '0.15';


sub setup {
    my $self = shift;

    $self->mode_param( 'mode' );
    $self->run_modes(
        index    => 'gallery_index',
        thumb    => 'thumbnail',
        full     => 'show_image',
        view     => 'single_index',
        AUTOLOAD => 'gallery_index'
    );
    $self->start_mode( 'index' );
    $self->error_mode( 'handle_error' );

    # setup defaults

    $self->param( thumb_size => 100 )
        unless defined $self->param( 'thumb_size' );
    $self->param( preview_thumbs => 4 )
        unless defined $self->param( 'preview_thumbs' );
    $self->param( title => 'My Photo Gallery' )
        unless defined $self->param( 'title' );
    $self->param( graphics_lib => 'GD' )
        unless defined $self->param( 'graphics_lib' );
    $self->param( script_name => $0 )
        unless defined $self->param( 'script_name' );

    # check required params

    die
        "PARAMS => { photos_dir => '/path/to/photos' } not set in your instance script!"
        unless defined $self->param( 'photos_dir' );

    # fixes $0 for win32

    $self->param( script_name => basename( $self->param( 'script_name' ) ) )
        if $self->param( 'script_name' );
}


sub get_photos {
    my $self  = shift;
    my $dir   = shift;
    my $types = $self->mime_types;

    my @photos = sort File::Find::Rule->maxdepth( 1 )->file->exec(
        sub {
            my $name = pop;
            return 0 if basename( $name ) eq 'favicon.ico';
            my $mime = $types->mimeTypeOf( $name );
            return 1 if $mime && $mime->mediaType eq 'image';
        }
    )->in( $dir );

    return @photos;
}


sub mime_types {
    my $self = shift;

    unless ( $self->{ _mime_types } ) {
        my $types = MIME::Types->new( only_complete => 1 );
        $types->create_type_index;
        $self->{ _mime_types } = $types;
    }

    return $self->{ _mime_types };
}


sub gfx_lib {
    my $self = shift;

    unless ( $self->{ _gfx_lib } ) {
        my $lib = 'CGI::Application::PhotoGallery::'
            . $self->param( 'graphics_lib' );
        eval "require $lib";
        $self->{ _gfx_lib } = $lib->new;
    }

    return $self->{ _gfx_lib };
}


sub cache {
    my $self = shift;

    unless ( $self->{ _cache } ) {
        my %options = ( namespace => $self->param( 'title' ),
            directory_umask => 0007 );

        $options{ 'cache_root' } = $self->param( 'cache_root' )
            if defined $self->param( 'cache_root' );
        $options{ 'namespace' } = $self->param( 'cache_namespace' )
            if defined $self->param( 'cache_namespace' );
        $options{ 'directory_umask' } = $self->param( 'cache_dirumask' )
            if defined $self->param( 'cache_dirumask' );
        if ( defined $self->param( 'cache_datumask' ) ) {
            umask $self->param( 'cache_datumask' );
        }
        else {
            umask 006;
        }
        $self->{ _cache } = Cache::FileCache->new( \%options );
    }

    return $self->{ _cache };

}


sub gallery_index {
    my $self  = shift;
    my $types = $self->mime_types;
    my $query = $self->query;

    my $limit     = $self->param( 'preview_thumbs' );
    my $photo_dir = $self->param( 'photos_dir' );
    my $user_dir  = $self->query->param( 'dir' ) || '';

    $user_dir =~ s/\.\.//g;
    $user_dir =~ s/\/$//;

    my $parent = $user_dir;
    $parent =~ s{^(.*?)/([^/]+?)/?$}{$1/};

    my $directory = $photo_dir . $user_dir;
    die "ERROR: File not found."                 unless -e $directory;
    die "ERROR: '$directory' is not a directory" unless -d $directory;

    my $output;
    my $cache   = $self->cache;
    my $key     = $directory;
    my $lastmod = ( stat( $directory ) )[ 9 ];
    my $cstamp  = "$directory/.cachetime";

    if ( $output = $cache->get( $key ) ) {
        my $cachetime = $cache->get( $cstamp );
        if ( $cachetime && $cachetime == $lastmod ) {
            my $reqmod;
            if ( my $header = $query->http( 'If-Modified-Since' ) ) {
                $reqmod = HTTP::Date::str2time(
                    ( split( /;/, $header, 2 ) )[ 0 ] );

                if ( $reqmod && $reqmod == $lastmod ) {
                    $self->header_props( { -status => '304 Not Modified' } );
                    return;
                }
            }

            $self->header_add(
                { -last_modified => HTTP::Date::time2str( $lastmod ) } );
            return $output;
        }
    }

    my @dirs = sort File::Find::Rule->directory->mindepth( 1 )->maxdepth( 1 )
        ->in( $directory );

    my @galleries;
    for my $dir ( $directory, @dirs ) {
        my @files = map { s/^$photo_dir//; { filename => $_ }; }
            $self->get_photos( $dir );

        # only limit the number of photos on sub-galleries
        if ( $dir ne $directory ) {
            @files = @files[ 0 .. $limit - 1 ] if @files > $limit;
        }

        ( my $location = $dir ) =~ s/^$photo_dir//;
        push @galleries,
            {
            dir    => $location,
            title  => basename( $dir ),
            photos => \@files
            };
    }

    my $current = shift( @galleries );

    my $html = $self->load_tmpl(
        $self->param( 'index_template' )
            || $self->_dist_file( 'photos_index.tmpl' ),
        associate         => $self,
        global_vars       => 1,
        loop_context_vars => 1,
        die_on_bad_params => 0
    );

    $html->param(
        photos => $current->{ photos },
        gallery_name =>
            ( $user_dir ? $current->{ title } : $self->param( 'title' ) ),
        galleries => \@galleries,
        parent    => $parent,
    );

    $self->header_add(
        { -last_modified => HTTP::Date::time2str( $lastmod ) } );
    $output = $html->output;
    $cache->set( $key    => $output );
    $cache->set( $cstamp => $lastmod );

    return $output;
}


sub thumbnail {
    my $self  = shift;
    my $query = $self->query;
    my $dir   = $self->param( 'photos_dir' );
    my $photo = $query->param( 'photo' );
    my $size  = $self->param( 'thumb_size' );

    die 'ERROR: Missing photo query argument.' unless $photo;

    my $path    = "$dir$photo";
    my $cache   = $self->cache;
    my $key     = "$path$size";
    my $lastmod = ( stat( $path ) )[ 9 ];

    my $data;
    if ( $data = $cache->get( $key ) ) {
        my $reqmod;
        if ( my $header = $query->http( 'If-Modified-Since' ) ) {
            $reqmod
                = HTTP::Date::str2time( ( split( /;/, $header, 2 ) )[ 0 ] );
        }

        if ( $reqmod && $reqmod == $lastmod ) {
            $self->header_props( { -status => '304 Not Modified' } );
            return;
        }
        else {
            $data = undef;
        }
    }

    unless ( $data ) {
        my $gfx = $self->gfx_lib;
        $data = $gfx->resize( $path, $size );
        $cache->set( $key => $data );
    }

    $self->header_props(
        {   -type          => $self->mime_types->mimeTypeOf( $path ),
            -last_modified => HTTP::Date::time2str( $lastmod )
        }
    );

    binmode STDOUT;
    return $data;
}


sub show_image {
    my $self  = shift;
    my $query = $self->query;
    my $dir   = $self->param( 'photos_dir' );
    my $photo = $query->param( 'photo' );
    my $path  = "$dir$photo";

    die 'ERROR: Missing $photo query argument.' unless $photo;

    my $lastmod = ( stat( $path ) )[ 9 ];

    my $reqmod;
    if ( my $header = $query->http( 'If-Modified-Since' ) ) {
        $reqmod = HTTP::Date::str2time( ( split( /;/, $header, 2 ) )[ 0 ] );
    }

    if ( $reqmod && $reqmod == $lastmod ) {
        $self->header_props( { -status => '304 Not Modified' } );
        return;
    }

    open( PHOTO, $path ) or die "ERROR: Cannot open $path: $!";
    binmode PHOTO;
    my $data = do { local $/; <PHOTO> };
    close( PHOTO );

    $self->header_props(
        {   -type          => $self->mime_types->mimeTypeOf( $path ),
            -last_modified => HTTP::Date::time2str( $lastmod )
        }
    );

    return $data;
}


sub single_index {
    my $self  = shift;
    my $query = $self->query();
    my $dir   = $self->param( 'photos_dir' );
    my $photo = $query->param( 'photo' );
    my $path  = "$dir$photo";

    die 'ERROR: Missing photo query argument.' unless $photo;
    die 'ERROR: File not found' unless -e $path;

    my $caption_path = "$dir/captions.txt";

    my $output;
    my $cache   = $self->cache;
    my $key     = "$path.#frame";
    my $lastmod = ( stat( $path ) )[ 9 ];

    # Directory change means links may have changed
    # Caption file change is a content change
    my $lastdir = ( stat( $dir ) )[ 9 ];
    $lastmod = $lastdir if ( $lastdir > $lastmod );
    my $lastcap = 0;
    $lastcap = ( stat( $caption_path ) )[ 9 ] if ( -r $caption_path );
    $lastmod = $lastcap if ( $lastcap > $lastmod );
    my $cstamp = "$key#cachetime";

    if ( $output = $cache->get( $key ) ) {
        my $cachetime = $cache->get( $cstamp );
        if ( $cachetime && $cachetime == $lastmod ) {
            my $reqmod;
            if ( my $header = $query->http( 'If-Modified-Since' ) ) {
                $reqmod = HTTP::Date::str2time(
                    ( split( /;/, $header, 2 ) )[ 0 ] );

                if ( $reqmod && $reqmod == $lastmod ) {
                    $self->header_props( { -status => '304 Not Modified' } );
                    return;
                }
            }

            $self->header_add(
                { -last_modified => HTTP::Date::time2str( $lastmod ) } );
            return $output;
        }
    }

    my $gfx = $self->gfx_lib;

    my ( $width, $height ) = eval { $gfx->size( $path ); };

    die "Unable to determine size of $path; file may be corrupt.\nError string: $@" if $@;

    # get data for prev/next/parent links
    my ( undef, $search_dir ) = fileparse( $path );
    my ( undef, $parent )     = fileparse( $photo );
    my @files = $self->get_photos( $search_dir );
    my ( $prev, $next );

    while ( my $f = shift @files ) {
        $f =~ s{^$dir}{};
        if ( $f ne $photo ) {
            $prev = $f;
            next;
        }
        else {
            $next = shift @files;
            $next =~ s{^$dir}{} if $next;
            last;
        }
    }

    my $html = $self->load_tmpl(
        $self->param( 'single_template' )
            || $self->_dist_file( 'photos_single.tmpl' ),
        associate         => $self,
        global_vars       => 1,
        die_on_bad_params => 0
    );

    if ( defined( my $max_width = $self->param( 'max_width' ) ) ) {
        if ( $width > $max_width ) {
            my $scale = $max_width / $width;
            $width  = int( $width * $scale );
            $height = int( $height * $scale );
        }
    }

    if ( defined( my $max_height = $self->param( 'max_height' ) ) ) {
        if ( $height > $max_height ) {
            my $scale = $max_height / $height;
            $width  = int( $width * $scale );
            $height = int( $height * $scale );
        }
    }

    $html->param(
        photo  => $photo,
        width  => $width,
        height => $height,
        next   => $next,
        prev   => $prev,
        parent => $parent,
    );

    # get caption, if available
    if ( -e $caption_path ) {
        open( CAPTIONS, $caption_path )
            or die "ERROR: Cannot open caption file $caption_path: $!";
        while ( my $caption = <CAPTIONS> ) {
            if ( $caption =~ /^\Q$photo\E\t(.+)$/ ) {
                $html->param( caption => $1 );
                last;
            }
        }
        close( CAPTIONS );
    }

    $self->header_add(
        { -last_modified => HTTP::Date::time2str( $lastmod ) } );
    $output = $html->output;
    $cache->set( $key    => $output );
    $cache->set( $cstamp => $lastmod );

    return $output;
}

sub _dist_file {
    my ( $self, $file ) = @_;
    return File::ShareDir::dist_file( 'CGI-Application-PhotoGallery', $file );
}


sub handle_error {
    my ( $self, $error ) = @_;

    if ( $error =~ m{file not found}i ) {
        $self->header_props( { -status => '404 Not Found' } );
        $error = 'ERROR: File not found.';
    }
    else {
        # log non-404 errors
        warn $error;
        $error =~ s{\n}{<br/>}g;
        $self->header_props( { -status => '500 Error' } );
    }

    my $html = $self->load_tmpl(
        $self->param( 'error_template' ) || $self->_dist_file( 'error.tmpl' ),
        associate         => $self,
        global_vars       => 1,
        die_on_bad_params => 0
    );

    $html->param( error => $error );

    return $html->output;
}


1;