view release on metacpan or  search on metacpan

lib/Nginx/Module/Gallery.pm  view on Meta::CPAN

    server {
        listen                  80;

        server_name             gallery.localhost;

        location / {
            perl  Nginx::Module::Gallery::handler;
            # Path to image files
            root /usr/share/images;
        }
    }

=head1 DESCRIPTION

This module not for production servers! But for single user usage.
Gallery don`t use nginx event machine, so one nginx worker per connect
(typically 8) used for slow create thumbnails!

All thumbnails cached on first request. Next show will be more fast.

=cut

=head1 VARIABLES

=cut

# Module version
our $VERSION = '0.3.0';

our %CONFIG;

# Fixed thumbnails
use constant ICON_FOLDER    => '/folder.png';
use constant ICON_UPDIR     => '/updir.png';
use constant ICON_FAVICON   => '/favicon.png';
use constant ICON_ARCHIVE   => '/archive.png';

# MIME type of unknown files
use constant MIME_UNKNOWN   => 'x-unknown/x-unknown';

# Buffer size for output archive to client
use constant ARCHIVE_BUFFER_SIZE => 4096;

# Timeout for index create
use constant EVENT_TIMEOUT  => 1;

# Nginx module is ugly
eval{ require nginx; };
die $@ if $@;

use Mojo::Template;
use MIME::Types;
use File::Spec;
use File::Basename;
use File::Path qw(make_path);
use File::Temp qw(tempfile);
use File::Find;
use Digest::MD5 'md5_hex';
use URI::Escape qw(uri_escape);
use Image::Magick;

# MIME definition objects
our $mimetypes = MIME::Types->new;
our $mime_unknown   = MIME::Type->new(
    simplified  => 'unknown/unknown',
    type        => 'x-unknown/x-unknown'
);

# Default mime for thumbnails
our $mime_png   = $mimetypes->mimeTypeOf( 'png' );

# Templates
our $mt = Mojo::Template->new;
$mt->encoding('UTF-8');

=head1 HANDLERS

=cut

=head2 index $r

Directory index handler

=cut

sub index($)
{
    my $r = shift;

    # Get configuration variables
    _get_variables($r);

    # Stop unless GET or HEAD
    return HTTP_BAD_REQUEST unless grep {$r->request_method eq $_} qw{GET HEAD};
    # Stop unless dir or file
    return HTTP_NOT_FOUND unless -f $r->filename or -d _;
    # Stop if header only
    return OK if $r->header_only;

    # show file
    return show_image($r) if -f _;
    # show directory index
    return show_index($r);
}

=head2 archive $r

Online archive response

=cut

sub archive($)
{
    my $r = shift;

    # Get configuration variables
    _get_variables($r);

    # Stop unless GET or HEAD
    return HTTP_BAD_REQUEST unless grep {$r->request_method eq $_} qw{GET HEAD};

lib/Nginx/Module/Gallery.pm  view on Meta::CPAN

=cut

=head2 _get_video_thumb $path

Get raw thumbnail data for video file by it`s $path

=cut

sub _get_video_thumb($)
{
    my ($path) = @_;

    # Get standart extension
    my @ext     = $mime_png->extensions;
    my $suffix  = $ext[0] || 'png';

    # Full file read
    local $/;

    # Convert to temp thumbnail file
    my ($fh, $filename) =
        tempfile( UNLINK => 1, OPEN => 1, SUFFIX => '.'.$suffix );
    return unless $fh;

    system '/usr/bin/ffmpegthumbnailer',
        '-s', $CONFIG{ICON_MAX_DIMENSION},
        '-q', $CONFIG{ICON_QUALITY_LEVEL},
#            '-f',
        '-i', $path,
        '-o', $filename;

    # Get image
    my $raw = <$fh>;
    close $fh or return;
    return unless $raw;

    my $mime = $mime_png || $mime_unknown;

    my %result = (
        raw     => $raw,
        mime    => $mime,
        orig    => {
            path    => $path,
        },
    );

    return wantarray ?%result :\%result;
}

=head2 _get_image_thumb $path

Get raw thumbnail data for image file by it`s $path

=cut

sub _get_image_thumb($)
{
    my ($path) = @_;

    # Get image and attributes
    my $image = Image::Magick->new;
    $image->Read($path);
    my ($image_width, $image_height, $image_size) =
        $image->Get("width", "height", "filesize");

    # Save image on disk:
    # Remove any sequences (for GIF)
    for (my $x = 1; $image->[$x]; $x++) {
        undef $image->[$x];
    }
    # Remove original comments, EXIF, etc.
    $image->Strip;
    # make tumbnail
    $image->Thumbnail(geometry =>
        $CONFIG{ICON_MAX_DIMENSION}.'x'.$CONFIG{ICON_MAX_DIMENSION}.'>');
    # Set colors
    $image->Quantize(colorspace => 'RGB');
    # Orient
    $image->AutoOrient;
    # Some compression
    $image->Set(quality => $CONFIG{ICON_COMPRESSION_LEVEL});

    # Get mime type as icon type
    my $mime = $mime_png || $mime_unknown;

    my %result = (
        mime    => $mime,
        orig    => {
            path    => $path,
            width   => $image_width,
            heigth  => $image_height,
            size    => $image_size,
        },
        save    => sub {
            my ($cache) = @_;
            my $msg = $image->Write( $cache );
            undef $image;
            warn "$msg" if "$msg";
            return 1;
        }
    );

    return wantarray ?%result :\%result;
}

=head2 _get_image_thumb $path

Get raw thumbnail data for icon file by it`s $path

=cut

sub _get_icon_thumb($)
{
    my ($path) = @_;

    # Show just small icons
    return unless -s $path < $CONFIG{ICON_MAX_SIZE};

    # Full file read
    local $/;