preliminary code for building gallery RSS feed
[mkgallery.git] / mkgallery.pl
1 #!/usr/bin/perl
2
3 # $Id$
4
5 # Recursively create image gallery index and slideshow wrappings.
6 # Makes use of (slightly modified) "lightbox" Javascript/CSS as published
7 # at http://www.huddletogether.com/projects/lightbox/
8
9 # Copyright (c) 2006 Eugene G. Crosser
10
11 #  This software is provided 'as-is', without any express or implied
12 #  warranty.  In no event will the authors be held liable for any damages
13 #  arising from the use of this software.
14 #
15 #  Permission is granted to anyone to use this software for any purpose,
16 #  including commercial applications, and to alter it and redistribute it
17 #  freely, subject to the following restrictions:
18 #
19 #  1. The origin of this software must not be misrepresented; you must not
20 #     claim that you wrote the original software. If you use this software
21 #     in a product, an acknowledgment in the product documentation would be
22 #     appreciated but is not required.
23 #  2. Altered source versions must be plainly marked as such, and must not be
24 #     misrepresented as being the original software.
25 #  3. This notice may not be removed or altered from any source distribution.
26
27 package FsObj;
28
29 use strict;
30 use Carp;
31 use POSIX qw/getcwd strftime/;
32 use CGI qw/:html *table *Tr *center *div *Link/;
33 use Image::Info qw/image_info dim/;
34 use Term::ReadLine;
35 use Getopt::Long;
36 use Encode;
37 use encoding 'utf-8';
38 binmode(STDOUT, ":utf8");
39
40 my $haveimagick = eval { require Image::Magick; };
41 { package Image::Magick; }      # to make perl compiler happy
42
43 my $haverssxml = eval { require XML::RSS; };
44 { package XML::RSS; }           # to make perl compiler happy
45
46 my @sizes = (160, 640);
47
48 ######################################################################
49
50 my $incpath;
51 my $rssobj;
52 my $debug = 0;
53 my $asktitle = 0;
54 my $noasktitle = 0;
55 my $rssfile = "";
56
57 charset("utf-8");
58
59 unless (GetOptions(
60                 'help'=>\&help,
61                 'incpath'=>\$incpath,
62                 'asktitle'=>\$asktitle,
63                 'noasktitle'=>\$noasktitle,
64                 'rssfile=s'=>\$rssfile,
65                 'debug'=>\$debug)) {
66         &help;
67 }
68
69 if ($rssfile && ! $haverssxml) {
70         print STDERR "You need to get XML::RSS from CPAN to use --rssfile\n";
71         exit 1;
72 }
73
74 my $term = new Term::ReadLine "Edit Title";
75
76 FsObj->new(getcwd)->iterate;
77
78 if ($rssobj) {
79         $rssobj->save($rssfile);
80 }
81
82 sub help {
83
84         print STDERR <<__END__;
85 usage: $0 [options]
86  --help:        print help message and exit
87  --incpath:     do not try to find .include diretory upstream, use
88                 specified path (absolute or relavive).  Use with causion.
89  --debug:       print a lot of debugging info to stdout as you run
90  --asktitle:    ask to edit album titles even if there are ".title" files
91  --noasktitle:  don't ask to enter album titles even where ".title"
92                 files are absent.  Use partial directory names as titles.
93  --rssfile=...: build RSS feed for newly added "albums", give name of rss file
94 __END__
95
96         exit 1;
97 }
98
99 sub new {
100         my $this = shift;
101         my $class;
102         my $self;
103         if (ref($this)) {
104                 $class = ref($this);
105                 my $parent = $this;
106                 my $name = shift;
107                 my $fullpath = $parent->{-fullpath}.'/'.$name;
108                 $self = {
109                                 -parent=>$parent,
110                                 -root=>$parent->{-root},
111                                 -base=>$name,
112                                 -fullpath=>$fullpath,
113                                 -inc=>'../'.$parent->{-inc},
114                                 -rss=>'../'.$parent->{-rss},
115                         };
116         } else {
117                 $class = $this;
118                 my $root=shift;
119                 $self = {
120                                 -root=>$root,
121                                 -fullpath=>$root,
122                                 -inc=>getinc($root),
123                                 -rss=>getrss($root),
124                         };
125         }
126         bless $self, $class;
127         if ($debug) {
128                 print "new $class:\n";
129                 foreach my $k(keys %$self) {
130                         print "\t$k\t=\t$self->{$k}\n";
131                 }
132         }
133         return $self;
134 }
135
136 sub getinc {
137         my $fullpath=shift;     # this is not a method
138         my $depth=20;           # arbitrary max depth
139
140         if ($incpath) {
141                 return $incpath."/.include";
142         }
143
144         my $inc=".include";
145         while ( ! -d $fullpath."/".$inc ) {
146                 $inc = "../".$inc;
147                 last unless ($depth-- > 0);
148         }
149         if ($depth > 0) {
150                 return $inc.'/';                # prefix with trailing slash
151         } else {
152                 return 'NO-.INCLUDE-IN-PATH/';  # won't work anyway
153         }
154 }
155
156 sub getrss {
157         my $fullpath=shift;     # this is not a method
158         my $depth=20;           # arbitrary max depth
159
160         return "" unless $rssfile;
161
162         my $rss=$rssfile;
163         while ( ! -f $fullpath."/".$rss ) {
164                 $rss = "../".$rss;
165                 last unless ($depth-- > 0);
166         }
167         if ($depth > 0) {
168                 $rssobj = new XML::RSS (version=>2);
169                 $rssobj->parsefile($rss);
170                 return $rss;
171         } else {
172                 print STDERR "There is no $rssfile in this or parent ".
173                         "directories, you must create one with mkgalrss.pl\n";
174                 exit 1;
175         }
176 }
177
178 sub iterate {
179         my $self = shift;
180         my $fullpath .= $self->{-fullpath};
181         print "iterate in dir $fullpath\n" if ($debug);
182
183         my $youngest=0;
184         my @rdirlist;
185         my @rimglist;
186         my $D;
187         unless (opendir($D,$fullpath)) {
188                 warn "cannot opendir $fullpath: $!";
189                 return;
190         }
191         while (my $de = readdir($D)) {
192                 next if ($de =~ /^\./);
193                 my $child = $self->new($de);
194                 my @stat = stat($child->{-fullpath});
195                 $youngest = $stat[9] if ($youngest < $stat[9]);
196                 if ($child->isdir) {
197                         push(@rdirlist,$child);
198                 } elsif ($child->isimg) {
199                         push(@rimglist,$child);
200                 }
201         }
202         closedir($D);
203         my @dirlist = sort {$a->{-base} cmp $b->{-base}} @rdirlist;
204         undef @rdirlist; # inplace sorting would be handy here
205         my @imglist = sort {$a->{-base} cmp $b->{-base}} @rimglist;
206         undef @rimglist; # optimize away unsorted versions
207         $self->{-firstimg} = $imglist[0];
208
209         print "Dir: $self->{-fullpath}\n" if ($debug);
210
211 # 1. first of all, fill title for this directory and create hidden subdirs
212
213         $self->initdir;
214
215 # 2. recurse into subdirectories to get their titles filled
216 #    before we start writing out subalbum list
217
218         foreach my $dir(@dirlist) {
219                 $dir->iterate;
220         }
221
222 # 3. iterate through images to build cross-links,
223
224         my $previmg = undef;
225         foreach my $img(@imglist) {
226                 # list-linking must be done before generating
227                 # aux html because aux pages rely on prev/next refs
228                 if ($previmg) {
229                         $previmg->{-nextimg} = $img;
230                         $img->{-previmg} = $previmg;
231                 }
232                 $previmg=$img;
233         }
234
235 # 4. create scaled versions and aux html pages
236
237         foreach my $img(@imglist) {
238                 # scaled versions must be generated before aux html
239                 # and main image index because they both rely on
240                 # refs to scaled images and they may be just original
241                 # images, this is not known before we try scaling.
242                 $img->makescaled;
243                 # finally, make aux html pages
244                 $img->makeaux;
245         }
246
247 # no need to go beyond this point if the directory timestamp did not
248 # change since we built index.html file last time.
249
250         my @istat = stat($self->{-fullpath}.'/index.html');
251         return unless ($youngest > $istat[9]);
252
253 # 5. start building index.html for the directory
254
255         $self->startindex;
256
257 # 6. iterate through subdirectories to build subalbums list
258
259         if (@dirlist) {
260                 $self->startsublist;
261                 foreach my $dir(@dirlist) {
262                         $dir->sub_entry;
263                 }
264                 $self->endsublist;
265         }
266
267 # 7. iterate through images to build thumb list
268
269         if (@imglist) {
270                 $self->startimglist;
271                 foreach my $img(@imglist) {
272                         print "Img: $img->{-fullpath}\n" if ($debug);
273                         $img->img_entry;
274                 }
275                 $self->endimglist;
276         }
277
278 # 8. comlplete building index.html for the directory
279
280         $self->endindex;
281 }
282
283 sub isdir {
284         my $self = shift;
285         return ( -d $self->{-fullpath} );
286 }
287
288 sub isimg {
289         my $self = shift;
290         my $fullpath = $self->{-fullpath};
291         return 0 unless ( -f $fullpath );
292         my $info = image_info($fullpath);
293         if (my $error = $info->{error}) {
294                 if (($error !~ "Unrecognized file format") &&
295                     ($error !~ "Can't read head")) {
296                         warn "File \"$fullpath\": $error\n";
297                 }
298                 return 0;
299         }
300
301         tryapp12($info) unless ($info->{'ExifVersion'});
302
303         $self->{-isimg} = 1;
304         $self->{-info} = $info;
305         return 1;
306 }
307
308 sub tryapp12 {
309         my $info = shift;       # this is not a method
310         my $app12;
311         # dirty hack to take care of Image::Info parser strangeness
312         foreach my $k(keys %$info) {
313                 $app12=substr($k,6).$info->{$k} if ($k =~ /^App12-/);
314         }
315         return unless ($app12); # bad luck
316         my $seenfirstline=0;
317         foreach my $ln(split /[\r\n]+/,$app12) {
318                 $ln =~ s/[[:^print:]\000]/ /g;
319                 unless ($seenfirstline) {
320                         $seenfirstline=1;
321                         $info->{'Make'}=$ln;
322                         next;
323                 }
324                 my ($k,$v)=split /=/,$ln,2;
325                 if ($k eq 'TimeDate') {
326                         $info->{'DateTime'} =
327                                 strftime("%Y:%m:%d %H:%M:%S", localtime($v))
328                                                         unless ($v < 0);
329                 } elsif ($k eq 'Shutter') {
330                         $info->{'ExposureTime'} = '1/'.int(1000000/$v+.5);
331                 } elsif ($k eq 'Flash') {
332                         $info->{'Flash'} = $v?'Flash fired':'Flash did not fire';
333                 } elsif ($k eq 'Type') {
334                         $info->{'Model'} = $v;
335                 } elsif ($k eq 'Version') {
336                         $info->{'Software'} = $v;
337                 } elsif ($k eq 'Fnumber') {
338                         $info->{'FNumber'} = $v;
339                 }
340         }
341 }
342
343 sub initdir {
344         my $self = shift;
345         my $fullpath = $self->{-fullpath};
346         for my $subdir(@sizes, 'html') {
347                 my $tdir=sprintf "%s/.%s",$self->{-fullpath},$subdir;
348                 mkdir($tdir,0755) unless ( -d $tdir );
349         }
350         $self->edittitle;
351 }
352
353 sub edittitle {
354         my $self = shift;
355         my $fullpath = $self->{-fullpath};
356         my $title;
357         my $T;
358         if (open($T,'<'.$fullpath.'/.title')) {
359                 $title = <$T>;
360                 $title =~ s/[\r\n]*$//;
361                 close($T);
362         }
363         if ($asktitle || (!$title && !$noasktitle)) {
364                 my $prompt = $self->{-base};
365                 $prompt = '/' unless ($prompt);
366                 my $OUT = $term->OUT || \*STDOUT;
367                 print $OUT "Enter title for $fullpath\n";
368                 $title = $term->readline($prompt.' >',$title);
369                 $term->addhistory($title) if ($title);
370                 if (open($T,'>'.$fullpath.'/.title')) {
371                         print $T $title,"\n";
372                         close($T);
373                 }
374         }
375         unless ($title) {
376                 $title=substr($fullpath,length($self->{-root}));
377         }
378         $self->{-title}=$title;
379         print "title in $fullpath is $title\n" if ($debug);
380 }
381
382 sub makescaled {
383         my $self = shift;
384         my $fn = $self->{-fullpath};
385         my $name = $self->{-base};
386         my $dn = $self->{-parent}->{-fullpath};
387         my ($w, $h) = dim($self->{-info});
388         my $max = ($w > $h)?$w:$h;
389
390         foreach my $size(@sizes) {
391                 my $nref = '.'.$size.'/'.$name;
392                 my $nfn = $dn.'/'.$nref;
393                 my $factor=$size/$max;
394                 if ($factor >= 1) {
395                         $self->{$size} = $name; # unscaled version will do
396                 } else {
397                         $self->{$size} = $nref;
398                         if (isnewer($fn,$nfn)) {
399                                 doscaling($fn,$nfn,$factor,$w,$h);
400                         }
401                 }
402         }
403 }
404
405 sub isnewer {
406         my ($fn1,$fn2) = @_;                    # this is not a method
407         my @stat1=stat($fn1);
408         my @stat2=stat($fn2);
409         return (!@stat2 || ($stat1[9] > $stat2[9]));
410         # true if $fn2 is absent or is older than $fn1
411 }
412
413 sub doscaling {
414         my ($src,$dest,$factor,$w,$h) = @_;     # this is not a method
415
416         my $err=1;
417         if ($haveimagick) {
418                 my $im = new Image::Magick;
419                 print "doscaling $src -> $dest by $factor\n" if ($debug);
420                 if ($err = $im->Read($src)) {
421                         warn "ImageMagick: read \"$src\": $err";
422                 } else {
423                         $im->Scale(width=>$w*$factor,height=>$h*$factor);
424                         $err=$im->Write($dest);
425                         warn "ImageMagick: write \"$dest\": $err" if ($err);
426                 }
427                 undef $im;
428         }
429         if ($err) {     # fallback to command-line tools
430                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
431         }
432 }
433
434 sub makeaux {
435         my $self = shift;
436         my $name = $self->{-base};
437         my $dn = $self->{-parent}->{-fullpath};
438         my $pref = $self->{-previmg}->{-base};
439         my $nref = $self->{-nextimg}->{-base};
440         my $inc = $self->{-inc};
441         my $title = $self->{-info}->{'Comment'};
442         $title = $name unless ($title);
443
444         print "slide: \"$title\": \"$pref\"->\"$name\"->\"$nref\"\n" if ($debug);
445
446         # slideshow
447         for my $refresh('static', 'slide') {
448                 my $fn = sprintf("%s/.html/%s-%s.html",$dn,$name,$refresh);
449                 if (isnewer($self->{-fullpath},$fn)) {
450                         my $imgsrc = '../'.$self->{$sizes[1]};
451                         my $fwdref;
452                         my $bakref;
453                         if ($nref) {
454                                 $fwdref = sprintf("%s-%s.html",$nref,$refresh);
455                         } else {
456                                 $fwdref = '../index.html';
457                         }
458                         if ($pref) {
459                                 $bakref = sprintf("%s-%s.html",$pref,$refresh);
460                         } else {
461                                 $bakref = '../index.html';
462                         }
463                         my $toggleref;
464                         my $toggletext;
465                         if ($refresh eq 'slide') {
466                                 $toggleref=sprintf("%s-static.html",$name);
467                                 $toggletext = 'Stop!';
468                         } else {
469                                 $toggleref=sprintf("%s-slide.html",$name);
470                                 $toggletext = 'Play-&gt;';
471                         }
472                         my $F;
473                         unless (open($F,'>'.$fn)) {
474                                 warn "cannot open \"$fn\": $!";
475                                 next;
476                         }
477                         binmode($F, ":utf8");
478                         if ($refresh eq 'slide') {
479                                 print $F start_html(
480                                         -encoding=>"utf-8",
481                                         -title=>$title,
482                                         -bgcolor=>"#808080",
483                                         -head=>meta({-http_equiv=>'Refresh',
484                                                 -content=>"3; url=$fwdref"}),
485                                         -style=>{-src=>$inc."gallery.css"},
486                                         ),"\n";
487                                                 
488                         } else {
489                                 print $F start_html(-title=>$title,
490                                         -encoding=>"utf-8",
491                                         -bgcolor=>"#808080",
492                                         -style=>{-src=>$inc."gallery.css"},
493                                         ),"\n";
494                         }
495                         print $F start_center,"\n",
496                                 h1($title),"\n",
497                                 start_table({-class=>'navi'}),start_Tr,"\n",
498                                 td(a({-href=>"../index.html"},"Index")),"\n",
499                                 td(a({-href=>$bakref},"&lt;&lt;Prev")),"\n",
500                                 td(a({-href=>$toggleref},$toggletext)),"\n",
501                                 td(a({-href=>$fwdref},"Next&gt;&gt;")),"\n",
502                                 end_Tr,
503                                 end_table,"\n",
504                                 table({-class=>'picframe'},
505                                         Tr(td(img({-src=>$imgsrc})))),"\n",
506                                 end_center,"\n",
507                                 end_html,"\n";
508                         close($F);
509                 }
510         }
511
512         # info html
513         my $fn = sprintf("%s/.html/%s-info.html",$dn,$name);
514         if (isnewer($self->{-fullpath},$fn)) {
515                 my $F;
516                 unless (open($F,'>'.$fn)) {
517                         warn "cannot open \"$fn\": $!";
518                         return;
519                 }
520                 my $imgsrc = sprintf("../.%s/%s",$sizes[0],$name);
521                 print $F start_html(-title=>$title,
522                                 -encoding=>"utf-8",
523                                 -style=>{-src=>$inc."gallery.css"},),"\n",
524                         start_center,"\n",
525                         h1($title),"\n",
526                         table({-class=>'ipage'},
527                                 Tr(td(img({-src=>$imgsrc})),
528                                         td($self->infotable))),
529                         a({-href=>'../index.html'},'Index'),"\n",
530                         end_center,"\n",
531                         end_html,"\n";
532                 close($F);
533         }
534 }
535
536 sub startindex {
537         my $self = shift;
538         my $fn = $self->{-fullpath}.'/index.html';
539         my $block = $self->{-fullpath}.'/.noindex';
540         $fn = '/dev/null' if ( -f $block );
541         my $IND;
542         unless (open($IND,'>'.$fn)) {
543                 warn "cannot open $fn: $!";
544                 return;
545         }
546         binmode($IND, ":utf8");
547         $self->{-IND} = $IND;
548
549         my $inc = $self->{-inc};
550         my $title = $self->{-title};
551         my $rsslink="";
552         if ($self->{-rss}) {
553                 $rsslink=Link({-rel=>'alternate',
554                                 -type=>'application/rss+xml',
555                                 -title=>'RSS',
556                                 -href=>$self->{-rss}});
557         }
558         print $IND start_html(-title => $title,
559                         -encoding=>"utf-8",
560                         -head=>$rsslink,
561                         -style=>{-src=>[$inc."gallery.css",
562                                         $inc."lightbox.css"]},
563                         -script=>[{-code=>"var incPrefix='$inc';"},
564                                 {-src=>$inc."gallery.js"},
565                                 {-src=>$inc."lightbox.js"}]),
566                 a({-href=>"../index.html"},"UP"),"\n",
567                 start_center,"\n",
568                 h1($title),"\n",
569                 "\n";
570 }
571
572 sub endindex {
573         my $self = shift;
574         my $IND = $self->{-IND};
575
576         print $IND end_center,end_html,"\n";
577
578         close($IND) if ($IND);
579         undef $self->{-IND};
580         print STDERR "title=",$self->{-title},
581                 ", numofsubs=",$self->{-numofsubs},
582                 ", numofimgs=",$self->{-numofimgs},"\n";
583         if ($rssobj) {
584                 my $rsstitle=sprintf "%s [%d images, %d subalbums]",
585                                 $self->{-title},
586                                 $self->{-numofimgs},
587                                 $self->{-numofsubs};
588                 my $rsslink=$rssobj->channel('link')."index.html";
589                 $rssobj->add_item(
590                         title           => $self->{-title},
591                         link            => $rsslink,
592                         description     => $rsstitle,
593                 );
594         }
595 }
596
597 sub startsublist {
598         my $self = shift;
599         my $IND = $self->{-IND};
600
601         print $IND h2("Albums"),"\n",start_table,"\n";
602 }
603
604 sub sub_entry {
605         my $self = shift;
606         my $IND = $self->{-parent}->{-IND};
607         my $name = $self->{-base};
608         my $title = $self->{-title};
609
610         $self->{-parent}->{-numofsubs}++;
611         print $IND Tr(td(a({-href=>$name.'/index.html'},$name)),
612                         td(a({-href=>$name.'/index.html'},$title))),"\n";
613 }
614
615 sub endsublist {
616         my $self = shift;
617         my $IND = $self->{-IND};
618
619         print $IND end_table,"\n",br({-clear=>'all'}),hr,"\n\n";
620 }
621
622 sub startimglist {
623         my $self = shift;
624         my $IND = $self->{-IND};
625         my $first = $self->{-firstimg}->{-base};
626         my $slideref = sprintf(".html/%s-slide.html",$first);
627
628         print $IND h2("Images"),"\n",
629                 a({-href=>$slideref},'Slideshow'),
630                 "\n";
631 }
632
633 sub img_entry {
634         my $self = shift;
635         my $IND = $self->{-parent}->{-IND};
636         my $name = $self->{-base};
637         my $title = $self->{-info}->{'Comment'};
638         $title = $name unless ($title);
639         my $thumb = $self->{$sizes[0]};
640         my $medium = $self->{$sizes[1]};
641         my $info = $self->{-info};
642         my ($w, $h) = dim($info);
643
644         $self->{-parent}->{-numofimgs}++;
645         print $IND start_div({-class=>'ibox',-id=>$name,
646                                 -OnClick=>"HideIbox('$name');"}),"\n",
647                 start_div({-class=>'iboxtitle'}),
648                 span({-style=>'float: left;'},b("Info for $name")),
649                 span({-style=>'float: right;'},
650                         a({-href=>"#",-OnClick=>"HideIbox('$name');"},"Close")),
651                 br({-clear=>'all'}),"\n",
652                 end_div,"\n",
653                 $self->infotable,
654                 end_div,"\n";
655
656         print $IND table({-class=>'slide'},Tr(td(
657                 a({-href=>".html/$name-info.html",-title=>'Image Info',
658                         -onClick=>"return showIbox('$name');"},$title),
659                 br,
660                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
661                         img({-src=>$thumb})),
662                 br,
663                 a({-href=>$name,-title=>'Original Image'},"($w x $h)"),
664                 br))),"\n";
665 }
666
667 sub endimglist {
668         my $self = shift;
669         my $IND = $self->{-IND};
670
671         print $IND br({-clear=>'all'}),hr,"\n\n";
672 }
673
674 sub infotable {
675         my $self = shift;
676         my $info = $self->{-info};
677         my $msg='';
678
679         my @infokeys=(
680                 'DateTime',
681                 'ExposureTime',
682                 'FNumber',
683                 'Flash',
684                 'ISOSpeedRatings',
685                 'MeteringMode',
686                 'ExposureProgram',
687                 'FocalLength',
688                 'FileSource',
689                 'Make',
690                 'Model',
691                 'Software',
692         );
693         $msg.=start_table({-class=>'infotable'})."\n";
694         foreach my $k(@infokeys) {
695                 $msg.=Tr(td($k.":"),td($info->{$k}))."\n" if ($info->{$k});
696         }
697         $msg.=end_table."\n";
698 }
699