Apache-Gallery
view release on metacpan or search on metacpan
lib/Apache/Gallery.pm view on Meta::CPAN
package Apache::Gallery;
# $Author: mil $ $Rev: 335 $
# $Date: 2011-06-08 20:47:46 +0200 (Wed, 08 Jun 2011) $
use strict;
use vars qw($VERSION);
$VERSION = "1.0.2";
BEGIN {
if (exists($ENV{MOD_PERL_API_VERSION})
and ($ENV{MOD_PERL_API_VERSION}==2)) {
require mod_perl2;
if ($mod_perl::VERSION >= 1.99 && $mod_perl::VERSION < 2.0) {
die "mod_perl 2.0.0 or later is now required";
}
require Apache2::ServerRec;
require Apache2::RequestRec;
require Apache2::Log;
require APR::Table;
require Apache2::RequestIO;
require Apache2::SubRequest;
require Apache2::Const;
Apache2::Const->import(-compile => 'OK','DECLINED','FORBIDDEN','NOT_FOUND','HTTP_NOT_MODIFIED');
$::MP2 = 1;
} else {
require mod_perl;
require Apache;
require Apache::Constants;
require Apache::Request;
Apache::Constants->import('OK','DECLINED','FORBIDDEN','NOT_FOUND');
$::MP2 = 0;
}
}
use Image::Info qw(image_info);
use Image::Size qw(imgsize);
use Image::Imlib2;
use Text::Template;
use File::stat;
use File::Spec;
use POSIX qw(floor);
use URI::Escape;
use CGI;
use CGI::Cookie;
use Encode;
use HTTP::Date;
use Digest::MD5 qw(md5_base64);
use Data::Dumper;
# Regexp for escaping URI's
my $escape_rule = "^A-Za-z0-9\-_.!~*'()\/";
my $memoized;
sub handler {
my $r = shift or Apache2::RequestUtil->request();
unless (($r->method eq 'HEAD') or ($r->method eq 'GET')) {
return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
}
if ((not $memoized) and ($r->dir_config('GalleryMemoize'))) {
require Memoize;
Memoize::memoize('get_imageinfo');
$memoized=1;
}
$r->headers_out->{"X-Powered-By"} = "apachegallery.dk $VERSION - Hest design!";
$r->headers_out->{"X-Gallery-Version"} = '$Rev: 335 $ $Date: 2011-06-08 20:47:46 +0200 (Wed, 08 Jun 2011) $';
my $filename = $r->filename;
$filename =~ s/\/$//;
my $topdir = $filename;
my $media_rss_enabled = $r->dir_config('GalleryEnableMediaRss');
# Just return the http headers if the client requested that
if ($r->header_only) {
if (!$::MP2) {
$r->send_http_header;
}
if (-f $filename or -d $filename) {
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
else {
return $::MP2 ? Apache2::Const::NOT_FOUND() : Apache::Constants::NOT_FOUND();
}
}
my $cgi = new CGI;
# Handle selected images
if ($cgi->param('selection')) {
my @selected = $cgi->param('selection');
my $content = join "<br />\n",@selected;
$r->content_type('text/html');
$r->headers_out->{'Content-Length'} = length($content);
if (!$::MP2) {
$r->send_http_header;
}
$r->print($content);
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
# Selectmode providing checkboxes beside all thumbnails
my $select_mode = $cgi->param('select');
# Let Apache serve icons without us modifying the request
if ($r->uri =~ m/^\/icons/i) {
return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
}
# Lookup the file in the cache and scale the image if the cached
# image does not exist
if ($r->uri =~ m/\.cache\//i) {
my $filename = $r->filename().$r->path_info();
$filename =~ s/\.cache//;
$filename =~ m/\/(\d+)x(\d+)\-/;
my $image_width = $1;
my $image_height = $2;
$filename =~ s/\/(\d+)x(\d+)\-//;
my ($width, $height, $type) = imgsize($filename);
my $imageinfo = get_imageinfo($r, $filename, $type, $width, $height);
my $cached = scale_picture($r, $filename, $image_width, $image_height, $imageinfo);
my $file = cache_dir($r, 0);
$file =~ s/\.cache//;
my $subr = $r->lookup_file($file);
$r->content_type($subr->content_type());
if ($::MP2) {
my $fileinfo = stat($file);
my $nonce = md5_base64($fileinfo->ino.$fileinfo->mtime);
if ($r->headers_in->{"If-None-Match"} eq $nonce) {
return Apache2::Const::HTTP_NOT_MODIFIED();
}
if ($r->headers_in->{"If-Modified-Since"} && str2time($r->headers_in->{"If-Modified-Since"}) < $fileinfo->mtime) {
return Apache2::Const::HTTP_NOT_MODIFIED();
}
$r->headers_out->{"Content-Length"} = $fileinfo->size;
$r->headers_out->{"Last-Modified-Date"} = time2str($fileinfo->mtime);
$r->headers_out->{"ETag"} = $nonce;
$r->sendfile($file);
return Apache2::Const::OK();
}
else {
$r->path_info('');
$r->filename($file);
return Apache::Constants::DECLINED();
}
}
my $uri = $r->uri;
$uri =~ s/\/$//;
unless (-f $filename or -d $filename) {
show_error($r, 404, "404!", "No such file or directory: ".uri_escape($r->uri, $escape_rule));
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
my $doc_pattern = $r->dir_config('GalleryDocFile');
unless ($doc_pattern) {
$doc_pattern = '\.(mpe?g|avi|mov|asf|wmv|doc|mp3|ogg|pdf|rtf|wav|dlt|txt|html?|csv|eps)$'
}
my $img_pattern = $r->dir_config('GalleryImgFile');
unless ($img_pattern) {
$img_pattern = '\.(jpe?g|png|tiff?|ppm)$'
}
# Let Apache serve files we don't know how to handle anyway
if (-f $filename && $filename !~ m/$img_pattern/i) {
return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
}
if (-d $filename) {
unless (-d cache_dir($r, 0)) {
unless (create_cache($r, cache_dir($r, 0))) {
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
}
my $tpl_dir = $r->dir_config('GalleryTemplateDir');
# Instead of reading the templates every single time
# we need them, create a hash of template names and
# the associated Text::Template objects.
my %templates = create_templates({layout => "$tpl_dir/layout.tpl",
index => "$tpl_dir/index.tpl",
directory => "$tpl_dir/directory.tpl",
picture => "$tpl_dir/picture.tpl",
file => "$tpl_dir/file.tpl",
comment => "$tpl_dir/dircomment.tpl",
nocomment => "$tpl_dir/nodircomment.tpl",
rss => "$tpl_dir/rss.tpl",
rss_item => "$tpl_dir/rss_item.tpl",
navdirectory => "$tpl_dir/navdirectory.tpl",
});
my %tpl_vars;
$tpl_vars{TITLE} = "Index of: $uri";
if ($media_rss_enabled) {
# Put the RSS feed on all directory listings
$tpl_vars{META} = '<link rel="alternate" href="?rss=1" type="application/rss+xml" title="" id="gallery" />';
}
unless (opendir (DIR, $filename)) {
show_error ($r, 500, $!, "Unable to access directory $filename: $!");
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
$tpl_vars{MENU} = generate_menu($r);
lib/Apache/Gallery.pm view on Meta::CPAN
if ($start_at < 1) {
$start_at = 1;
}
}
my $browse_links = "";
if (defined($max_files)) {
for (my $i=1; $i<=scalar(@listing); $i++) {
my $from = $i;
my $to = $i+$max_files-1;
if ($to > scalar(@listing)) {
$to = scalar(@listing);
}
if ($start_at < $from || $start_at > $to) {
$browse_links .= "<a href=\"?start=$from\">$from - ".$to."</a> ";
}
else {
$browse_links .= "$from - $to ";
}
$i+=$max_files-1;
}
}
$tpl_vars{BROWSELINKS} = $browse_links;
DIRLOOP:
foreach my $file (@listing) {
$file_counter++;
if ($file_counter < $start_at) {
next;
}
if (defined($max_files) && $file_counter > $max_files+$start_at-1) {
last DIRLOOP;
}
my $thumbfilename = $topdir."/".$file;
my $fileurl = $uri."/".$file;
# Debian bug #619625 <http://bugs.debian.org/619625>
if (-d $thumbfilename && ! -e $thumbfilename . ".ignore") {
my $dirtitle = '';
if (-e $thumbfilename . ".folder") {
$dirtitle = get_filecontent($thumbfilename . ".folder");
}
$dirtitle = $dirtitle ? $dirtitle : $file;
$dirtitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');
$tpl_vars{FILES} .=
$templates{directory}->fill_in(HASH=> {FILEURL => uri_escape($fileurl, $escape_rule),
FILE => $dirtitle,
}
);
}
# Debian bug #619625 <http://bugs.debian.org/619625>
elsif (-f $thumbfilename && $thumbfilename =~ /$doc_pattern/i && $thumbfilename !~ /$img_pattern/i && ! -e $thumbfilename . ".ignore") {
my $type = lc($1);
my $stat = stat($thumbfilename);
my $size = $stat->size;
my $filetype;
if ($thumbfilename =~ m/\.(mpe?g|avi|mov|asf|wmv)$/i) {
$filetype = "video-$type";
} elsif ($thumbfilename =~ m/\.(txt|html?)$/i) {
$filetype = "text-$type";
} elsif ($thumbfilename =~ m/\.(mp3|ogg|wav)$/i) {
$filetype = "sound-$type";
} elsif ($thumbfilename =~ m/$doc_pattern/i) {
$filetype = "application-$type";
} else {
$filetype = "unknown";
}
# Debian bug #348724 <http://bugs.debian.org/348724>
# not images
my $filetitle = $file;
$filetitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');
$tpl_vars{FILES} .=
$templates{file}->fill_in(HASH => {%tpl_vars,
FILEURL => uri_escape($fileurl, $escape_rule),
ALT => "Size: $size Bytes",
FILE => $filetitle,
TYPE => $type,
FILETYPE => $filetype,
}
);
}
# Debian bug #619625 <http://bugs.debian.org/619625>
elsif (-f $thumbfilename && ! -e $thumbfilename . ".ignore") {
my ($width, $height, $type) = imgsize($thumbfilename);
next if $type eq 'Data stream is not a known image file format';
my @filetypes = qw(JPG TIF PNG PPM GIF);
next unless (grep $type eq $_, @filetypes);
my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $width, $height);
my $imageinfo = get_imageinfo($r, $thumbfilename, $type, $width, $height);
my $cached = get_scaled_picture_name($thumbfilename, $thumbnailwidth, $thumbnailheight);
my $rotate = readfile_getnum($r, $imageinfo, $thumbfilename.".rotate");
# Debian bug #348724 <http://bugs.debian.org/348724>
# HTML <img> tag, alt attribute
my $filetitle = $file;
$filetitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');
my %file_vars = (FILEURL => uri_escape($fileurl, $escape_rule),
FILE => $filetitle,
DATE => $imageinfo->{DateTimeOriginal} ? $imageinfo->{DateTimeOriginal} : '', # should this really be a stat of the file instead of ''?
SRC => uri_escape($uri."/.cache/$cached", $escape_rule),
HEIGHT => (grep($rotate==$_, (1, 3)) ? $thumbnailwidth : $thumbnailheight),
WIDTH => (grep($rotate==$_, (1, 3)) ? $thumbnailheight : $thumbnailwidth),
SELECT => $select_mode?'<input type="checkbox" name="selection" value="'.$file.'"> ':'',);
$tpl_vars{FILES} .= $templates{picture}->fill_in(HASH => {%tpl_vars,
%file_vars,
},
);
if ($media_rss_enabled) {
my ($content_image_width, undef, $content_image_height) = get_image_display_size($cgi, $r, $width, $height);
my %item_vars = (
THUMBNAIL => uri_escape($uri."/.cache/$cached", $escape_rule),
LINK => uri_escape($fileurl, $escape_rule),
TITLE => $file,
CONTENT => uri_escape($uri."/.cache/".$content_image_width."x".$content_image_height."-".$file, $escape_rule)
);
$tpl_vars{ITEMS} .= $templates{rss_item}->fill_in(HASH => {
%item_vars
});
}
}
}
}
else {
$tpl_vars{FILES} = "No files found";
$tpl_vars{BROWSELINKS} = "";
}
# Generate prev and next directory menu items
$filename =~ m/(.*)\/.*?$/;
my $parent_filename = $1;
$r->document_root =~ m/(.*)\/$/;
my $root_path = $1;
print STDERR "$filename vs $root_path\n";
if ($filename ne $root_path) {
unless (opendir (PARENT_DIR, $parent_filename)) {
show_error ($r, 500, $!, "Unable to access parent directory $parent_filename: $!");
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
# Debian bug #619625 <http://bugs.debian.org/619625>
my @neighbour_directories = grep { !/^\./ && -d "$parent_filename/$_" && ! -e "$parent_filename/$_" . ".ignore" } readdir (PARENT_DIR);
my $dirsortby;
if (defined($r->dir_config('GalleryDirSortBy'))) {
$dirsortby=$r->dir_config('GalleryDirSortBy');
} else {
$dirsortby=$r->dir_config('GallerySortBy');
}
if ($dirsortby && $dirsortby =~ m/^(size|atime|mtime|ctime)$/) {
@neighbour_directories = map(/^\d+ (.*)/, sort map(stat("$parent_filename/$_")->$dirsortby()." $_", @neighbour_directories));
} else {
@neighbour_directories = sort @neighbour_directories;
}
closedir(PARENT_DIR);
my $neightbour_counter = 0;
foreach my $neighbour_directory (@neighbour_directories) {
if ($parent_filename.'/'.$neighbour_directory eq $filename) {
if ($neightbour_counter > 0) {
print STDERR "prev directory is " .$neighbour_directories[$neightbour_counter-1] ."\n";
my $linktext = $neighbour_directories[$neightbour_counter-1];
if (-e $parent_filename.'/'.$neighbour_directories[$neightbour_counter-1] . ".folder") {
$linktext = get_filecontent($parent_filename.'/'.$neighbour_directories[$neightbour_counter-1] . ".folder");
}
my %info = (
URL => "../".$neighbour_directories[$neightbour_counter-1],
LINK_NAME => "<<< $linktext",
DIR_FILES => "",
);
$tpl_vars{PREV_DIR_FILES} = $templates{navdirectory}->fill_in(HASH=> {%info});
print STDERR $tpl_vars{PREV_DIR_FILES} ."\n";
}
lib/Apache/Gallery.pm view on Meta::CPAN
}
else {
# original size
if (defined($ENV{QUERY_STRING}) && $ENV{QUERY_STRING} eq 'orig') {
if ($r->dir_config('GalleryAllowOriginal') ? 1 : 0) {
$r->filename($filename);
return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
} else {
return $::MP2 ? Apache2::Const::FORBIDDEN() : Apache::Constants::FORBIDDEN();
}
}
# Create cache dir if not existing
my @tmp = split (/\//, $filename);
my $picfilename = pop @tmp;
my $path = (join "/", @tmp)."/";
my $cache_path = cache_dir($r, 1);
unless (-d $cache_path) {
unless (create_cache($r, $cache_path)) {
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
}
my ($orig_width, $orig_height, $type) = imgsize($filename);
my $imageinfo = get_imageinfo($r, $filename, $type, $orig_width, $orig_height);
my ($image_width, $width, $height, $original_size) = get_image_display_size($cgi, $r, $orig_width, $orig_height);
my $cached = get_scaled_picture_name($filename, $image_width, $height);
my $tpl_dir = $r->dir_config('GalleryTemplateDir');
my %templates = create_templates({layout => "$tpl_dir/layout.tpl",
picture => "$tpl_dir/showpicture.tpl",
navpicture => "$tpl_dir/navpicture.tpl",
info => "$tpl_dir/info.tpl",
scale => "$tpl_dir/scale.tpl",
scaleactive => "$tpl_dir/scaleactive.tpl",
orig => "$tpl_dir/orig.tpl",
refresh => "$tpl_dir/refresh.tpl",
interval => "$tpl_dir/interval.tpl",
intervalactive => "$tpl_dir/intervalactive.tpl",
slideshowisoff => "$tpl_dir/slideshowisoff.tpl",
slideshowoff => "$tpl_dir/slideshowoff.tpl",
pictureinfo => "$tpl_dir/pictureinfo.tpl",
nopictureinfo => "$tpl_dir/nopictureinfo.tpl",
});
my %tpl_vars;
my $resolution = (($image_width > $orig_width) && ($height > $orig_height)) ?
"$orig_width x $orig_height" : "$image_width x $height";
$tpl_vars{TITLE} = "Viewing ".$r->uri()." at $image_width x $height";
$tpl_vars{META} = " ";
$tpl_vars{RESOLUTION} = $resolution;
$tpl_vars{MENU} = generate_menu($r);
$tpl_vars{SRC} = uri_escape(".cache/$cached", $escape_rule);
$tpl_vars{URI} = $r->uri();
my $exif_mode = $r->dir_config('GalleryEXIFMode');
unless ($exif_mode) {
$exif_mode = 'namevalue';
}
unless (opendir(DATADIR, $path)) {
show_error($r, 500, "Unable to access directory", "Unable to access directory $path");
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
my @pictures = grep { /$img_pattern/i && ! -e "$path/$_" . ".ignore" } readdir (DATADIR);
closedir(DATADIR);
@pictures = gallerysort($r, @pictures);
$tpl_vars{TOTAL} = scalar @pictures;
my $prevpicture;
my $nextpicture;
for (my $i=0; $i <= $#pictures; $i++) {
if ($pictures[$i] eq $picfilename) {
$tpl_vars{NUMBER} = $i+1;
$prevpicture = $pictures[$i-1];
my $displayprev = ($i>0 ? 1 : 0);
if ($r->dir_config("GalleryWrapNavigation")) {
$prevpicture = $pictures[$i>0 ? $i-1 : $#pictures];
$displayprev = 1;
}
if ($prevpicture and $displayprev) {
my ($orig_width, $orig_height, $type) = imgsize($path.$prevpicture);
my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);
my $imageinfo = get_imageinfo($r, $path.$prevpicture, $type, $orig_width, $orig_height);
my $cached = get_scaled_picture_name($path.$prevpicture, $thumbnailwidth, $thumbnailheight);
my %nav_vars;
$nav_vars{URL} = uri_escape($prevpicture, $escape_rule);
$nav_vars{FILENAME} = $prevpicture;
$nav_vars{WIDTH} = $width;
$nav_vars{PICTURE} = uri_escape(".cache/$cached", $escape_rule);
$nav_vars{DIRECTION} = "« <u>p</u>rev";
$nav_vars{ACCESSKEY} = "P";
$tpl_vars{BACK} = $templates{navpicture}->fill_in(HASH => \%nav_vars);
}
else {
$tpl_vars{BACK} = " ";
}
$nextpicture = $pictures[$i+1];
if ($r->dir_config("GalleryWrapNavigation")) {
$nextpicture = $pictures[$i == $#pictures ? 0 : $i+1];
}
if ($nextpicture) {
my ($orig_width, $orig_height, $type) = imgsize($path.$nextpicture);
my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);
my $imageinfo = get_imageinfo($r, $path.$nextpicture, $type, $thumbnailwidth, $thumbnailheight);
my $cached = get_scaled_picture_name($path.$nextpicture, $thumbnailwidth, $thumbnailheight);
my %nav_vars;
$nav_vars{URL} = uri_escape($nextpicture, $escape_rule);
$nav_vars{FILENAME} = $nextpicture;
$nav_vars{WIDTH} = $width;
$nav_vars{PICTURE} = uri_escape(".cache/$cached", $escape_rule);
$nav_vars{DIRECTION} = "<u>n</u>ext »";
$nav_vars{ACCESSKEY} = "N";
$tpl_vars{NEXT} = $templates{navpicture}->fill_in(HASH => \%nav_vars);
$tpl_vars{NEXTURL} = uri_escape($nextpicture, $escape_rule);
}
else {
$tpl_vars{NEXT} = " ";
$tpl_vars{NEXTURL} = '#';
}
}
}
my $foundcomment = 0;
if (-f $path . '/' . $picfilename . '.comment') {
my $comment_ref = get_comment($path . '/' . $picfilename . '.comment');
$foundcomment = 1;
$tpl_vars{COMMENT} = $comment_ref->{COMMENT} . '<br />' if $comment_ref->{COMMENT};
$tpl_vars{TITLE} = $comment_ref->{TITLE} if $comment_ref->{TITLE};
} elsif ($r->dir_config('GalleryCommentExifKey')) {
my $comment = decode("utf8", $imageinfo->{$r->dir_config('GalleryCommentExifKey')});
$tpl_vars{COMMENT} = encode("iso-8859-1", $comment);
} else {
$tpl_vars{COMMENT} = '';
}
my @infos = split /, /, $r->dir_config('GalleryInfo') ? $r->dir_config('GalleryInfo') : 'Picture Taken => DateTimeOriginal, Flash => Flash';
my $foundinfo = 0;
my $exifvalues;
foreach (@infos) {
my ($human_key, $exif_key) = (split " => ")[0,1];
my $value = $imageinfo->{$human_key};
if (defined($value)) {
$foundinfo = 1;
if ($exif_mode eq 'namevalue') {
my %info_vars;
$info_vars{KEY} = $human_key;
$info_vars{VALUE} = $value;
$tpl_vars{INFO} .= $templates{info}->fill_in(HASH => \%info_vars);
}
if ($exif_mode eq 'variables') {
$tpl_vars{"EXIF_".uc($exif_key)} = $value;
}
if ($exif_mode eq 'values') {
$exifvalues .= "| ".$value." ";
}
}
}
if ($exif_mode eq 'values') {
if (defined($exifvalues)) {
$tpl_vars{EXIFVALUES} = $exifvalues;
}
else {
$tpl_vars{EXIFVALUES} = "";
}
}
if ($foundcomment and !$foundinfo) {
$tpl_vars{INFO} = "";
}
if ($exif_mode ne 'namevalue') {
$tpl_vars{INFO} = "";
}
if ($exif_mode eq 'namevalue' && $foundinfo or $foundcomment) {
$tpl_vars{PICTUREINFO} = $templates{pictureinfo}->fill_in(HASH => \%tpl_vars);
unless (defined($exifvalues)) {
$tpl_vars{EXIFVALUES} = "";
}
}
else {
$tpl_vars{PICTUREINFO} = $templates{nopictureinfo}->fill_in(HASH => \%tpl_vars);
}
# Fill in sizes and determine if any are smaller than the
# actual image. If they are, $scaleable=1
my $scaleable = 0;
my @sizes = split (/ /, $r->dir_config('GallerySizes') ? $r->dir_config('GallerySizes') : '640 800 1024 1600');
foreach my $size (@sizes) {
if ($size<=$original_size) {
my %sizes_vars;
$sizes_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
$sizes_vars{SIZE} = $size;
$sizes_vars{WIDTH} = $size;
if ($width == $size) {
$tpl_vars{SIZES} .= $templates{scaleactive}->fill_in(HASH => \%sizes_vars);
}
else {
$tpl_vars{SIZES} .= $templates{scale}->fill_in(HASH => \%sizes_vars);
}
$scaleable = 1;
}
}
unless ($scaleable) {
my %sizes_vars;
$sizes_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
$sizes_vars{SIZE} = $original_size;
$sizes_vars{WIDTH} = $original_size;
$tpl_vars{SIZES} .= $templates{scaleactive}->fill_in(HASH => \%sizes_vars);
}
$tpl_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
if ($r->dir_config('GalleryAllowOriginal')) {
$tpl_vars{SIZES} .= $templates{orig}->fill_in(HASH => \%tpl_vars);
}
my @slideshow_intervals = split (/ /, $r->dir_config('GallerySlideshowIntervals') ? $r->dir_config('GallerySlideshowIntervals') : '3 5 10 15 30');
foreach my $interval (@slideshow_intervals) {
my %slideshow_vars;
$slideshow_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
$slideshow_vars{SECONDS} = $interval;
$slideshow_vars{WIDTH} = ($width > $height ? $width : $height);
if ($cgi->param('slideshow') && $cgi->param('slideshow') == $interval and $nextpicture) {
$tpl_vars{SLIDESHOW} .= $templates{intervalactive}->fill_in(HASH => \%slideshow_vars);
}
else {
$tpl_vars{SLIDESHOW} .= $templates{interval}->fill_in(HASH => \%slideshow_vars);
}
}
if ($cgi->param('slideshow') and $nextpicture) {
$tpl_vars{SLIDESHOW} .= $templates{slideshowoff}->fill_in(HASH => \%tpl_vars);
unless ((grep $cgi->param('slideshow') == $_, @slideshow_intervals)) {
show_error($r, 200, "Invalid interval", "Invalid slideshow interval choosen");
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
$tpl_vars{URL} = uri_escape($nextpicture, $escape_rule);
$tpl_vars{WIDTH} = ($width > $height ? $width : $height);
$tpl_vars{INTERVAL} = $cgi->param('slideshow');
$tpl_vars{META} .= $templates{refresh}->fill_in(HASH => \%tpl_vars);
}
else {
$tpl_vars{SLIDESHOW} .= $templates{slideshowisoff}->fill_in(HASH => \%tpl_vars);
}
$tpl_vars{MAIN} = $templates{picture}->fill_in(HASH => \%tpl_vars);
$tpl_vars{MAIN} = $templates{layout}->fill_in(HASH => \%tpl_vars);
$r->content_type('text/html');
$r->headers_out->{'Content-Length'} = length($tpl_vars{MAIN});
if (!$::MP2) {
$r->send_http_header;
}
$r->print($tpl_vars{MAIN});
return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
}
sub cache_dir {
my ($r, $strip_filename) = @_;
my $cache_root;
unless ($r->dir_config('GalleryCacheDir')) {
$cache_root = '/var/cache/www/';
if ($r->server->is_virtual) {
$cache_root = File::Spec->catdir($cache_root, $r->server->server_hostname);
} else {
$cache_root = File::Spec->catdir($cache_root, $r->location);
}
} else {
$cache_root = $r->dir_config('GalleryCacheDir');
}
# If the uri contains .cache we need to remove it
my $uri = $r->uri;
$uri =~ s/\.cache//;
my (undef, $dirs, $filename) = File::Spec->splitpath($uri);
# We don't need a volume as this is a relative path
if ($strip_filename) {
return(File::Spec->canonpath(File::Spec->catdir($cache_root, $dirs)));
} else {
return(File::Spec->canonpath(File::Spec->catfile($cache_root, $dirs, $filename)));
}
}
lib/Apache/Gallery.pm view on Meta::CPAN
}
sub generate_menu {
my $r = shift;
my $root_text = (defined($r->dir_config('GalleryRootText')) ? $r->dir_config('GalleryRootText') : "root:" );
my $root_path = (defined($r->dir_config('GalleryRootPath')) ? $r->dir_config('GalleryRootPath') : "" );
my $subr = $r->lookup_uri($r->uri);
my $filename = $subr->filename;
my @links = split (/\//, $r->uri);
my $uri = $r->uri;
$uri =~ s/^$root_path//g;
@links = split (/\//, $uri);
# Get the full path of the base directory
my $dirname;
{
my @direlem = split (/\//, $filename);
for my $i ( 0 .. ( scalar(@direlem) - scalar(@links) ) ) {
$dirname .= shift(@direlem) . '/';
}
chop $dirname;
}
my $picturename;
if (-f $filename) {
$picturename = pop(@links);
}
if ($r->uri eq $root_path) {
return qq{ <a href="$root_path">$root_text</a> };
}
my $menu;
my $menuurl = $root_path;
foreach my $link (@links) {
$menuurl .= $link."/";
my $linktext = $link;
unless (length($link)) {
$linktext = "$root_text ";
}
else {
$dirname = File::Spec->catdir($dirname, $link);
if (-e $dirname . ".folder") {
$linktext = get_filecontent($dirname . ".folder");
}
}
if ("$root_path$uri" eq $menuurl) {
$menu .= "$linktext / ";
}
else {
$menu .= "<a href=\"".uri_escape($menuurl, $escape_rule)."\">$linktext</a> / ";
}
}
if (-f $filename) {
$menu .= $picturename;
}
else {
if ($r->dir_config('GallerySelectionMode') && $r->dir_config('GallerySelectionMode') eq '1') {
$menu .= "<a href=\"".uri_escape($menuurl, $escape_rule);
$menu .= "?select=1\">[select]</a> ";
}
}
return $menu;
}
sub resizepicture {
my ($r, $infile, $outfile, $x, $y, $rotate, $copyrightfile, $GalleryTTFDir, $GalleryCopyrightText, $text_color, $GalleryTTFFile, $GalleryTTFSize, $GalleryCopyrightBackgroundColor, $quality) = @_;
# Load image
my $image = Image::Imlib2->load($infile) or warn("Unable to open file $infile, $!");
# Scale image
$image=$image->create_scaled_image($x, $y) or warn("Unable to scale image $infile. Are you running out of memory?");
# Rotate image
if ($rotate != 0) {
$image->image_orientate($rotate);
}
# blend copyright image onto image
if ($copyrightfile ne '') {
if (-f $copyrightfile and (my $logo=Image::Imlib2->load($copyrightfile))) {
my $x = $image->get_width();
my $y = $image->get_height();
my $logox = $logo->get_width();
my $logoy = $logo->get_height();
$image->blend($logo, 0, 0, 0, $logox, $logoy, $x-$logox, $y-$logoy, $logox, $logoy);
}
else {
log_error("GalleryCopyrightImage $copyrightfile was not found");
}
}
if ($GalleryTTFDir && $GalleryCopyrightText && $GalleryTTFFile && $text_color) {
if (!-d $GalleryTTFDir) {
log_error("GalleryTTFDir $GalleryTTFDir is not a dir\n");
} elsif ($GalleryCopyrightText eq '') {
log_error("GalleryCopyrightText is empty. No text inserted to picture\n");
} elsif (!-e "$GalleryTTFDir/$GalleryTTFFile") {
log_error("GalleryTTFFile $GalleryTTFFile was not found\n");
} else {
$GalleryTTFFile =~ s/\.TTF$//i;
$image->add_font_path("$GalleryTTFDir");
$image->load_font("$GalleryTTFFile/$GalleryTTFSize");
my($text_x, $text_y) = $image->get_text_size("$GalleryCopyrightText");
my $x = $image->get_width();
my $y = $image->get_height();
my $offset = 3;
( run in 0.886 second using v1.01-cache-2.11-cpan-59e3e3084b8 )