Apache-Gallery
view release on metacpan or search on metacpan
lib/Apache/Gallery.pm view on Meta::CPAN
}
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",
lib/Apache/Gallery.pm view on Meta::CPAN
});
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);
$tpl_vars{FORM_BEGIN} = $select_mode?'<form method="post">':'';
$tpl_vars{FORM_END} = $select_mode?'<input type="submit" name="Get list" value="Get list"></form>':'';
# Read, sort, and filter files
my @files = grep { !/^\./ && -f "$filename/$_" } readdir (DIR);
@files=gallerysort($r, @files);
my @downloadable_files;
if (@files) {
# Remove unwanted files from list
my @new_files = ();
foreach my $picture (@files) {
my $file = $topdir."/".$picture;
if ($file =~ /$img_pattern/i) {
push (@new_files, $picture);
}
if ($file =~ /$doc_pattern/i) {
push (@downloadable_files, $picture);
}
}
@files = @new_files;
}
# Read and sort directories
rewinddir (DIR);
my @directories = grep { !/^\./ && -d "$filename/$_" } readdir (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)$/) {
@directories = map(/^\d+ (.*)/, sort map(stat("$filename/$_")->$dirsortby()." $_", @directories));
} else {
@directories = sort @directories;
}
closedir(DIR);
# Combine directories and files to one listing
my @listing;
push (@listing, @directories);
push (@listing, @files);
push (@listing, @downloadable_files);
if (@listing) {
my $filelist;
my $file_counter = 0;
my $start_at = 1;
my $max_files = $r->dir_config('GalleryMaxThumbnailsPerPage');
if (defined($cgi->param('start'))) {
$start_at = $cgi->param('start');
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";
}
if ($neightbour_counter < scalar @neighbour_directories - 1) {
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{NEXT_DIR_FILES} = $templates{navdirectory}->fill_in(HASH=> {%info});
print STDERR "next directory is " .$neighbour_directories[$neightbour_counter+1] ."\n";
}
}
$neightbour_counter++;
}
}
if (-f $topdir . '.comment') {
my $comment_ref = get_comment($topdir . '.comment');
my %comment_vars;
$comment_vars{COMMENT} = $comment_ref->{COMMENT} . '<br />' if $comment_ref->{COMMENT};
$comment_vars{TITLE} = $comment_ref->{TITLE} if $comment_ref->{TITLE};
$tpl_vars{DIRCOMMENT} = $templates{comment}->fill_in(HASH => \%comment_vars);
$tpl_vars{TITLE} = $comment_ref->{TITLE} if $comment_ref->{TITLE};
} else {
$tpl_vars{DIRCOMMENT} = $templates{nocomment}->fill_in(HASH=>\%tpl_vars);
}
if ($cgi->param('rss')) {
$tpl_vars{MAIN} = $templates{rss}->fill_in(HASH => \%tpl_vars);
$r->content_type('application/rss+xml');
} else {
$tpl_vars{MAIN} = $templates{index}->fill_in(HASH => \%tpl_vars);
$tpl_vars{MAIN} = $templates{layout}->fill_in(HASH => \%tpl_vars);
$r->content_type('text/html');
lib/Apache/Gallery.pm view on Meta::CPAN
my $parent = $dir;
$parent =~ s/\/[^\/]*$//;
mkdirhier($parent);
mkdir($dir, 0755);
}
}
}
sub get_scaled_picture_name {
my ($fullpath, $width, $height) = @_;
my (undef, undef, $type) = imgsize($fullpath);
my @dirs = split(/\//, $fullpath);
my $filename = pop(@dirs);
my $newfilename;
if (grep $type eq $_, qw(PPM TIF GIF)) {
$newfilename = $width."x".$height."-".$filename;
# needs to be configurable
$newfilename =~ s/\.(\w+)$/-$1\.jpg/;
} else {
$newfilename = $width."x".$height."-".$filename;
}
return $newfilename;
}
sub scale_picture {
my ($r, $fullpath, $width, $height, $imageinfo) = @_;
my @dirs = split(/\//, $fullpath);
my $filename = pop(@dirs);
my ($orig_width, $orig_height, $type) = imgsize($fullpath);
my $cache = cache_dir($r, 1);
my $newfilename = get_scaled_picture_name($fullpath, $width, $height);
if (($width > $orig_width) && ($height > $orig_height)) {
# Run it through the resize code anyway to get watermarks
$width = $orig_width;
$height = $orig_height;
}
my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);
# Do we want to generate a new file in the cache?
my $scale = 1;
if (-f $cache."/".$newfilename) {
$scale = 0;
# Check to see if the image has changed
my $filestat = stat($fullpath);
my $cachestat = stat($cache."/".$newfilename);
if ($filestat->mtime >= $cachestat->mtime) {
$scale = 1;
}
# Check to see if the .rotate file has been added or changed
if (-f $fullpath . ".rotate") {
my $rotatestat = stat($fullpath . ".rotate");
if ($rotatestat->mtime > $cachestat->mtime) {
$scale = 1;
}
}
# Check to see if the copyrightimage has been added or changed
if ($r->dir_config('GalleryCopyrightImage') && -f $r->dir_config('GalleryCopyrightImage')) {
unless ($width == $thumbnailwidth or $width == $thumbnailheight) {
my $copyrightstat = stat($r->dir_config('GalleryCopyrightImage'));
if ($copyrightstat->mtime > $cachestat->mtime) {
$scale = 1;
}
}
}
}
if ($scale) {
my $newpath = $cache."/".$newfilename;
my $rotate = readfile_getnum($r, $imageinfo, $fullpath . ".rotate");
my $quality = $r->dir_config('GalleryQuality');
if ($width == $thumbnailwidth or $width == $thumbnailheight) {
resizepicture($r, $fullpath, $newpath, $width, $height, $rotate, '', '', '', '', '', '');
} else {
resizepicture($r, $fullpath, $newpath, $width, $height, $rotate,
($r->dir_config('GalleryCopyrightImage') ? $r->dir_config('GalleryCopyrightImage') : ''),
($r->dir_config('GalleryTTFDir') ? $r->dir_config('GalleryTTFDir') : ''),
($r->dir_config('GalleryCopyrightText') ? $r->dir_config('GalleryCopyrightText') : ''),
($r->dir_config('GalleryCopyrightColor') ? $r->dir_config('GalleryCopyrightColor') : ''),
($r->dir_config('GalleryTTFFile') ? $r->dir_config('GalleryTTFFile') : ''),
($r->dir_config('GalleryTTFSize') ? $r->dir_config('GalleryTTFSize') : ''),
($r->dir_config('GalleryCopyrightBackgroundColor') ? $r->dir_config('GalleryCopyrightBackgroundColor') : ''),
$quality);
}
}
return $newfilename;
}
sub get_thumbnailsize {
my ($r, $orig_width, $orig_height) = @_;
my $gallerythumbnailsize=$r->dir_config('GalleryThumbnailSize');
if (defined($gallerythumbnailsize)) {
warn("Invalid setting for GalleryThumbnailSize") unless
$gallerythumbnailsize =~ /^\s*\d+\s*x\s*\d+\s*$/i;
}
my ($thumbnailwidth, $thumbnailheight) = split(/x/i, ($gallerythumbnailsize) ? $gallerythumbnailsize : "100x75");
my $width = $thumbnailwidth;
my $height = $thumbnailheight;
# If the image is rotated, flip everything around.
if (defined $r->dir_config('GalleryThumbnailSizeLS')
and $r->dir_config('GalleryThumbnailSizeLS') eq '1'
and $orig_width < $orig_height) {
$width = $thumbnailheight;
$height = $thumbnailwidth;
}
lib/Apache/Gallery.pm view on Meta::CPAN
$value = $@;
} else {
$value = int($value + 0.5) . "mm";
}
}
}
if ($exif_key eq 'ShutterSpeedValue') {
if ($value =~ /^((?:\-)?\d+)\/(\d+)$/) {
$value = eval { $1 / $2 };
if ($@) {
$value = $@;
} else {
eval {
$value = 1/(exp($value*log(2)));
if ($value < 1) {
$value = "1/" . (int((1/$value)));
} else {
$value = int($value*10)/10;
}
};
if ($@) {
$value = $@;
} else {
$value = $value . " sec";
}
}
}
}
if ($exif_key eq 'ApertureValue') {
if ($value =~ /^(\d+)\/(\d+)$/) {
$value = eval { $1 / $2 };
if ($@) {
$value = $@;
} else {
# poor man's rounding
$value = int(exp($value*log(2)*0.5)*10)/10;
$value = "f" . $value;
}
}
}
if ($exif_key eq 'FNumber') {
if ($value =~ /^(\d+)\/(\d+)$/) {
$value = eval { $1 / $2 };
if ($@) {
$value = $@;
} else {
$value = int($value*10+0.5)/10;
$value = "f" . $value;
}
}
}
$imageinfo->{$human_key} = $value;
}
}
if ($r->dir_config('GalleryUseFileDate') &&
($r->dir_config('GalleryUseFileDate') eq '1'
|| !$imageinfo->{"Picture Taken"} )) {
my $st = stat($file);
$imageinfo->{"DateTimeOriginal"} = $imageinfo->{"Picture Taken"} = scalar localtime($st->mtime) if $st;
}
return $imageinfo;
}
sub get_imageinfo_from_thm_file {
my ($file, $width, $height) = @_;
my $imageinfo = undef;
# Windows based file extensions are often .THM, so check
# for both .thm and .THM
my $unix_file = $file;
my $windows_file = $file;
$unix_file =~ s/\.(\w+)$/.thm/;
$windows_file =~ s/\.(\w+)$/.THM/;
if (-e $unix_file && -f $unix_file && -r $unix_file) {
$imageinfo = image_info($unix_file);
$imageinfo->{width} = $width;
$imageinfo->{height} = $height;
}
elsif (-e $windows_file && -f $windows_file && -r $windows_file) {
$imageinfo = image_info($windows_file);
$imageinfo->{width} = $width;
$imageinfo->{height} = $height;
}
return $imageinfo;
}
sub readfile_getnum {
my ($r, $imageinfo, $filename) = @_;
my $rotate = 0;
print STDERR "orientation: ".$imageinfo->{Orientation}."\n";
# Check to see if the image contains the Orientation EXIF key,
# but allow user to override using rotate
if (!defined($r->dir_config("GalleryAutoRotate"))
|| $r->dir_config("GalleryAutoRotate") eq "1") {
if (defined($imageinfo->{Orientation})) {
print STDERR $imageinfo->{Orientation}."\n";
if ($imageinfo->{Orientation} eq 'right_top') {
$rotate=1;
}
elsif ($imageinfo->{Orientation} eq 'left_bot') {
$rotate=3;
}
}
}
if (open(FH, "<$filename")) {
my $temp = <FH>;
chomp($temp);
close(FH);
unless ($temp =~ /^\d$/) {
$rotate = 0;
lib/Apache/Gallery.pm view on Meta::CPAN
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;
if (($text_x < $x - $offset) && ($text_y < $y - $offset)) {
if ($GalleryCopyrightBackgroundColor =~ /^\d+,\d+,\d+,\d+$/) {
my ($br_val, $bg_val, $bb_val, $ba_val) = split (/,/, $GalleryCopyrightBackgroundColor);
$image->set_colour($br_val, $bg_val, $bb_val, $ba_val);
$image->fill_rectangle ($x-$text_x-$offset, $y-$text_y-$offset, $text_x, $text_y);
}
my ($r_val, $g_val, $b_val, $a_val) = split (/,/, $text_color);
$image->set_colour($r_val, $g_val, $b_val, $a_val);
$image->draw_text($x-$text_x-$offset, $y-$text_y-$offset, "$GalleryCopyrightText");
} else {
log_error("Text is to big for the picture.\n");
}
}
}
if ($quality && $quality =~ m/^\d+$/) {
$image->set_quality($quality);
}
$image->save($outfile);
}
sub gallerysort {
my $r=shift;
my @files=@_;
my $sortby = $r->dir_config('GallerySortBy');
my $filename=$r->lookup_uri($r->uri)->filename;
$filename=(File::Spec->splitpath($filename))[1] if (-f $filename);
if ($sortby && $sortby =~ m/^(size|atime|mtime|ctime)$/) {
@files = map(/^\d+ (.*)/, sort map(stat("$filename/$_")->$sortby()." $_", @files));
} else {
@files = sort @files;
}
return @files;
}
# Create Text::Template objects used by Apache::Gallery. Takes a
# hashref of template_name, template_filename pairs, and returns a
# list of template_name, texttemplate_object pairs.
sub create_templates {
my $templates = shift;
# This routine is called whenever a template has an error. Prints
# the error to STDERR and sticks the error in the output
sub tt_broken {
my %args = @_;
# Pull out the name and filename from the arg option [see
# Text::Template for details]
@args{qw(name file)} = @{$args{arg}};
print STDERR qq(Template $args{name} ("$args{file}") is broken: $args{error});
# Don't include the file name in the output, as the user can see this.
return qq(<!-- Template $args{name} is broken: $args{error} -->);
}
my %texttemplate_objects;
for my $template_name (keys %$templates) {
my $tt_obj = Text::Template->new(TYPE => 'FILE',
SOURCE => $$templates{$template_name},
BROKEN => \&tt_broken,
BROKEN_ARG => [$template_name, $$templates{$template_name}],
)
or die "Unable to create new Text::Template object for $template_name: $Text::Template::ERROR";
$texttemplate_objects{$template_name} = $tt_obj;
}
return %texttemplate_objects;
}
sub log_error {
if ($::MP2) {
Apache2::RequestUtil->request->log_error(shift());
} else {
Apache->request->log_error(shift());
}
}
1;
=head1 NAME
Apache::Gallery - mod_perl handler to create an image gallery
=head1 SYNOPSIS
See the INSTALL file in the distribution for installation instructions.
=head1 DESCRIPTION
( run in 3.373 seconds using v1.01-cache-2.11-cpan-8f98c5d2c55 )