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

lib/Apache/Gallery.pm  view on Meta::CPAN

	}

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

	my $scale = ($orig_width ? $width/$orig_width : 1);

	if ($orig_height) {
		if ($orig_height * $scale > $thumbnailheight) {
			$scale = $height/$orig_height;
			$width = $orig_width * $scale;
		}
	}

	$height = $orig_height * $scale;

	$height = floor($height);
	$width  = floor($width);

	return ($width, $height);
}

sub get_image_display_size {
	my ($cgi, $r, $orig_width, $orig_height) = @_;

	my $width = $orig_width;

	my $original_size=$orig_height;
	if ($orig_width>$orig_height) {
		$original_size=$orig_width;
	}

	# Check if the selected width is allowed
	my @sizes = split (/ /, $r->dir_config('GallerySizes') ? $r->dir_config('GallerySizes') : '640 800 1024 1600');

	my %cookies = fetch CGI::Cookie;

	if ($cgi->param('width')) {
		unless ((grep $cgi->param('width') == $_, @sizes) or ($cgi->param('width') == $original_size)) {
			show_error($r, 200, "Invalid width", "The specified width is invalid");
			return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
		}

		$width = $cgi->param('width');
		my $cookie = new CGI::Cookie(-name => 'GallerySize', -value => $width, -expires => '+6M');
		$r->headers_out->{'Set-Cookie'} = $cookie;

	} elsif ($cookies{'GallerySize'} && (grep $cookies{'GallerySize'}->value == $_, @sizes)) {

		$width = $cookies{'GallerySize'}->value;

	} else {
		$width = $sizes[0];
	}	

	my $scale;
	my $image_width;
	if ($orig_width<$orig_height) {
		$scale = ($orig_height ? $width/$orig_height: 1);
		$image_width=$width*$orig_width/$orig_height;
	}
	else {
		$scale = ($orig_width ? $width/$orig_width : 1);
		$image_width = $width;
	}

	my $height = $orig_height * $scale;

	$image_width = floor($image_width);
	$width       = floor($width);
	$height      = floor($height);

	return ($image_width, $width, $height, $original_size);
}

sub get_imageinfo {
	my ($r, $file, $type, $width, $height) = @_;
	my $imageinfo = {};
	if ($type eq 'Data stream is not a known image file format') {
		# should never be reached, this is supposed to be handled outside of here
		log_error("Something was fishy with the type of the file $file\n");
	} else { 

		# Some files, like TIFF, PNG, GIF do not have EXIF info 
		# embedded but use .thm files instead.
		$imageinfo = get_imageinfo_from_thm_file($file, $width, $height);

		# If there is no .thm file and our file is a JPEG file we try to extract the EXIf
		# info using Image::Info
		unless (defined($imageinfo) && (grep $type eq $_, qw(JPG))) {
			# Only for files that natively keep the EXIF info in the same file
			$imageinfo = image_info($file);
		}
	}

	unless (defined($imageinfo->{width}) and defined($imageinfo->{height})) {
		$imageinfo->{width} = $width;
		$imageinfo->{height} = $height;
	}

	my @infos = split /, /, $r->dir_config('GalleryInfo') ? $r->dir_config('GalleryInfo') : 'Picture Taken => DateTimeOriginal, Flash => Flash';
	foreach (@infos) {
		
		my ($human_key, $exif_key) = (split " => ")[0,1];
		if (defined($exif_key) && defined($imageinfo->{$exif_key})) {
			my $value = "";