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