view release on metacpan or  search on metacpan

lib/CGI/Application/PhotoGallery.pm  view on Meta::CPAN

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

=cut

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 };

}

=head1 RUN MODES

=head2 gallery_index( )

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

=cut

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;
}

=head2 thumbnail( )

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

=cut

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;
}

=head2 show_image( )

Sends the contents of the image to the browser.

=cut

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;
}

=head2 single_index( )

Fills and sends the template for viewing an individual image.

=cut

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 );