basic slideshow implemented
[mkgallery.git] / mkgallery.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use Carp;
5 use POSIX qw/getcwd/;
6 use CGI qw/:html *table *center *div/;
7 use Image::Info qw/image_info dim/;
8 use Image::Magick;
9
10 my $ask=1;
11 my $startdir=getcwd;
12
13 ######################################################################
14
15 &processdir($startdir);
16
17 sub processdir {
18         my ($start,$dir)=@_;
19         my $dn=$start;
20         $dn .= "/".$dir if ($dir);
21         unless ( -d $dn ) {
22                 warn "not a directory: $dn";
23                 return;
24         }
25         my $D;
26         unless (opendir($D,$dn)) {
27                 warn "cannot opendir $dn: $!";
28                 return;
29         }
30
31 # recurse into subdirectories BEFORE opening index file
32
33         &iteratedir($D,$start,$dir,sub {
34                 my ($start,$dir,$base)=@_;
35                 my $ndir = $dir;
36                 $ndir .= "/" if ($ndir);
37                 $ndir .= $base;
38                 return unless ( -d $start."/".$ndir );
39                 &processdir($start,$ndir);
40         });
41
42 # fill in title
43
44         my $title=&gettitle($dn,$dir);
45
46 # get include prefix
47
48         my $inc=&getinclude($dn);
49
50 # generate directory index unless suppressed
51
52         if ( -e $dn."/.noindex" ) {
53                 open(STDOUT,">/dev/null");
54         } else {
55                 open(STDOUT,">".$dn."/index.html");
56         }
57
58 # write HTML header
59
60         print start_html(-title => $title,
61                         -style=>{-src=>[$inc."gallery.css",
62                                         $inc."lightbox.css"]},
63                         -script=>[{-code=>"var incPrefix='$inc';"},
64                                 {-src=>$inc."gallery.js"},
65                                 {-src=>$inc."lightbox.js"}]),"\n";
66         print a({-href=>"../"},"UP");
67         print start_center,"\n";
68         print h1($title),"\n";
69
70 # create list of sub-albums
71
72         my $hassubdirs=0;
73         &iteratedir($D,$start,$dir,sub {
74                 my ($start,$dir,$base)=@_;
75                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
76                 return unless ( -d $en );
77                 unless ($hassubdirs) {
78                         print hr,h2("Albums"),start_table,"\n";
79                         $hassubdirs=1;
80                 }
81                 &subalbum($base,&gettitle($en,$dir."/".$base));
82         });
83         print end_table,hr,"\n" if ($hassubdirs);
84
85 # create picture gallery
86
87         my @piclist=();
88         my @infolist=();
89
90         my $haspics=0;
91         &iteratedir($D,$start,$dir,sub {
92                 my ($start,$dir,$base)=@_;
93                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
94                 return unless ( -f $en );
95                 my $info = image_info($en);
96                 if (my $error = $info->{error}) {
97                         if (($error !~ "Unrecognized file format") &&
98                             ($error !~ "Can't read head")) {
99                                 print STDERR "File \"$en\": $error\n";
100                         }
101                         return;
102                 }
103                 if (&processfile($start,$dir,$base,$en,$info)) {
104                         $haspics=1;
105                         push(@piclist,$base);
106                         push(@infolist,$info);
107                 }
108         });
109
110 # write HTML footer
111
112         print br({-clear=>"all"}),"\n";
113         print hr,"\n" if ($haspics);
114         print end_center,"\n";
115         print end_html,"\n";
116
117         close(STDOUT);
118         closedir($D);
119
120 # generate html files for slideshow from @piclist
121
122         for (my $i=0;$i<=$#piclist;$i++) {
123                 my $base=$piclist[$i];
124                 my $pbase;
125                 my $nbase;
126                 $pbase=$piclist[$i-1] if ($i>0);
127                 $nbase=$piclist[$i+1] if ($i<$#piclist);
128                 for my $refresh('static','slide') {
129                         &mkauxfile($start,$dir,$pbase,$base,$nbase,
130                                         $refresh,$infolist[$i]);
131                 }
132         }
133
134 }
135
136 #############################################################
137 # helper functions
138 #############################################################
139
140 sub iteratedir {
141         my ($D,$start,$dir,$prog)=@_;
142         my @list=();
143         while (my $de=readdir($D)) {
144                 next if ($de =~ /^\./);
145                 push(@list,$de);
146         }
147         foreach my $de(sort @list) {
148                 &$prog($start,$dir,$de);
149         }
150         rewinddir($D);
151 }
152
153 sub getinclude {
154         my ($dn)=@_;
155
156         my $depth=20;
157         my $str="";
158         #print STDERR "start include ",$dn."/".$str.".include","\n";
159         while ( ! -d $dn."/".$str.".include" ) {
160                 #print STDERR "not include ",$dn."/".$str.".include","\n";
161                 $str.="../";
162                 last unless ($depth--);
163         }
164         #print STDERR "end include ",$dn."/".$str.".include","\n";
165         if ( -d $dn."/".$str.".include" ) {
166                 #print STDERR "return include ".$str.".include/".$fn,"\n";
167                 return $str.".include/";
168         } else {
169                 return ""; # won't work anyway but return something
170         }
171 }
172
173 sub gettitle {
174         my ($dir,$dflt)=@_;
175
176         my $F;
177         my $str;
178         if (open($F,"<".$dir."/.title")) {
179                 $str=<$F>;
180                 chop $str;
181                 close($F);
182         } else {
183                 print STDERR "enter title for $dir\n";
184                 $str=<>;
185                 if ($str =~ /^\s*$/) {
186                         $str=$dflt;
187                 }
188                 if (open($F,">".$dir."/.title")) {
189                         print $F $str,"\n";
190                         close($F);
191                 } else {
192                         print STDERR "cant open .title in $dir for writing: $!";
193                 }
194         }
195         return $str;
196 }
197
198 sub subalbum {
199         my ($base,$title)=@_;
200
201         print Tr({-bgcolor=>"#c0c0c0"},
202                 td(a({-href=>$base."/"},$base)),
203                 td(a({-href=>$base."/"},$title))),"\n";
204 }
205
206 sub processfile {
207         my ($start,$dir,$base,$fn,$info)=@_;
208
209         my ($w,$h) = dim($info);
210         my $title=$info->{'Comment'};
211         $title=$base unless ($title);
212         my $thumb=&scale($start,$dir,$base,$fn,160,$info);
213         my $medium=&scale($start,$dir,$base,$fn,640,$info);
214         print &infobox($info,$base,$fn),"\n";
215         print table({-class=>'slide'},Tr(td(
216                 a({-href=>".html/$base-info.html",
217                         -onClick=>"return showIbox('$base');"},$title),
218                 br,
219                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
220                         img({-src=>$thumb})),
221                 br,
222                 a({-href=>$base},"($w x $h)"),
223                 br))),"\n";
224         return 1;
225 }
226
227 sub infobox {
228         my ($info,$base,$fn)=@_;
229
230         my @infokeys=(
231                 'DateTime',
232                 'ExposureTime',
233                 'FNumber',
234                 'Flash',
235                 'ISOSpeedRatings',
236                 'MeteringMode',
237                 'ExposureProgram',
238                 'FocalLength',
239                 'FileSource',
240                 'Make',
241                 'Model',
242                 'Software',
243         );
244
245         my $msg=start_div({-class=>'ibox',-id=>$base,-OnClick=>"HideIbox('$base');"});
246         $msg.=span({-style=>'float: left;'},"Info for $base").
247                 span({-style=>'float: right;'},
248                         a({-href=>"#",-OnClick=>"HideIbox('$base');"},"Close"));
249         $msg.=br({-clear=>'all'});
250         $msg.=start_table;
251         foreach my $k(@infokeys) {
252                 $msg.=Tr(td($k.":"),td($info->{$k}));
253         }
254         $msg.=end_table;
255         $msg.=end_div;
256         return $msg;
257 }
258
259 sub mkauxfile {
260         my ($start,$dir,$pbase,$base,$nbase,$refresh,$info) =@_;
261         my $en=sprintf("%s/%s/.html/%s-%s.html",$start,$dir,$base,$refresh);
262         my $pref;
263         my $nref;
264         if ($pbase) {
265                 $pref=sprintf("%s-%s.html",$pbase,$refresh);
266         } else {
267                 $pref="../";
268         }
269         if ($nbase) {
270                 $nref=sprintf("%s-%s.html",$nbase,$refresh);
271         } else {
272                 $nref="../";
273         }
274
275         my $tdir=sprintf "%s/%s/.html",$start,$dir;
276         mkdir($tdir,0755) unless ( -d $tdir );
277
278         unless (open(STDOUT,">".$en)) {
279                 warn "cannot open $en: $!";
280                 return;
281         }
282         my $title=$info->{'Comment'};
283         $title=$base unless ($title);
284         if ($refresh eq 'slide') {
285                 print start_html(-title=>$title,
286                         -head=>meta({-http_equiv=>'Refresh',
287                                 -content=>"3; url=$nref"})),"\n";
288         } else {
289                 print start_html(-title=>$title),"\n";
290         }
291         print img({-src=>"../.640/".$base});
292         print end_html,"\n";
293         close(STDOUT);
294 }
295
296 sub scale {
297         my ($start,$dir,$base,$fn,$tsize,$info)=@_;
298         my ($w,$h) = dim($info);
299         my $max=($w>$h)?$w:$h;
300         my $factor=$tsize/$max;
301
302         return $base if ($factor >= 1);
303
304         my $tdir=sprintf "%s/%s/.%s",$start,$dir,$tsize;
305         mkdir($tdir,0755) unless ( -d $tdir );
306         my $tbase=sprintf ".%s/%s",$tsize,$base;
307         my $tfn=sprintf "%s/%s",$tdir,$base;
308         my @sstat=stat($fn);
309         my @tstat=stat($tfn);
310         return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime
311
312         print STDERR "scale by $factor from $fn to $tfn\n";
313         &doscaling($fn,$tfn,$factor,$w,$h);
314         return $tbase;
315 }
316
317 sub doscaling {
318         my ($src,$dest,$factor,$w,$h)=@_;
319
320         my $im=new Image::Magick;
321         my $err;
322         #print STDERR "doscale $src -> $dest by $factor\n";
323         $err=$im->Read($src);
324         unless ($err) {
325                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
326                 $err=$im->Write($dest);
327                 warn "ImageMagic: write \"$dest\": $err" if ($err);
328         } else {
329                 warn "ImageMagic: read \"$src\": $err";
330                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
331         }
332         undef $im;
333 }