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