lib/Apache/Gallery.pm

   1 package Apache::Gallery;
   2
   3 # $Author: mil $ $Rev: 335 $
   4 # $Date: 2011-06-08 20:47:46 +0200 (Wed, 08 Jun 2011) $
   5
   6 use strict;
   7
   8 use vars qw($VERSION);
   9
  10 $VERSION = "1.0.2";
  11
  12 BEGIN {
  13
  14         if (exists($ENV{MOD_PERL_API_VERSION})
  15                 and ($ENV{MOD_PERL_API_VERSION}==2)) {
  16                 require mod_perl2;
  17                 if ($mod_perl::VERSION >= 1.99 && $mod_perl::VERSION < 2.0) {
  18                         die "mod_perl 2.0.0 or later is now required";
  19                 }
  20                 require Apache2::ServerRec;
  21                 require Apache2::RequestRec;
  22                 require Apache2::Log;
  23                 require APR::Table;
  24                 require Apache2::RequestIO;
  25                 require Apache2::SubRequest;
  26                 require Apache2::Const;
  27
  28                 Apache2::Const->import(-compile => 'OK','DECLINED','FORBIDDEN','NOT_FOUND','HTTP_NOT_MODIFIED');
  29
  30                 $::MP2 = 1;
  31         } else {
  32                 require mod_perl;
  33
  34                 require Apache;
  35                 require Apache::Constants;
  36                 require Apache::Request;
  37
  38                 Apache::Constants->import('OK','DECLINED','FORBIDDEN','NOT_FOUND');
  39                 $::MP2 = 0;
  40         }
  41 }
  42
  43 use Image::Info qw(image_info);
  44 use Image::Size qw(imgsize);
  45 use Image::Imlib2;
  46 use Text::Template;
  47 use File::stat;
  48 use File::Spec;
  49 use POSIX qw(floor);
  50 use URI::Escape;
  51 use CGI;
  52 use CGI::Cookie;
  53 use Encode;
  54 use HTTP::Date;
  55 use Digest::MD5 qw(md5_base64);
  56
  57 use Data::Dumper;
  58
  59 # Regexp for escaping URI's
  60 my $escape_rule = "^A-Za-z0-9\-_.!~*'()\/";
  61 my $memoized;
  62
  63 sub handler {
  64
  65         my $r = shift or Apache2::RequestUtil->request();
  66
  67         unless (($r->method eq 'HEAD') or ($r->method eq 'GET')) {
  68                 return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
  69         }
  70
  71         if ((not $memoized) and ($r->dir_config('GalleryMemoize'))) {
  72                 require Memoize;
  73                 Memoize::memoize('get_imageinfo');
  74                 $memoized=1;
  75         }
  76
  77         $r->headers_out->{"X-Powered-By"} = "apachegallery.dk $VERSION - Hest design!";
  78         $r->headers_out->{"X-Gallery-Version"} = '$Rev: 335 $ $Date: 2011-06-08 20:47:46 +0200 (Wed, 08 Jun 2011) $';
  79
  80         my $filename = $r->filename;
  81         $filename =~ s/\/$//;
  82         my $topdir = $filename;
  83
  84         my $media_rss_enabled = $r->dir_config('GalleryEnableMediaRss');
  85
  86         # Just return the http headers if the client requested that
  87         if ($r->header_only) {
  88
  89                 if (!$::MP2) {
  90                         $r->send_http_header;
  91                 }
  92
  93                 if (-f $filename or -d $filename) {
  94                         return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
  95                 }
  96                 else {
  97                         return $::MP2 ? Apache2::Const::NOT_FOUND() : Apache::Constants::NOT_FOUND();
  98                 }
  99         }
 100
 101         my $cgi = new CGI;
 102
 103         # Handle selected images
 104         if ($cgi->param('selection')) {
 105                 my @selected = $cgi->param('selection');
 106                 my $content = join "<br />\n",@selected;
 107                 $r->content_type('text/html');
 108                 $r->headers_out->{'Content-Length'} = length($content);
 109
 110                 if (!$::MP2) {
 111                         $r->send_http_header;
 112                 }
 113
 114                 $r->print($content);
 115                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 116         }
 117
 118         # Selectmode providing checkboxes beside all thumbnails
 119         my $select_mode = $cgi->param('select');
 120
 121         # Let Apache serve icons without us modifying the request
 122         if ($r->uri =~ m/^\/icons/i) {
 123                 return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
 124         }
 125         # Lookup the file in the cache and scale the image if the cached
 126         # image does not exist
 127         if ($r->uri =~ m/\.cache\//i) {
 128
 129                 my $filename = $r->filename().$r->path_info();
 130                 $filename =~ s/\.cache//;
 131
 132                 $filename =~ m/\/(\d+)x(\d+)\-/;
 133                 my $image_width = $1;
 134                 my $image_height = $2;
 135
 136                 $filename =~ s/\/(\d+)x(\d+)\-//;
 137
 138                 my ($width, $height, $type) = imgsize($filename);
 139
 140                 my $imageinfo = get_imageinfo($r, $filename, $type, $width, $height);
 141
 142                 my $cached = scale_picture($r, $filename, $image_width, $image_height, $imageinfo);
 143
 144                 my $file = cache_dir($r, 0);
 145                 $file =~ s/\.cache//;
 146
 147                 my $subr = $r->lookup_file($file);
 148                 $r->content_type($subr->content_type());
 149
 150                 if ($::MP2) {
 151                         my $fileinfo = stat($file);
 152
 153                         my $nonce = md5_base64($fileinfo->ino.$fileinfo->mtime);
 154                         if ($r->headers_in->{"If-None-Match"} eq $nonce) {
 155                                 return Apache2::Const::HTTP_NOT_MODIFIED();
 156                         }
 157
 158                         if ($r->headers_in->{"If-Modified-Since"} && str2time($r->headers_in->{"If-Modified-Since"}) < $fileinfo->mtime) {
 159                                 return Apache2::Const::HTTP_NOT_MODIFIED();
 160                         }
 161
 162                         $r->headers_out->{"Content-Length"} = $fileinfo->size;
 163                         $r->headers_out->{"Last-Modified-Date"} = time2str($fileinfo->mtime);
 164                         $r->headers_out->{"ETag"} = $nonce;
 165                         $r->sendfile($file);
 166                         return Apache2::Const::OK();
 167                 }
 168                 else {
 169                         $r->path_info('');
 170                         $r->filename($file);
 171                         return Apache::Constants::DECLINED();
 172                 }
 173
 174         }
 175
 176         my $uri = $r->uri;
 177         $uri =~ s/\/$//;
 178
 179         unless (-f $filename or -d $filename) {
 180                 show_error($r, 404, "404!", "No such file or directory: ".uri_escape($r->uri, $escape_rule));
 181                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 182         }
 183
 184         my $doc_pattern = $r->dir_config('GalleryDocFile');
 185         unless ($doc_pattern) {
 186                 $doc_pattern = '\.(mpe?g|avi|mov|asf|wmv|doc|mp3|ogg|pdf|rtf|wav|dlt|txt|html?|csv|eps)$'
 187         }
 188         my $img_pattern = $r->dir_config('GalleryImgFile');
 189         unless ($img_pattern) {
 190                 $img_pattern = '\.(jpe?g|png|tiff?|ppm)$'
 191         }
 192
 193         # Let Apache serve files we don't know how to handle anyway
 194         if (-f $filename && $filename !~ m/$img_pattern/i) {
 195                 return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
 196         }
 197
 198         if (-d $filename) {
 199
 200                 unless (-d cache_dir($r, 0)) {
 201                         unless (create_cache($r, cache_dir($r, 0))) {
 202                                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 203                         }
 204                 }
 205
 206                 my $tpl_dir = $r->dir_config('GalleryTemplateDir');
 207
 208                 # Instead of reading the templates every single time
 209                 # we need them, create a hash of template names and
 210                 # the associated Text::Template objects.
 211                 my %templates = create_templates({layout       => "$tpl_dir/layout.tpl",
 212                                                   index        => "$tpl_dir/index.tpl",
 213                                                   directory    => "$tpl_dir/directory.tpl",
 214                                                   picture      => "$tpl_dir/picture.tpl",
 215                                                   file         => "$tpl_dir/file.tpl",
 216                                                   comment      => "$tpl_dir/dircomment.tpl",
 217                                                   nocomment    => "$tpl_dir/nodircomment.tpl",
 218                                                   rss          => "$tpl_dir/rss.tpl",
 219                                                   rss_item     => "$tpl_dir/rss_item.tpl",
 220                                                   navdirectory => "$tpl_dir/navdirectory.tpl",
 221                                                  });
 222
 223
 224
 225
 226                 my %tpl_vars;
 227
 228                 $tpl_vars{TITLE} = "Index of: $uri";
 229
 230                 if ($media_rss_enabled) {
 231                         # Put the RSS feed on all directory listings
 232                         $tpl_vars{META} = '<link rel="alternate" href="?rss=1" type="application/rss+xml" title="" id="gallery" />';
 233                 }
 234
 235                 unless (opendir (DIR, $filename)) {
 236                         show_error ($r, 500, $!, "Unable to access directory $filename: $!");
 237                         return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 238                 }
 239
 240                 $tpl_vars{MENU} = generate_menu($r);
 241
 242                 $tpl_vars{FORM_BEGIN} = $select_mode?'<form method="post">':'';
 243                 $tpl_vars{FORM_END}   = $select_mode?'<input type="submit" name="Get list" value="Get list"></form>':'';
 244
 245                 # Read, sort, and filter files
 246                 my @files = grep { !/^\./ && -f "$filename/$_" } readdir (DIR);
 247
 248                 @files=gallerysort($r, @files);
 249
 250                 my @downloadable_files;
 251
 252                 if (@files) {
 253                         # Remove unwanted files from list
 254                         my @new_files = ();
 255                         foreach my $picture (@files) {
 256
 257                                 my $file = $topdir."/".$picture;
 258
 259                                 if ($file =~ /$img_pattern/i) {
 260                                         push (@new_files, $picture);
 261                                 }
 262
 263                                 if ($file =~ /$doc_pattern/i) {
 264                                         push (@downloadable_files, $picture);
 265                                 }
 266
 267                         }
 268                         @files = @new_files;
 269                 }
 270
 271                 # Read and sort directories
 272                 rewinddir (DIR);
 273                 my @directories = grep { !/^\./ && -d "$filename/$_" } readdir (DIR);
 274                 my $dirsortby;
 275                 if (defined($r->dir_config('GalleryDirSortBy'))) {
 276                         $dirsortby=$r->dir_config('GalleryDirSortBy');
 277                 } else {
 278                         $dirsortby=$r->dir_config('GallerySortBy');
 279                 }
 280                 if ($dirsortby && $dirsortby =~ m/^(size|atime|mtime|ctime)$/) {
 281                         @directories = map(/^\d+ (.*)/, sort map(stat("$filename/$_")->$dirsortby()." $_", @directories));
 282                 } else {
 283                         @directories = sort @directories;
 284                 }
 285
 286                 closedir(DIR);
 287
 288
 289                 # Combine directories and files to one listing
 290                 my @listing;
 291                 push (@listing, @directories);
 292                 push (@listing, @files);
 293                 push (@listing, @downloadable_files);
 294
 295                 if (@listing) {
 296
 297                         my $filelist;
 298
 299                         my $file_counter = 0;
 300                         my $start_at = 1;
 301                         my $max_files = $r->dir_config('GalleryMaxThumbnailsPerPage');
 302
 303                         if (defined($cgi->param('start'))) {
 304                                 $start_at = $cgi->param('start');
 305                                 if ($start_at < 1) {
 306                                         $start_at = 1;
 307                                 }
 308                         }
 309
 310                         my $browse_links = "";
 311                         if (defined($max_files)) {
 312
 313                                 for (my $i=1; $i<=scalar(@listing); $i++) {
 314
 315                                         my $from = $i;
 316
 317                                         my $to = $i+$max_files-1;
 318                                         if ($to > scalar(@listing)) {
 319                                                 $to = scalar(@listing);
 320                                         }
 321
 322                                         if ($start_at < $from || $start_at > $to) {
 323                                                 $browse_links .= "<a href=\"?start=$from\">$from - ".$to."</a> ";
 324                                         }
 325                                         else {
 326                                                 $browse_links .= "$from - $to ";
 327                                         }
 328
 329                                         $i+=$max_files-1;
 330
 331                                 }
 332
 333                         }
 334
 335                         $tpl_vars{BROWSELINKS} = $browse_links;
 336
 337                         DIRLOOP:
 338                         foreach my $file (@listing) {
 339
 340                                 $file_counter++;
 341
 342                                 if ($file_counter < $start_at) {
 343                                         next;
 344                                 }
 345
 346                                 if (defined($max_files) && $file_counter > $max_files+$start_at-1) {
 347                                         last DIRLOOP;
 348                                 }
 349
 350                                 my $thumbfilename = $topdir."/".$file;
 351
 352                                 my $fileurl = $uri."/".$file;
 353
 354                                 # Debian bug #619625 <http://bugs.debian.org/619625>
 355                                 if (-d $thumbfilename && ! -e $thumbfilename . ".ignore") {
 356                                         my $dirtitle = '';
 357                                         if (-e $thumbfilename . ".folder") {
 358                                                 $dirtitle = get_filecontent($thumbfilename . ".folder");
 359                                         }
 360
 361                                         $dirtitle = $dirtitle ? $dirtitle : $file;
 362                                         $dirtitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');
 363
 364                                         $tpl_vars{FILES} .=
 365                                              $templates{directory}->fill_in(HASH=> {FILEURL => uri_escape($fileurl, $escape_rule),
 366                                                                                     FILE    => $dirtitle,
 367                                                                                    }
 368                                                                            );
 369
 370                                 }
 371                                 # Debian bug #619625 <http://bugs.debian.org/619625>
 372                                 elsif (-f $thumbfilename && $thumbfilename =~ /$doc_pattern/i && $thumbfilename !~ /$img_pattern/i && ! -e $thumbfilename . ".ignore") {
 373                                         my $type = lc($1);
 374                                         my $stat = stat($thumbfilename);
 375                                         my $size = $stat->size;
 376                                         my $filetype;
 377
 378                                         if ($thumbfilename =~ m/\.(mpe?g|avi|mov|asf|wmv)$/i) {
 379                                                 $filetype = "video-$type";
 380                                         } elsif ($thumbfilename =~ m/\.(txt|html?)$/i) {
 381                                                 $filetype = "text-$type";
 382                                         } elsif ($thumbfilename =~ m/\.(mp3|ogg|wav)$/i) {
 383                                                 $filetype = "sound-$type";
 384                                         } elsif ($thumbfilename =~ m/$doc_pattern/i) {
 385                                                 $filetype = "application-$type";
 386                                         } else {
 387                                                 $filetype = "unknown";
 388                                         }
 389
 390                                         # Debian bug #348724 <http://bugs.debian.org/348724>
 391                                         # not images
 392                                         my $filetitle = $file;
 393                                         $filetitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');
 394
 395                                         $tpl_vars{FILES} .=
 396                                              $templates{file}->fill_in(HASH => {%tpl_vars,
 397                                                                                 FILEURL => uri_escape($fileurl, $escape_rule),
 398                                                                                 ALT => "Size: $size Bytes",
 399                                                                                 FILE => $filetitle,
 400                                                                                 TYPE => $type,
 401                                                                                 FILETYPE => $filetype,
 402                                                                                }
 403                                                                       );
 404                                 }
 405                                 # Debian bug #619625 <http://bugs.debian.org/619625>
 406                                 elsif (-f $thumbfilename && ! -e $thumbfilename . ".ignore") {
 407
 408                                         my ($width, $height, $type) = imgsize($thumbfilename);
 409                                         next if $type eq 'Data stream is not a known image file format';
 410
 411                                         my @filetypes = qw(JPG TIF PNG PPM GIF);
 412
 413                                         next unless (grep $type eq $_, @filetypes);
 414                                         my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $width, $height);
 415                                         my $imageinfo = get_imageinfo($r, $thumbfilename, $type, $width, $height);
 416                                         my $cached = get_scaled_picture_name($thumbfilename, $thumbnailwidth, $thumbnailheight);
 417
 418                                         my $rotate = readfile_getnum($r, $imageinfo, $thumbfilename.".rotate");
 419
 420                                         # Debian bug #348724 <http://bugs.debian.org/348724>
 421                                         # HTML <img> tag, alt attribute
 422                                         my $filetitle = $file;
 423                                         $filetitle =~ s/_/ /g if $r->dir_config('GalleryUnderscoresToSpaces');
 424
 425                                         my %file_vars = (FILEURL => uri_escape($fileurl, $escape_rule),
 426                                                          FILE    => $filetitle,
 427                                                          DATE    => $imageinfo->{DateTimeOriginal} ? $imageinfo->{DateTimeOriginal} : '', # should this really be a stat of the file instead of ''?
 428                                                          SRC     => uri_escape($uri."/.cache/$cached", $escape_rule),
 429                                                          HEIGHT => (grep($rotate==$_, (1, 3)) ? $thumbnailwidth : $thumbnailheight),
 430                                                          WIDTH => (grep($rotate==$_, (1, 3)) ? $thumbnailheight : $thumbnailwidth),
 431                                                          SELECT  => $select_mode?'<input type="checkbox" name="selection" value="'.$file.'">&nbsp;&nbsp;':'',);
 432                                         $tpl_vars{FILES} .= $templates{picture}->fill_in(HASH => {%tpl_vars,
 433                                                                                                  %file_vars,
 434                                                                                                 },
 435                                                                                        );
 436
 437                                         if ($media_rss_enabled) {
 438                                                 my ($content_image_width, undef, $content_image_height) = get_image_display_size($cgi, $r, $width, $height);
 439                                                 my %item_vars = (
 440                                                         THUMBNAIL => uri_escape($uri."/.cache/$cached", $escape_rule),
 441                                                         LINK      => uri_escape($fileurl, $escape_rule),
 442                                                         TITLE     => $file,
 443                                                         CONTENT   => uri_escape($uri."/.cache/".$content_image_width."x".$content_image_height."-".$file, $escape_rule)
 444                                                 );
 445                                                 $tpl_vars{ITEMS} .= $templates{rss_item}->fill_in(HASH => {
 446                                                         %item_vars
 447                                                 });
 448                                         }
 449                                 }
 450                         }
 451                 }
 452                 else {
 453                         $tpl_vars{FILES} = "No files found";
 454                         $tpl_vars{BROWSELINKS} = "";
 455                 }
 456
 457                 # Generate prev and next directory menu items
 458                 $filename =~ m/(.*)\/.*?$/;
 459                 my $parent_filename = $1;
 460
 461                 $r->document_root =~ m/(.*)\/$/;
 462                 my $root_path = $1;
 463                 print STDERR "$filename vs $root_path\n";
 464                 if ($filename ne $root_path) {
 465                         unless (opendir (PARENT_DIR, $parent_filename)) {
 466                                 show_error ($r, 500, $!, "Unable to access parent directory $parent_filename: $!");
 467                                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 468                         }
 469
 470                         # Debian bug #619625 <http://bugs.debian.org/619625>
 471                         my @neighbour_directories = grep { !/^\./ && -d "$parent_filename/$_" && ! -e "$parent_filename/$_" . ".ignore" } readdir (PARENT_DIR);
 472                         my $dirsortby;
 473                         if (defined($r->dir_config('GalleryDirSortBy'))) {
 474                                 $dirsortby=$r->dir_config('GalleryDirSortBy');
 475                         } else {
 476                                 $dirsortby=$r->dir_config('GallerySortBy');
 477                         }
 478                         if ($dirsortby && $dirsortby =~ m/^(size|atime|mtime|ctime)$/) {
 479                                 @neighbour_directories = map(/^\d+ (.*)/, sort map(stat("$parent_filename/$_")->$dirsortby()." $_", @neighbour_directories));
 480                         } else {
 481                                 @neighbour_directories = sort @neighbour_directories;
 482                         }
 483
 484                         closedir(PARENT_DIR);
 485
 486                         my $neightbour_counter = 0;
 487                         foreach my $neighbour_directory (@neighbour_directories) {
 488                                 if ($parent_filename.'/'.$neighbour_directory eq $filename) {
 489                                         if ($neightbour_counter > 0) {
 490                                                 print STDERR "prev directory is " .$neighbour_directories[$neightbour_counter-1] ."\n";
 491                                                 my $linktext = $neighbour_directories[$neightbour_counter-1];
 492                                                 if (-e $parent_filename.'/'.$neighbour_directories[$neightbour_counter-1] . ".folder") {
 493                                                         $linktext = get_filecontent($parent_filename.'/'.$neighbour_directories[$neightbour_counter-1] . ".folder");
 494                                                 }
 495                                                 my %info = (
 496                                                 URL => "../".$neighbour_directories[$neightbour_counter-1],
 497                                                 LINK_NAME => "<<< $linktext",
 498                                                 DIR_FILES => "",
 499                                                 );
 500                                                 $tpl_vars{PREV_DIR_FILES} = $templates{navdirectory}->fill_in(HASH=> {%info});
 501                                                 print STDERR $tpl_vars{PREV_DIR_FILES} ."\n";
 502
 503                                         }
 504                                         if ($neightbour_counter < scalar @neighbour_directories - 1) {
 505                                                 my $linktext = $neighbour_directories[$neightbour_counter+1];
 506                                                 if (-e $parent_filename.'/'.$neighbour_directories[$neightbour_counter+1] . ".folder") {
 507                                                         $linktext = get_filecontent($parent_filename.'/'.$neighbour_directories[$neightbour_counter+1] . ".folder");
 508                                                 }
 509                                                 my %info = (
 510                                                 URL => "../".$neighbour_directories[$neightbour_counter+1],
 511                                                 LINK_NAME => "$linktext >>>",
 512                                                 DIR_FILES => "",
 513                                                 );
 514                                                 $tpl_vars{NEXT_DIR_FILES} = $templates{navdirectory}->fill_in(HASH=> {%info});
 515                                                 print STDERR "next directory is " .$neighbour_directories[$neightbour_counter+1] ."\n";
 516                                         }
 517                                 }
 518                                 $neightbour_counter++;
 519                         }
 520                 }
 521
 522                 if (-f $topdir . '.comment') {
 523                         my $comment_ref = get_comment($topdir . '.comment');
 524                         my %comment_vars;
 525                         $comment_vars{COMMENT} = $comment_ref->{COMMENT} . '<br />' if $comment_ref->{COMMENT};
 526                         $comment_vars{TITLE} = $comment_ref->{TITLE} if $comment_ref->{TITLE};
 527                         $tpl_vars{DIRCOMMENT} = $templates{comment}->fill_in(HASH => \%comment_vars);
 528                         $tpl_vars{TITLE} = $comment_ref->{TITLE} if $comment_ref->{TITLE};
 529                 } else {
 530                         $tpl_vars{DIRCOMMENT} = $templates{nocomment}->fill_in(HASH=>\%tpl_vars);
 531                 }
 532
 533                 if ($cgi->param('rss')) {
 534                         $tpl_vars{MAIN} = $templates{rss}->fill_in(HASH => \%tpl_vars);
 535                         $r->content_type('application/rss+xml');
 536                 } else {
 537                         $tpl_vars{MAIN} = $templates{index}->fill_in(HASH => \%tpl_vars);
 538                         $tpl_vars{MAIN} = $templates{layout}->fill_in(HASH => \%tpl_vars);
 539                         $r->content_type('text/html');
 540                 }
 541
 542                 $r->headers_out->{'Content-Length'} = length($tpl_vars{MAIN});
 543
 544                 if (!$::MP2) {
 545                         $r->send_http_header;
 546                 }
 547
 548                 $r->print($tpl_vars{MAIN});
 549                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 550
 551         }
 552         else {
 553
 554                 # original size
 555                 if (defined($ENV{QUERY_STRING}) && $ENV{QUERY_STRING} eq 'orig') {
 556                         if ($r->dir_config('GalleryAllowOriginal') ? 1 : 0) {
 557                                 $r->filename($filename);
 558                                 return $::MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
 559                         } else {
 560                                 return $::MP2 ? Apache2::Const::FORBIDDEN() : Apache::Constants::FORBIDDEN();
 561                         }
 562                 }
 563
 564                 # Create cache dir if not existing
 565                 my @tmp = split (/\//, $filename);
 566                 my $picfilename = pop @tmp;
 567                 my $path = (join "/", @tmp)."/";
 568                 my $cache_path = cache_dir($r, 1);
 569
 570                 unless (-d $cache_path) {
 571                         unless (create_cache($r, $cache_path)) {
 572                                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 573                         }
 574                 }
 575
 576                 my ($orig_width, $orig_height, $type) = imgsize($filename);
 577
 578                 my $imageinfo = get_imageinfo($r, $filename, $type, $orig_width, $orig_height);
 579
 580                 my ($image_width, $width, $height, $original_size) = get_image_display_size($cgi, $r, $orig_width, $orig_height);
 581
 582                 my $cached = get_scaled_picture_name($filename, $image_width, $height);
 583
 584                 my $tpl_dir = $r->dir_config('GalleryTemplateDir');
 585
 586                 my %templates = create_templates({layout         => "$tpl_dir/layout.tpl",
 587                                                   picture        => "$tpl_dir/showpicture.tpl",
 588                                                   navpicture     => "$tpl_dir/navpicture.tpl",
 589                                                   info           => "$tpl_dir/info.tpl",
 590                                                   scale          => "$tpl_dir/scale.tpl",
 591                                                   scaleactive    => "$tpl_dir/scaleactive.tpl",
 592                                                   orig           => "$tpl_dir/orig.tpl",
 593                                                   refresh        => "$tpl_dir/refresh.tpl",
 594                                                   interval       => "$tpl_dir/interval.tpl",
 595                                                   intervalactive => "$tpl_dir/intervalactive.tpl",
 596                                                   slideshowisoff => "$tpl_dir/slideshowisoff.tpl",
 597                                                   slideshowoff   => "$tpl_dir/slideshowoff.tpl",
 598                                                   pictureinfo    => "$tpl_dir/pictureinfo.tpl",
 599                                                   nopictureinfo  => "$tpl_dir/nopictureinfo.tpl",
 600                                                  });
 601
 602                 my %tpl_vars;
 603
 604                 my $resolution = (($image_width > $orig_width) && ($height > $orig_height)) ?
 605                         "$orig_width x $orig_height" : "$image_width x $height";
 606
 607                 $tpl_vars{TITLE} = "Viewing ".$r->uri()." at $image_width x $height";
 608                 $tpl_vars{META} = " ";
 609                 $tpl_vars{RESOLUTION} = $resolution;
 610                 $tpl_vars{MENU} = generate_menu($r);
 611                 $tpl_vars{SRC} = uri_escape(".cache/$cached", $escape_rule);
 612                 $tpl_vars{URI} = $r->uri();
 613
 614                 my $exif_mode = $r->dir_config('GalleryEXIFMode');
 615                 unless ($exif_mode) {
 616                         $exif_mode = 'namevalue';
 617                 }
 618
 619                 unless (opendir(DATADIR, $path)) {
 620                         show_error($r, 500, "Unable to access directory", "Unable to access directory $path");
 621                         return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 622                 }
 623                 my @pictures = grep { /$img_pattern/i && ! -e "$path/$_" . ".ignore" } readdir (DATADIR);
 624                 closedir(DATADIR);
 625                 @pictures = gallerysort($r, @pictures);
 626
 627                 $tpl_vars{TOTAL} = scalar @pictures;
 628
 629                 my $prevpicture;
 630                 my $nextpicture;
 631
 632                 for (my $i=0; $i <= $#pictures; $i++) {
 633                         if ($pictures[$i] eq $picfilename) {
 634
 635                                 $tpl_vars{NUMBER} = $i+1;
 636
 637                                 $prevpicture = $pictures[$i-1];
 638                                 my $displayprev = ($i>0 ? 1 : 0);
 639
 640                                 if ($r->dir_config("GalleryWrapNavigation")) {
 641                                         $prevpicture = $pictures[$i>0 ? $i-1 : $#pictures];
 642                                         $displayprev = 1;
 643                                 }
 644                                 if ($prevpicture and $displayprev) {
 645                                         my ($orig_width, $orig_height, $type) = imgsize($path.$prevpicture);
 646                                         my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);
 647                                         my $imageinfo = get_imageinfo($r, $path.$prevpicture, $type, $orig_width, $orig_height);
 648                                         my $cached = get_scaled_picture_name($path.$prevpicture, $thumbnailwidth, $thumbnailheight);
 649                                         my %nav_vars;
 650                                         $nav_vars{URL}       = uri_escape($prevpicture, $escape_rule);
 651                                         $nav_vars{FILENAME}  = $prevpicture;
 652                                         $nav_vars{WIDTH}     = $width;
 653                                         $nav_vars{PICTURE}   = uri_escape(".cache/$cached", $escape_rule);
 654                                         $nav_vars{DIRECTION} = "&laquo; <u>p</u>rev";
 655                                         $nav_vars{ACCESSKEY} = "P";
 656                                         $tpl_vars{BACK} = $templates{navpicture}->fill_in(HASH => \%nav_vars);
 657                                 }
 658                                 else {
 659                                         $tpl_vars{BACK} = "&nbsp;";
 660                                 }
 661
 662                                 $nextpicture = $pictures[$i+1];
 663                                 if ($r->dir_config("GalleryWrapNavigation")) {
 664                                         $nextpicture = $pictures[$i == $#pictures ? 0 : $i+1];
 665                                 }
 666
 667                                 if ($nextpicture) {
 668                                         my ($orig_width, $orig_height, $type) = imgsize($path.$nextpicture);
 669                                         my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);
 670                                         my $imageinfo = get_imageinfo($r, $path.$nextpicture, $type, $thumbnailwidth, $thumbnailheight);
 671                                         my $cached = get_scaled_picture_name($path.$nextpicture, $thumbnailwidth, $thumbnailheight);
 672                                         my %nav_vars;
 673                                         $nav_vars{URL}       = uri_escape($nextpicture, $escape_rule);
 674                                         $nav_vars{FILENAME}  = $nextpicture;
 675                                         $nav_vars{WIDTH}     = $width;
 676                                         $nav_vars{PICTURE}   = uri_escape(".cache/$cached", $escape_rule);
 677                                         $nav_vars{DIRECTION} = "<u>n</u>ext &raquo;";
 678                                         $nav_vars{ACCESSKEY} = "N";
 679
 680                                         $tpl_vars{NEXT} = $templates{navpicture}->fill_in(HASH => \%nav_vars);
 681                                         $tpl_vars{NEXTURL}   = uri_escape($nextpicture, $escape_rule);
 682                                 }
 683                                 else {
 684                                         $tpl_vars{NEXT} = "&nbsp;";
 685                                         $tpl_vars{NEXTURL}   = '#';
 686                                 }
 687                         }
 688                 }
 689
 690                 my $foundcomment = 0;
 691                 if (-f $path . '/' . $picfilename . '.comment') {
 692                         my $comment_ref = get_comment($path . '/' . $picfilename . '.comment');
 693                         $foundcomment = 1;
 694                         $tpl_vars{COMMENT} = $comment_ref->{COMMENT} . '<br />' if $comment_ref->{COMMENT};
 695                         $tpl_vars{TITLE} = $comment_ref->{TITLE} if $comment_ref->{TITLE};
 696                 } elsif ($r->dir_config('GalleryCommentExifKey')) {
 697                         my $comment = decode("utf8", $imageinfo->{$r->dir_config('GalleryCommentExifKey')});
 698                         $tpl_vars{COMMENT} = encode("iso-8859-1", $comment);
 699                 } else {
 700                         $tpl_vars{COMMENT} = '';
 701                 }
 702
 703                 my @infos = split /, /, $r->dir_config('GalleryInfo') ? $r->dir_config('GalleryInfo') : 'Picture Taken => DateTimeOriginal, Flash => Flash';
 704                 my $foundinfo = 0;
 705                 my $exifvalues;
 706                 foreach (@infos) {
 707
 708                         my ($human_key, $exif_key) = (split " => ")[0,1];
 709                         my $value = $imageinfo->{$human_key};
 710                         if (defined($value)) {
 711
 712                                 $foundinfo = 1;
 713
 714                                 if ($exif_mode eq 'namevalue') {
 715                                         my %info_vars;
 716                                         $info_vars{KEY} = $human_key;
 717                                         $info_vars{VALUE} = $value;
 718                                         $tpl_vars{INFO} .=  $templates{info}->fill_in(HASH => \%info_vars);
 719                                 }
 720
 721                                 if ($exif_mode eq 'variables') {
 722                                         $tpl_vars{"EXIF_".uc($exif_key)} = $value;
 723                                 }
 724
 725                                 if ($exif_mode eq 'values') {
 726                                         $exifvalues .= "| ".$value." ";
 727                                 }
 728
 729                         }
 730
 731                 }
 732
 733                 if ($exif_mode eq 'values') {
 734                         if (defined($exifvalues)) {
 735                                 $tpl_vars{EXIFVALUES} = $exifvalues;
 736                         }
 737                         else {
 738                                 $tpl_vars{EXIFVALUES} = "";
 739                         }
 740                 }
 741
 742                 if ($foundcomment and !$foundinfo) {
 743                         $tpl_vars{INFO} = "";
 744                 }
 745
 746                 if ($exif_mode ne 'namevalue') {
 747                         $tpl_vars{INFO} = "";
 748                 }
 749
 750                 if ($exif_mode eq 'namevalue' && $foundinfo or $foundcomment) {
 751
 752                         $tpl_vars{PICTUREINFO} = $templates{pictureinfo}->fill_in(HASH => \%tpl_vars);
 753
 754                         unless (defined($exifvalues)) {
 755                                 $tpl_vars{EXIFVALUES} = "";
 756                         }
 757
 758                 }
 759                 else {
 760                         $tpl_vars{PICTUREINFO} = $templates{nopictureinfo}->fill_in(HASH => \%tpl_vars);
 761                 }
 762
 763                 # Fill in sizes and determine if any are smaller than the
 764                 # actual image. If they are, $scaleable=1
 765                 my $scaleable = 0;
 766                 my @sizes = split (/ /, $r->dir_config('GallerySizes') ? $r->dir_config('GallerySizes') : '640 800 1024 1600');
 767                 foreach my $size (@sizes) {
 768                         if ($size<=$original_size) {
 769                                 my %sizes_vars;
 770                                 $sizes_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
 771                                 $sizes_vars{SIZE}     = $size;
 772                                 $sizes_vars{WIDTH}    = $size;
 773                                 if ($width == $size) {
 774                                         $tpl_vars{SIZES} .= $templates{scaleactive}->fill_in(HASH => \%sizes_vars);
 775                                 }
 776                                 else {
 777                                         $tpl_vars{SIZES} .= $templates{scale}->fill_in(HASH => \%sizes_vars);
 778                                 }
 779                                 $scaleable = 1;
 780                         }
 781                 }
 782
 783                 unless ($scaleable) {
 784                         my %sizes_vars;
 785                         $sizes_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
 786                         $sizes_vars{SIZE}     = $original_size;
 787                         $sizes_vars{WIDTH}    = $original_size;
 788                         $tpl_vars{SIZES} .= $templates{scaleactive}->fill_in(HASH => \%sizes_vars);
 789                 }
 790
 791                 $tpl_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
 792
 793                 if ($r->dir_config('GalleryAllowOriginal')) {
 794                         $tpl_vars{SIZES} .= $templates{orig}->fill_in(HASH => \%tpl_vars);
 795                 }
 796
 797                 my @slideshow_intervals = split (/ /, $r->dir_config('GallerySlideshowIntervals') ? $r->dir_config('GallerySlideshowIntervals') : '3 5 10 15 30');
 798                 foreach my $interval (@slideshow_intervals) {
 799
 800                         my %slideshow_vars;
 801                         $slideshow_vars{IMAGEURI} = uri_escape($r->uri(), $escape_rule);
 802                         $slideshow_vars{SECONDS} = $interval;
 803                         $slideshow_vars{WIDTH} = ($width > $height ? $width : $height);
 804
 805                         if ($cgi->param('slideshow') && $cgi->param('slideshow') == $interval and $nextpicture) {
 806                                 $tpl_vars{SLIDESHOW} .= $templates{intervalactive}->fill_in(HASH => \%slideshow_vars);
 807                         }
 808                         else {
 809
 810                                 $tpl_vars{SLIDESHOW} .= $templates{interval}->fill_in(HASH => \%slideshow_vars);
 811
 812                         }
 813                 }
 814
 815                 if ($cgi->param('slideshow') and $nextpicture) {
 816
 817                         $tpl_vars{SLIDESHOW} .= $templates{slideshowoff}->fill_in(HASH => \%tpl_vars);
 818
 819                         unless ((grep $cgi->param('slideshow') == $_, @slideshow_intervals)) {
 820                                 show_error($r, 200, "Invalid interval", "Invalid slideshow interval choosen");
 821                                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 822                         }
 823
 824                         $tpl_vars{URL} = uri_escape($nextpicture, $escape_rule);
 825                         $tpl_vars{WIDTH} = ($width > $height ? $width : $height);
 826                         $tpl_vars{INTERVAL} = $cgi->param('slideshow');
 827                         $tpl_vars{META} .=  $templates{refresh}->fill_in(HASH => \%tpl_vars);
 828
 829                 }
 830                 else {
 831                         $tpl_vars{SLIDESHOW} .=  $templates{slideshowisoff}->fill_in(HASH => \%tpl_vars);
 832                 }
 833
 834                 $tpl_vars{MAIN} = $templates{picture}->fill_in(HASH => \%tpl_vars);
 835                 $tpl_vars{MAIN} = $templates{layout}->fill_in(HASH => \%tpl_vars);
 836
 837                 $r->content_type('text/html');
 838                 $r->headers_out->{'Content-Length'} = length($tpl_vars{MAIN});
 839
 840                 if (!$::MP2) {
 841                         $r->send_http_header;
 842                 }
 843
 844                 $r->print($tpl_vars{MAIN});
 845                 return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
 846
 847         }
 848
 849 }
 850
 851 sub cache_dir {
 852
 853         my ($r, $strip_filename) = @_;
 854
 855         my $cache_root;
 856
 857         unless ($r->dir_config('GalleryCacheDir')) {
 858
 859                 $cache_root = '/var/cache/www/';
 860                 if ($r->server->is_virtual) {
 861                         $cache_root = File::Spec->catdir($cache_root, $r->server->server_hostname);
 862                 } else {
 863                         $cache_root = File::Spec->catdir($cache_root, $r->location);
 864                 }
 865
 866         } else {
 867
 868                 $cache_root = $r->dir_config('GalleryCacheDir');
 869
 870         }
 871
 872         # If the uri contains .cache we need to remove it
 873         my $uri = $r->uri;
 874         $uri =~ s/\.cache//;
 875
 876         my (undef, $dirs, $filename) = File::Spec->splitpath($uri);
 877         # We don't need a volume as this is a relative path
 878
 879         if ($strip_filename) {
 880                 return(File::Spec->canonpath(File::Spec->catdir($cache_root, $dirs)));
 881         } else {
 882                 return(File::Spec->canonpath(File::Spec->catfile($cache_root, $dirs, $filename)));
 883         }
 884 }
 885
 886 sub create_cache {
 887
 888         my ($r, $path) = @_;
 889
 890                 unless (mkdirhier ($path)) {
 891                         show_error($r, 500, $!, "Unable to create cache directory in $path: $!");
 892                         return 0;
 893                 }
 894
 895         return 1;
 896 }
 897
 898 sub mkdirhier {
 899
 900         my $dir = shift;
 901
 902         unless (-d $dir) {
 903
 904                 unless (mkdir($dir, 0755)) {
 905                         my $parent = $dir;
 906                         $parent =~ s/\/[^\/]*$//;
 907
 908                         mkdirhier($parent);
 909
 910                         mkdir($dir, 0755);
 911                 }
 912         }
 913 }
 914
 915 sub get_scaled_picture_name {
 916
 917         my ($fullpath, $width, $height) = @_;
 918
 919         my (undef, undef, $type) = imgsize($fullpath);
 920
 921         my @dirs = split(/\//, $fullpath);
 922         my $filename = pop(@dirs);
 923         my $newfilename;
 924
 925         if (grep $type eq $_, qw(PPM TIF GIF)) {
 926                 $newfilename = $width."x".$height."-".$filename;
 927                 # needs to be configurable
 928                 $newfilename =~ s/\.(\w+)$/-$1\.jpg/;
 929         } else {
 930                 $newfilename = $width."x".$height."-".$filename;
 931         }
 932
 933         return $newfilename;
 934
 935 }
 936
 937 sub scale_picture {
 938
 939         my ($r, $fullpath, $width, $height, $imageinfo) = @_;
 940
 941         my @dirs = split(/\//, $fullpath);
 942         my $filename = pop(@dirs);
 943
 944         my ($orig_width, $orig_height, $type) = imgsize($fullpath);
 945
 946         my $cache = cache_dir($r, 1);
 947
 948         my $newfilename = get_scaled_picture_name($fullpath, $width, $height);
 949
 950         if (($width > $orig_width) && ($height > $orig_height)) {
 951                 # Run it through the resize code anyway to get watermarks
 952                 $width = $orig_width;
 953                 $height = $orig_height;
 954         }
 955
 956         my ($thumbnailwidth, $thumbnailheight) = get_thumbnailsize($r, $orig_width, $orig_height);
 957
 958         # Do we want to generate a new file in the cache?
 959         my $scale = 1;
 960
 961         if (-f $cache."/".$newfilename) {
 962                 $scale = 0;
 963
 964                 # Check to see if the image has changed
 965                 my $filestat = stat($fullpath);
 966                 my $cachestat = stat($cache."/".$newfilename);
 967                 if ($filestat->mtime >= $cachestat->mtime) {
 968                         $scale = 1;
 969                 }
 970
 971                 # Check to see if the .rotate file has been added or changed
 972                 if (-f $fullpath . ".rotate") {
 973                         my $rotatestat = stat($fullpath . ".rotate");
 974                         if ($rotatestat->mtime > $cachestat->mtime) {
 975                                 $scale = 1;
 976                         }
 977                 }
 978                 # Check to see if the copyrightimage has been added or changed
 979                 if ($r->dir_config('GalleryCopyrightImage') && -f $r->dir_config('GalleryCopyrightImage')) {
 980                         unless ($width == $thumbnailwidth or $width == $thumbnailheight) {
 981                                 my $copyrightstat = stat($r->dir_config('GalleryCopyrightImage'));
 982                                 if ($copyrightstat->mtime > $cachestat->mtime) {
 983                                         $scale = 1;
 984                                 }
 985                         }
 986                 }
 987
 988         }
 989
 990         if ($scale) {
 991
 992                 my $newpath = $cache."/".$newfilename;
 993                 my $rotate = readfile_getnum($r, $imageinfo, $fullpath . ".rotate");
 994                 my $quality = $r->dir_config('GalleryQuality');
 995
 996                 if ($width == $thumbnailwidth or $width == $thumbnailheight) {
 997
 998                         resizepicture($r, $fullpath, $newpath, $width, $height, $rotate, '', '', '', '', '', '');
 999
1000                 } else {
1001
1002                         resizepicture($r, $fullpath, $newpath, $width, $height, $rotate,
1003                                 ($r->dir_config('GalleryCopyrightImage') ? $r->dir_config('GalleryCopyrightImage') : ''),
1004                                 ($r->dir_config('GalleryTTFDir') ? $r->dir_config('GalleryTTFDir') : ''),
1005                                 ($r->dir_config('GalleryCopyrightText') ? $r->dir_config('GalleryCopyrightText') : ''),
1006                                 ($r->dir_config('GalleryCopyrightColor') ? $r->dir_config('GalleryCopyrightColor') : ''),
1007                                 ($r->dir_config('GalleryTTFFile') ? $r->dir_config('GalleryTTFFile') : ''),
1008                                 ($r->dir_config('GalleryTTFSize') ?  $r->dir_config('GalleryTTFSize') : ''),
1009                                 ($r->dir_config('GalleryCopyrightBackgroundColor') ?  $r->dir_config('GalleryCopyrightBackgroundColor') : ''),
1010                                 $quality);
1011
1012                 }
1013         }
1014
1015         return $newfilename;
1016
1017 }
1018
1019 sub get_thumbnailsize {
1020         my ($r, $orig_width, $orig_height) = @_;
1021
1022         my $gallerythumbnailsize=$r->dir_config('GalleryThumbnailSize');
1023
1024         if (defined($gallerythumbnailsize)) {
1025                 warn("Invalid setting for GalleryThumbnailSize") unless
1026                         $gallerythumbnailsize =~ /^\s*\d+\s*x\s*\d+\s*$/i;
1027         }
1028
1029         my ($thumbnailwidth, $thumbnailheight) = split(/x/i, ($gallerythumbnailsize) ?  $gallerythumbnailsize : "100x75");
1030
1031         my $width = $thumbnailwidth;
1032         my $height = $thumbnailheight;
1033
1034         # If the image is rotated, flip everything around.
1035         if (defined $r->dir_config('GalleryThumbnailSizeLS')
1036         and $r->dir_config('GalleryThumbnailSizeLS') eq '1'
1037         and $orig_width < $orig_height) {
1038
1039                 $width = $thumbnailheight;
1040                 $height = $thumbnailwidth;
1041         }
1042
1043         my $scale = ($orig_width ? $width/$orig_width : 1);
1044
1045         if ($orig_height) {
1046                 if ($orig_height * $scale > $thumbnailheight) {
1047                         $scale = $height/$orig_height;
1048                         $width = $orig_width * $scale;
1049                 }
1050         }
1051
1052         $height = $orig_height * $scale;
1053
1054         $height = floor($height);
1055         $width  = floor($width);
1056
1057         return ($width, $height);
1058 }
1059
1060 sub get_image_display_size {
1061         my ($cgi, $r, $orig_width, $orig_height) = @_;
1062
1063         my $width = $orig_width;
1064
1065         my $original_size=$orig_height;
1066         if ($orig_width>$orig_height) {
1067                 $original_size=$orig_width;
1068         }
1069
1070         # Check if the selected width is allowed
1071         my @sizes = split (/ /, $r->dir_config('GallerySizes') ? $r->dir_config('GallerySizes') : '640 800 1024 1600');
1072
1073         my %cookies = fetch CGI::Cookie;
1074
1075         if ($cgi->param('width')) {
1076                 unless ((grep $cgi->param('width') == $_, @sizes) or ($cgi->param('width') == $original_size)) {
1077                         show_error($r, 200, "Invalid width", "The specified width is invalid");
1078                         return $::MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
1079                 }
1080
1081                 $width = $cgi->param('width');
1082                 my $cookie = new CGI::Cookie(-name => 'GallerySize', -value => $width, -expires => '+6M');
1083                 $r->headers_out->{'Set-Cookie'} = $cookie;
1084
1085         } elsif ($cookies{'GallerySize'} && (grep $cookies{'GallerySize'}->value == $_, @sizes)) {
1086
1087                 $width = $cookies{'GallerySize'}->value;
1088
1089         } else {
1090                 $width = $sizes[0];
1091         }
1092
1093         my $scale;
1094         my $image_width;
1095         if ($orig_width<$orig_height) {
1096                 $scale = ($orig_height ? $width/$orig_height: 1);
1097                 $image_width=$width*$orig_width/$orig_height;
1098         }
1099         else {
1100                 $scale = ($orig_width ? $width/$orig_width : 1);
1101                 $image_width = $width;
1102         }
1103
1104         my $height = $orig_height * $scale;
1105
1106         $image_width = floor($image_width);
1107         $width       = floor($width);
1108         $height      = floor($height);
1109
1110         return ($image_width, $width, $height, $original_size);
1111 }
1112
1113 sub get_imageinfo {
1114         my ($r, $file, $type, $width, $height) = @_;
1115         my $imageinfo = {};
1116         if ($type eq 'Data stream is not a known image file format') {
1117                 # should never be reached, this is supposed to be handled outside of here
1118                 log_error("Something was fishy with the type of the file $file\n");
1119         } else {
1120
1121                 # Some files, like TIFF, PNG, GIF do not have EXIF info
1122                 # embedded but use .thm files instead.
1123                 $imageinfo = get_imageinfo_from_thm_file($file, $width, $height);
1124
1125                 # If there is no .thm file and our file is a JPEG file we try to extract the EXIf
1126                 # info using Image::Info
1127                 unless (defined($imageinfo) && (grep $type eq $_, qw(JPG))) {
1128                         # Only for files that natively keep the EXIF info in the same file
1129                         $imageinfo = image_info($file);
1130                 }
1131         }
1132
1133         unless (defined($imageinfo->{width}) and defined($imageinfo->{height})) {
1134                 $imageinfo->{width} = $width;
1135                 $imageinfo->{height} = $height;
1136         }
1137
1138         my @infos = split /, /, $r->dir_config('GalleryInfo') ? $r->dir_config('GalleryInfo') : 'Picture Taken => DateTimeOriginal, Flash => Flash';
1139         foreach (@infos) {
1140
1141                 my ($human_key, $exif_key) = (split " => ")[0,1];
1142                 if (defined($exif_key) && defined($imageinfo->{$exif_key})) {
1143                         my $value = "";
1144                         if (ref($imageinfo->{$exif_key}) eq 'Image::TIFF::Rational') {
1145                                 $value = $imageinfo->{$exif_key}->as_string;
1146                         }
1147                         elsif (ref($imageinfo->{$exif_key}) eq 'ARRAY') {
1148                                 foreach my $element (@{$imageinfo->{$exif_key}}) {
1149                                         if (ref($element) eq 'ARRAY') {
1150                                                 foreach (@{$element}) {
1151                                                         $value .= $_ . ' ';
1152                                                 }
1153                                         }
1154                                         elsif (ref($element) eq 'HASH') {
1155                                                 $value .= "<br />{ ";
1156                                         foreach (sort keys %{$element}) {
1157                                                         $value .= "$_ = " . $element->{$_} . ' ';
1158                                                 }
1159                                         $value .= "} ";
1160                                         }
1161                                         else {
1162                                                 $value .= $element;
1163                                         }
1164                                         $value .= ' ';
1165                                 }
1166                         }
1167                         else {
1168                                 my $exif_value = $imageinfo->{$exif_key};
1169                                 if ($human_key eq 'Flash' && $exif_value =~ m/\d/) {
1170                                         my %flashmodes = (
1171                                                 "0"  => "No",
1172                                                 "1"  => "Yes",
1173                                                 "9"  => "Yes",
1174                                                 "16" => "No (Compulsory) Should be External Flash",
1175                                                 "17" => "Yes (External)",
1176                                                 "24" => "No",
1177                                                 "25" => "Yes (Auto)",
1178                                                 "73" => "Yes (Compulsory, Red Eye Reducing)",
1179                                                 "89" => "Yes (Auto, Red Eye Reducing)"
1180                                         );
1181                                         $exif_value = defined $flashmodes{$exif_value} ? $flashmodes{$exif_value} : 'unknown flash mode';
1182                                 }
1183                                 $value = $exif_value;
1184                         }
1185                         if ($exif_key eq 'MeteringMode') {
1186                                 my $exif_value = $imageinfo->{$exif_key};
1187                                 if ($exif_value =~ /^\d+$/) {
1188                                         my %meteringmodes = (
1189                                                 '0' => 'unknown',
1190                                                 '1' => 'Average',
1191                                                 '2' => 'CenterWeightedAverage',
1192                                                 '3' => 'Spot',
1193                                                 '4' => 'MultiSpot',
1194                                                 '5' => 'Pattern',
1195                                                 '6' => 'Partial',
1196                                                 '255' => 'Other'
1197                                         );
1198                                         $exif_value = defined $meteringmodes{$exif_value} ? $meteringmodes{$exif_value} : 'unknown metering mode';
1199                                 }
1200                                 $value = $exif_value;
1201
1202                         }
1203                         if ($exif_key eq 'LightSource') {
1204                                 my $exif_value = $imageinfo->{$exif_key};
1205                                 if ($exif_value =~ /^\d+$/) {
1206                                         my %lightsources = (
1207                                                 '0' => 'unknown',
1208                                                 '1' => 'Daylight',
1209                                                 '2' => 'Fluorescent',
1210                                                 '3' => 'Tungsten (incandescent light)',
1211                                                 '4' => 'Flash',
1212                                                 '9' => 'Fine weather',
1213                                                 '10' => 'Cloudy weather',
1214                                                 '11' => 'Shade',
1215                                                 '12' => 'Daylight fluorescent',
1216                                                 '13' => 'Day white fluorescent',
1217                                                 '14' => 'Cool white fluorescent',
1218                                                 '15' => 'White fluorescent',
1219                                                 '17' => 'Standard light A',
1220                                                 '18' => 'Standard light B',
1221                                                 '19' => 'Standard light C',
1222                                                 '20' => 'D55',
1223                                                 '21' => 'D65',
1224                                                 '22' => 'D75',
1225                                                 '23' => 'D50',
1226                                                 '24' => 'ISO studio tungsten',
1227                                                 '255' => 'other light source'
1228                                         );
1229                                         $exif_value = defined $lightsources{$exif_value} ? $lightsources{$exif_value} : 'unknown light source';
1230                                 }
1231                                 $value = $exif_value;
1232                         }
1233                         if ($exif_key eq 'FocalLength') {
1234                                 if ($value =~ /^(\d+)\/(\d+)$/) {
1235                                         $value = eval { $1 / $2 };
1236                                         if ($@) {
1237                                                 $value = $@;
1238                                         } else {
1239                                                 $value = int($value + 0.5) . "mm";
1240
1241                                         }
1242                                 }
1243                         }
1244                         if ($exif_key eq 'ShutterSpeedValue') {
1245                                 if ($value =~ /^((?:\-)?\d+)\/(\d+)$/) {
1246                                         $value = eval { $1 / $2 };
1247                                         if ($@) {
1248                                                 $value = $@;
1249                                         } else {
1250                                                 eval {
1251                                                         $value = 1/(exp($value*log(2)));
1252                                                         if ($value < 1) {
1253                                                                 $value = "1/" . (int((1/$value)));
1254                                                         } else {
1255                                                                 $value = int($value*10)/10;
1256                                                         }
1257                                                 };
1258                                                 if ($@) {
1259                                                         $value = $@;
1260                                                 } else {
1261                                                         $value = $value . " sec";
1262                                                 }
1263                                         }
1264                                 }
1265                         }
1266                         if ($exif_key eq 'ApertureValue') {
1267                                 if ($value =~ /^(\d+)\/(\d+)$/) {
1268                                         $value = eval { $1 / $2 };
1269                                         if ($@) {
1270                                                 $value = $@;
1271                                         } else {
1272                                                 # poor man's rounding
1273                                                 $value = int(exp($value*log(2)*0.5)*10)/10;
1274                                                 $value = "f" . $value;
1275                                         }
1276                                 }
1277                         }
1278                         if ($exif_key eq 'FNumber') {
1279                                 if ($value =~ /^(\d+)\/(\d+)$/) {
1280                                         $value = eval { $1 / $2 };
1281                                         if ($@) {
1282                                                 $value = $@;
1283                                         } else {
1284                                                 $value = int($value*10+0.5)/10;
1285                                                 $value = "f" . $value;
1286                                         }
1287                                 }
1288                         }
1289                         $imageinfo->{$human_key} = $value;
1290                 }
1291         }
1292
1293         if ($r->dir_config('GalleryUseFileDate') &&
1294                 ($r->dir_config('GalleryUseFileDate') eq '1'
1295                 || !$imageinfo->{"Picture Taken"} )) {
1296
1297                 my $st = stat($file);
1298                 $imageinfo->{"DateTimeOriginal"} = $imageinfo->{"Picture Taken"} = scalar localtime($st->mtime) if $st;
1299         }
1300
1301         return $imageinfo;
1302 }
1303
1304 sub get_imageinfo_from_thm_file {
1305
1306         my ($file, $width, $height) = @_;
1307
1308         my $imageinfo = undef;
1309         # Windows based file extensions are often .THM, so check
1310         # for both .thm and .THM
1311         my $unix_file = $file;
1312         my $windows_file = $file;
1313         $unix_file =~ s/\.(\w+)$/.thm/;
1314         $windows_file =~ s/\.(\w+)$/.THM/;
1315
1316         if (-e $unix_file && -f $unix_file && -r $unix_file) {
1317                 $imageinfo = image_info($unix_file);
1318                 $imageinfo->{width} = $width;
1319                 $imageinfo->{height} = $height;
1320         }
1321         elsif (-e $windows_file && -f $windows_file && -r $windows_file) {
1322                 $imageinfo = image_info($windows_file);
1323                 $imageinfo->{width} = $width;
1324                 $imageinfo->{height} = $height;
1325         }
1326
1327         return $imageinfo;
1328 }
1329
1330
1331 sub readfile_getnum {
1332         my ($r, $imageinfo, $filename) = @_;
1333
1334         my $rotate = 0;
1335
1336         print STDERR "orientation: ".$imageinfo->{Orientation}."\n";
1337         # Check to see if the image contains the Orientation EXIF key,
1338         # but allow user to override using rotate
1339         if (!defined($r->dir_config("GalleryAutoRotate"))
1340                 || $r->dir_config("GalleryAutoRotate") eq "1") {
1341                 if (defined($imageinfo->{Orientation})) {
1342                         print STDERR $imageinfo->{Orientation}."\n";
1343                         if ($imageinfo->{Orientation} eq 'right_top') {
1344                                 $rotate=1;
1345                         }
1346                         elsif ($imageinfo->{Orientation} eq 'left_bot') {
1347                                 $rotate=3;
1348                         }
1349                 }
1350         }
1351
1352         if (open(FH, "<$filename")) {
1353                 my $temp = <FH>;
1354                 chomp($temp);
1355                 close(FH);
1356                 unless ($temp =~ /^\d$/) {
1357                         $rotate = 0;
1358                 }
1359                 unless ($temp == 1 || $temp == 2 || $temp == 3) {
1360                         $rotate = 0;
1361                 }
1362                 $rotate = $temp;
1363         }
1364
1365         return $rotate;
1366 }
1367
1368 sub get_filecontent {
1369         my $file = shift;
1370         open(FH, $file) or return undef;
1371         my $content = '';
1372         {
1373                 local $/;
1374                 $content = <FH>;
1375         }
1376         close(FH);
1377         return $content;
1378 }
1379
1380 sub get_comment {
1381         my $filename = shift;
1382         my $comment_ref = {};
1383         $comment_ref->{TITLE} = undef;
1384         $comment_ref->{COMMENT} = '';
1385
1386         open(FH, $filename) or return $comment_ref;
1387         my $title = <FH>;
1388         if ($title =~ m/^TITLE: (.*)$/) {
1389                 chomp($comment_ref->{TITLE} = $1);
1390         }
1391         else {
1392                 $comment_ref->{COMMENT} = $title;
1393         }
1394
1395         while (<FH>) {
1396                 chomp;
1397                 $comment_ref->{COMMENT} .= $_;
1398         }
1399         close(FH);
1400
1401         return $comment_ref;
1402 }
1403
1404 sub show_error {
1405
1406         my ($r, $statuscode, $errortitle, $error) = @_;
1407
1408         my $tpl = $r->dir_config('GalleryTemplateDir');
1409
1410         my %templates = create_templates({layout => "$tpl/layout.tpl",
1411                                           error  => "$tpl/error.tpl",
1412                                          });
1413
1414         my %tpl_vars;
1415         $tpl_vars{TITLE}      = "Error! $errortitle";
1416         $tpl_vars{META}       = "";
1417         $tpl_vars{ERRORTITLE} = "Error! $errortitle";
1418         $tpl_vars{ERROR}      = $error;
1419
1420         $tpl_vars{MAIN} = $templates{error}->fill_in(HASH => \%tpl_vars);
1421
1422         $tpl_vars{PAGE} = $templates{layout}->fill_in(HASH => \%tpl_vars);
1423
1424         $r->status($statuscode);
1425         $r->content_type('text/html');
1426
1427         $r->print($tpl_vars{PAGE});
1428
1429 }
1430
1431 sub generate_menu {
1432
1433         my $r = shift;
1434
1435         my $root_text = (defined($r->dir_config('GalleryRootText')) ? $r->dir_config('GalleryRootText') : "root:" );
1436         my $root_path = (defined($r->dir_config('GalleryRootPath')) ? $r->dir_config('GalleryRootPath') : "" );
1437
1438         my $subr = $r->lookup_uri($r->uri);
1439         my $filename = $subr->filename;
1440
1441         my @links = split (/\//, $r->uri);
1442         my $uri = $r->uri;
1443         $uri =~ s/^$root_path//g;
1444
1445         @links = split (/\//, $uri);
1446
1447         # Get the full path of the base directory
1448         my $dirname;
1449         {
1450                 my @direlem = split (/\//, $filename);
1451                 for my $i ( 0 .. ( scalar(@direlem) - scalar(@links) ) ) {
1452                         $dirname .= shift(@direlem) . '/';
1453                 }
1454                 chop $dirname;
1455         }
1456
1457         my $picturename;
1458         if (-f $filename) {
1459                 $picturename = pop(@links);
1460         }
1461
1462         if ($r->uri eq $root_path) {
1463                 return qq{ <a href="$root_path">$root_text</a> };
1464         }
1465
1466         my $menu;
1467         my $menuurl = $root_path;
1468         foreach my $link (@links) {
1469
1470                 $menuurl .= $link."/";
1471                 my $linktext = $link;
1472                 unless (length($link)) {
1473                         $linktext = "$root_text ";
1474                 }
1475                 else {
1476
1477                         $dirname = File::Spec->catdir($dirname, $link);
1478
1479                         if (-e $dirname . ".folder") {
1480                                 $linktext = get_filecontent($dirname . ".folder");
1481                         }
1482                 }
1483
1484                 if ("$root_path$uri" eq $menuurl) {
1485                         $menu .= "$linktext  / ";
1486                 }
1487                 else {
1488                         $menu .= "<a href=\"".uri_escape($menuurl, $escape_rule)."\">$linktext</a> / ";
1489                 }
1490
1491         }
1492
1493         if (-f $filename) {
1494                 $menu .= $picturename;
1495         }
1496         else {
1497
1498                 if ($r->dir_config('GallerySelectionMode') && $r->dir_config('GallerySelectionMode') eq '1') {
1499                         $menu .= "<a href=\"".uri_escape($menuurl, $escape_rule);
1500                         $menu .= "?select=1\">[select]</a> ";
1501                 }
1502         }
1503
1504         return $menu;
1505 }
1506
1507 sub resizepicture {
1508         my ($r, $infile, $outfile, $x, $y, $rotate, $copyrightfile, $GalleryTTFDir, $GalleryCopyrightText, $text_color, $GalleryTTFFile, $GalleryTTFSize, $GalleryCopyrightBackgroundColor, $quality) = @_;
1509
1510         # Load image
1511         my $image = Image::Imlib2->load($infile) or warn("Unable to open file $infile, $!");
1512
1513         # Scale image
1514         $image=$image->create_scaled_image($x, $y) or warn("Unable to scale image $infile. Are you running out of memory?");
1515
1516         # Rotate image
1517         if ($rotate != 0) {
1518                 $image->image_orientate($rotate);
1519         }
1520
1521         # blend copyright image onto image
1522         if ($copyrightfile ne '') {
1523                 if (-f $copyrightfile and (my $logo=Image::Imlib2->load($copyrightfile))) {
1524                         my $x = $image->get_width();
1525                         my $y = $image->get_height();
1526                         my $logox = $logo->get_width();
1527                         my $logoy = $logo->get_height();
1528                         $image->blend($logo, 0, 0, 0, $logox, $logoy, $x-$logox, $y-$logoy, $logox, $logoy);
1529                 }
1530                 else {
1531                         log_error("GalleryCopyrightImage $copyrightfile was not found");
1532                 }
1533         }
1534
1535         if ($GalleryTTFDir && $GalleryCopyrightText && $GalleryTTFFile && $text_color) {
1536                 if (!-d $GalleryTTFDir) {
1537
1538                         log_error("GalleryTTFDir $GalleryTTFDir is not a dir\n");
1539
1540                 } elsif ($GalleryCopyrightText eq '') {
1541
1542                         log_error("GalleryCopyrightText is empty. No text inserted to picture\n");
1543
1544                 } elsif (!-e "$GalleryTTFDir/$GalleryTTFFile") {
1545
1546                         log_error("GalleryTTFFile $GalleryTTFFile was not found\n");
1547
1548                 } else {
1549
1550                         $GalleryTTFFile =~ s/\.TTF$//i;
1551                         $image->add_font_path("$GalleryTTFDir");
1552
1553                         $image->load_font("$GalleryTTFFile/$GalleryTTFSize");
1554                         my($text_x, $text_y) = $image->get_text_size("$GalleryCopyrightText");
1555                         my $x = $image->get_width();
1556                         my $y = $image->get_height();
1557
1558                         my $offset = 3;
1559
1560                         if (($text_x < $x - $offset) && ($text_y < $y - $offset)) {
1561                                 if ($GalleryCopyrightBackgroundColor =~ /^\d+,\d+,\d+,\d+$/) {
1562                                         my ($br_val, $bg_val, $bb_val, $ba_val) = split (/,/, $GalleryCopyrightBackgroundColor);
1563                                         $image->set_colour($br_val, $bg_val, $bb_val, $ba_val);
1564                                         $image->fill_rectangle ($x-$text_x-$offset, $y-$text_y-$offset, $text_x, $text_y);
1565                                 }
1566                                 my ($r_val, $g_val, $b_val, $a_val) = split (/,/, $text_color);
1567                                 $image->set_colour($r_val, $g_val, $b_val, $a_val);
1568                                 $image->draw_text($x-$text_x-$offset, $y-$text_y-$offset, "$GalleryCopyrightText");
1569                         } else {
1570                                 log_error("Text is to big for the picture.\n");
1571                         }
1572                 }
1573         }
1574
1575         if ($quality && $quality =~ m/^\d+$/) {
1576                 $image->set_quality($quality);
1577         }
1578
1579         $image->save($outfile);
1580
1581 }
1582
1583 sub gallerysort {
1584         my $r=shift;
1585         my @files=@_;
1586         my $sortby = $r->dir_config('GallerySortBy');
1587         my $filename=$r->lookup_uri($r->uri)->filename;
1588         $filename=(File::Spec->splitpath($filename))[1] if (-f $filename);
1589         if ($sortby && $sortby =~ m/^(size|atime|mtime|ctime)$/) {
1590                 @files = map(/^\d+ (.*)/, sort map(stat("$filename/$_")->$sortby()." $_", @files));
1591         } else {
1592                 @files = sort @files;
1593         }
1594         return @files;
1595 }
1596
1597 # Create Text::Template objects used by Apache::Gallery. Takes a
1598 # hashref of template_name, template_filename pairs, and returns a
1599 # list of template_name, texttemplate_object pairs.
1600 sub create_templates {
1601      my $templates = shift;
1602
1603      # This routine is called whenever a template has an error. Prints
1604      # the error to STDERR and sticks the error in the output
1605      sub tt_broken {
1606           my %args = @_;
1607           # Pull out the name and filename from the arg option [see
1608           # Text::Template for details]
1609           @args{qw(name file)} = @{$args{arg}};
1610           print STDERR qq(Template $args{name} ("$args{file}") is broken: $args{error});
1611           # Don't include the file name in the output, as the user can see this.
1612           return qq(<!-- Template $args{name} is broken: $args{error} -->);
1613      }
1614
1615
1616
1617      my %texttemplate_objects;
1618
1619      for my $template_name (keys %$templates) {
1620           my $tt_obj = Text::Template->new(TYPE   => 'FILE',
1621                                            SOURCE => $$templates{$template_name},
1622                                            BROKEN => \&tt_broken,
1623                                            BROKEN_ARG => [$template_name, $$templates{$template_name}],
1624                                           )
1625                or die "Unable to create new Text::Template object for $template_name: $Text::Template::ERROR";
1626           $texttemplate_objects{$template_name} = $tt_obj;
1627      }
1628      return %texttemplate_objects;
1629 }
1630
1631 sub log_error {
1632         if ($::MP2) {
1633                 Apache2::RequestUtil->request->log_error(shift());
1634         } else {
1635                 Apache->request->log_error(shift());
1636         }
1637 }
1638
1639 1;
1640
1641 =head1 NAME
1642
1643 Apache::Gallery - mod_perl handler to create an image gallery
1644
1645 =head1 SYNOPSIS
1646
1647 See the INSTALL file in the distribution for installation instructions.
1648
1649 =head1 DESCRIPTION
1650
1651 Apache::Gallery creates an thumbnail index of each directory and allows
1652 viewing pictures in different resolutions. Pictures are resized on the
1653 fly and cached. The gallery can be configured and customized in many ways
1654 and a custom copyright image can be added to all the images without
1655 modifying the original.
1656
1657 =head1 CONFIGURATION
1658
1659 In your httpd.conf you set the global options for the gallery. You can
1660 also override each of the options in .htaccess files in your gallery
1661 directories.
1662
1663 The options are set in the httpd.conf/.htaccess file using the syntax:
1664 B<PerlSetVar OptionName 'value'>
1665
1666 Example: B<PerlSetVar GalleryCacheDir '/var/cache/www/'>
1667
1668 =over 4
1669
1670 =item B<GalleryAutoRotate>
1671
1672 Some cameras, like the Canon G3, can detect the orientation of a
1673 the pictures you take and will save this information in the
1674 'Orientation' EXIF field. Apache::Gallery will then automatically
1675 rotate your images.
1676
1677 This behavior is default but can be disabled by setting GalleryAutoRotate
1678 to 0.
1679
1680 =item B<GalleryCacheDir>
1681
1682 Directory where Apache::Gallery should create its cache with scaled
1683 pictures. The default is /var/cache/www/ . Here, a directory for each
1684 virtualhost or location will be created automatically. Make sure your
1685 webserver has write access to the CacheDir.
1686
1687 =item B<GalleryTemplateDir>
1688
1689 Full path to the directory where you placed the templates. This option
1690 can be used both in your global configuration and in .htaccess files,
1691 this way you can have different layouts in different parts of your
1692 gallery.
1693
1694 No default value, this option is required.
1695
1696 =item B<GalleryInfo>
1697
1698 With this option you can define which EXIF information you would like
1699 to present from the image. The format is: '<MyName => KeyInEXIF,
1700 MyOtherName => OtherKeyInEXIF'
1701
1702 Examples of keys: B<ShutterSpeedValue>, B<ApertureValue>, B<SubjectDistance>,
1703 and B<Camera>
1704
1705 You can view all the keys from the EXIF header using this perl-oneliner:
1706
1707 perl C<-e> 'use Data::Dumper; use Image::Info qw(image_info); print Dumper(image_info(shift));' filename.jpg
1708
1709 Default is: 'Picture Taken => DateTimeOriginal, Flash => Flash'
1710
1711 =item B<GallerySizes>
1712
1713 Defines which widths images can be scaled to. Images cannot be
1714 scaled to other widths than the ones you define with this option.
1715
1716 The default is '640 800 1024 1600'
1717
1718 =item B<GalleryThumbnailSize>
1719
1720 Defines the width and height of the thumbnail images.
1721
1722 Defaults to '100x75'
1723
1724 =item B<GalleryThumbnailSizeLS>
1725
1726 If set to '1', B<GalleryThumbnailSize> is the long and the short side of
1727 the thumbnail image instead of the width and height.
1728
1729 Defaults to '0'.
1730
1731 =item B<GalleryCopyrightImage>
1732
1733 Image you want to blend into your images in the lower right
1734 corner. This could be a transparent png saying "copyright
1735 my name 2001".
1736
1737 Optional.
1738
1739 =item B<GalleryWrapNavigation>
1740
1741 Make the navigation in the picture view wrap around (So Next
1742 at the end displays the first picture, etc.)
1743
1744 Set to 1 or 0, default is 0
1745
1746 =item B<GalleryAllowOriginal>
1747
1748 Allow the user to download the Original picture without
1749 resizing or putting the CopyrightImage on it.
1750
1751 Set to 1 or 0, default is 0
1752
1753 =item B<GallerySlideshowIntervals>
1754
1755 With this option you can configure which intervals can be selected for
1756 a slideshow. The default is '3 5 10 15 30'
1757
1758 =item B<GallerySortBy>
1759
1760 Instead of the default filename ordering you can sort by any
1761 stat attribute. For example size, atime, mtime, ctime.
1762
1763 =item B<GalleryDirSortBy>
1764
1765 Set this variable to sort directories differently than other items,
1766 can be set to size, atime, mtime and ctime; setting any other value
1767 will revert to sorting by name.
1768
1769 =item B<GalleryMemoize>
1770
1771 Cache EXIF data using Memoize - this will make Apache::Gallery faster
1772 when many people access the same images, but it will also cache EXIF
1773 data until the current Apache child dies.
1774
1775 =item B<GalleryUseFileDate>
1776
1777 Set this option to 1 to make A::G show the files timestamp
1778 instead of the EXIF value for "Picture taken".
1779
1780 =item B<GallerySelectionMode>
1781
1782 Enable the selection mode. Select images with checkboxes and
1783 get a list of filenames.
1784
1785 =item B<GalleryEXIFMode>
1786
1787 You can choose how Apache::Gallery should display EXIF info
1788 from your images.
1789
1790 The default setting is 'namevalue'. This setting will make
1791 Apache::Gallery print out the names and values of the EXIF values
1792 you configure with GalleryInfo. The information will be parsed into
1793 $INFO in pictureinfo.tpl.
1794
1795 You can also set it to 'values' which will make A::G parse
1796 the configured values into the var $EXIFVALUES as 'value | value | value'
1797
1798 If you set this option to 'variables' the items you configure in GalleryInfo
1799 will be available to your templates as $EXIF_<KEYNAME> (in all uppercase).
1800 That means that with the default setting "Picture Taken => DateTimeOriginal,
1801 Flash => Flash" you will have the variables $EXIF_DATETIMEORIGINAL and
1802 $EXIF_FLASH available to your templates. You can place them
1803 anywhere you want.
1804
1805 =item B<GalleryRootPath>
1806
1807 Change the location of gallery root. The default is ""
1808
1809 =item B<GalleryRootText>
1810
1811 Change the name that appears as the root element in the menu. The
1812 default is "root:"
1813
1814 =item B<GalleryMaxThumbnailsPerPage>
1815
1816 This options controls how many thumbnails should be displayed in a
1817 page. It requires $BROWSELINKS to be in the index.tpl template file.
1818
1819 =item B<GalleryImgFile>
1820
1821 Pattern matching the files you want Apache::Gallery to view in the
1822 index as thumbnails.
1823
1824 The default is '\.(jpe?g|png|tiff?|ppm)$'
1825
1826 =item B<GalleryDocFile>
1827
1828 Pattern matching the files you want Apache::Gallery to view in the index
1829 as normal files. All other filetypes will still be served by Apache::Gallery
1830 but are not visible in the index.
1831
1832 The default is '\.(mpe?g|avi|mov|asf|wmv|doc|mp3|ogg|pdf|rtf|wav|dlt|txt|html?|csv|eps)$'
1833
1834 =item B<GalleryTTFDir>
1835
1836 To use the GalleryCopyrightText feature you must set this option to the
1837 directory where your True Type fonts are stored. No default is set.
1838
1839 Example:
1840
1841         PerlSetVar      GalleryTTFDir '/usr/share/fonts/'
1842
1843 =item B<GalleryTTFFile>
1844
1845 To use the GalleryCopyrightText feature this option must be set to the
1846 name of the True Type font you wish to use. Example:
1847
1848         PerlSetVar      GalleryTTFFile 'verdanab.ttf'
1849
1850 =item B<GalleryTTFSize>
1851
1852 Configure the size of the CopyrightText that will be inserted as
1853 copyright notice in the corner of your pictures.
1854
1855 Example:
1856
1857         PerlSetVar      GalleryTTFSize '10'
1858
1859 =item B<GalleryCopyrightText>
1860
1861 The text that will be inserted as copyright notice.
1862
1863 Example:
1864
1865         PerlSetVar      GalleryCopyrightText '(c) Michael Legart'
1866
1867 =item B<GalleryCopyrightColor>
1868
1869 The text color of your copyright notice.
1870
1871 Examples:
1872
1873 White:
1874         PerlSetVar      GalleryCopyrightColor '255,255,255,255'
1875
1876 Black:
1877         PerlSetVar      GalleryCopyrightColor '0,0,0,255'
1878
1879 Red:
1880         PerlSetVar      GalleryCopyrightColor '255,0,0,255'
1881
1882 Green:
1883         PerlSetVar      GalleryCopyrightColor '0,255,0,255'
1884
1885 Blue:
1886         PerlSetVar      GalleryCopyrightColor '0,0,255,255'
1887
1888 Transparent orange:
1889         PerlSetVar      GalleryCopyrightColor '255,127,0,127'
1890
1891 =item B<GalleryCopyrightBackgroundColor>
1892
1893 The background-color of a GalleryCopyrightText
1894
1895 r,g,b,a - for examples, see GalleryCopyrightColor
1896
1897 =item B<GalleryQuality>
1898
1899 The quality (1-100) of scaled images
1900
1901 This setting affects the quality of the scaled images.
1902 Set this to a low number to reduce the size of the scaled images.
1903 Remember to clear out your cache if you change this setting.
1904 Quality seems to default to 75, at least in the jpeg and png loader code in
1905 Imlib2 1.1.0.
1906
1907 Examples:
1908
1909 Quality at 50:
1910         PerlSetVar      GalleryQuality '50'
1911
1912 =item B<GalleryUnderscoresToSpaces>
1913
1914 Set this option to 1 to convert underscores to spaces in the listing
1915 of directory and file names, as well as in the alt attribute for HTML
1916 <img> tags.
1917
1918 =back
1919
1920 =over 4
1921
1922 =item B<GalleryCommentExifKey>
1923
1924 Set this option to e.g. ImageDescription to use this field as comments
1925 for images.
1926
1927 =item B<GalleryEnableMediaRss>
1928
1929 Set this option to 1 to enable generation of a media RSS feed. This
1930 can be used e.g. together with the PicLens plugin from http://piclens.com
1931
1932 =back
1933
1934 =head1 FEATURES
1935
1936 =over 4
1937
1938 =item B<Rotate images>
1939
1940 Some cameras, like the Canon G3, detects the orientation of a picture
1941 and adds this info to the EXIF header. Apache::Gallery detects this
1942 and automatically rotates images with this info.
1943
1944 If your camera does not support this, you can rotate the images
1945 manually, This can also be used to override the rotate information
1946 from a camera that supports that. You can also disable this behavior
1947 with the GalleryAutoRotate option.
1948
1949 To use this functionality you have to create file with the name of the
1950 picture you want rotated appended with ".rotate". The file should include
1951 a number where these numbers are supported:
1952
1953         "1", rotates clockwise by 90 degree
1954         "2", rotates clockwise by 180 degrees
1955         "3", rotates clockwise by 270 degrees
1956
1957 So if we want to rotate "Picture1234.jpg" 90 degrees clockwise we would
1958 create a file in the same directory called "Picture1234.jpg.rotate" with
1959 the number 1 inside of it.
1960
1961 =item B<Ignore directories/files>
1962
1963 To ignore a directory or a file (of any kind, not only images) you
1964 create a <directory|file>.ignore file.
1965
1966 =item B<Comments>
1967
1968 To include comments for a directory you create a <directory>.comment
1969 file where the first line can contain "TITLE: New title" which
1970 will be the title of the page, and a comment on the following
1971 lines.
1972 To include comments for each picture you create files called
1973 picture.jpg.comment where the first line can contain "TITLE: New
1974 title" which will be the title of the page, and a comment on the
1975 following lines.
1976
1977 Example:
1978
1979         TITLE: This is the new title of the page
1980         And this is the comment.<br />
1981         And this is line two of the comment.
1982
1983 The visible name of the folder is by default identical to the name of
1984 the folder, but can be changed by creating a file <directory>.folder
1985 with the visible name of the folder.
1986
1987 It is also possible to set GalleryCommentExifKey to the name of an EXIF
1988 field containing the comment, e.g. ImageDescription. The EXIF comment is
1989 overridden by the .comment file if it exists.
1990
1991 =back
1992
1993 =head1 DEPENDENCIES
1994
1995 =over 4
1996
1997 =item B<Perl 5>
1998
1999 =item B<Apache with mod_perl>
2000
2001 =item B<URI::Escape>
2002
2003 =item B<Image::Info>
2004
2005 =item B<Image::Size>
2006
2007 =item B<Text::Template>
2008
2009 =item B<Image::Imlib2>
2010
2011 =item B<X11 libraries>
2012 (ie, XFree86)
2013
2014 =item B<Imlib2>
2015 Remember the -dev package when using rpm, deb or other package formats!
2016
2017 =back
2018
2019 =head1 AUTHOR
2020
2021 Michael Legart <michael@legart.dk>
2022
2023 =head1 COPYRIGHT AND LICENSE
2024
2025 Copyright (C) 2001-2011 Michael Legart <michael@legart.dk>
2026
2027 Templates designed by Thomas Kjaer <tk@lnx.dk>
2028
2029 Apache::Gallery is free software and is released under the Artistic License.
2030 See B<http://www.perl.com/language/misc/Artistic.html> for details.
2031
2032 The video icons are from the GNOME project. B<http://www.gnome.org/>
2033
2034 =head1 THANKS
2035
2036 Thanks to Thomas Kjaer for templates and design of B<http://apachegallery.dk>
2037 Thanks to Thomas Eibner and other for patches. (See the Changes file)
2038
2039 =head1 SEE ALSO
2040
2041 L<perl>, L<mod_perl>, L<Image::Imlib2>, L<CGI::FastTemplate>,
2042 L<Image::Info>, and L<Image::Size>.
2043
2044 =cut