6 use CGI qw/:html *table *center *div/;
7 use Image::Info qw/image_info dim/;
13 ######################################################################
15 &processdir($startdir);
20 $dn .= "/".$dir if ($dir);
22 warn "not a directory: $dn";
26 unless (opendir($D,$dn)) {
27 warn "cannot opendir $dn: $!";
31 # recurse into subdirectories BEFORE opening index file
33 &iteratedir($D,$start,$dir,sub {
34 my ($start,$dir,$base)=@_;
36 $ndir .= "/" if ($ndir);
38 return unless ( -d $start."/".$ndir );
39 &processdir($start,$ndir);
44 my $title=&gettitle($dn,$dir);
48 my $inc=&getinclude($dn);
50 # generate directory index unless suppressed
52 if ( -e $dn."/.noindex" ) {
53 open(STDOUT,">/dev/null");
55 open(STDOUT,">".$dn."/index.html");
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";
70 # create list of sub-albums
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";
81 &subalbum($base,&gettitle($en,$dir."/".$base));
83 print end_table,hr,"\n" if ($hassubdirs);
85 # create picture gallery
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";
103 if (&processfile($start,$dir,$base,$en,$info)) {
105 push(@piclist,$base);
106 push(@infolist,$info);
112 print br({-clear=>"all"}),"\n";
113 print hr,"\n" if ($haspics);
114 print end_center,"\n";
120 # generate html files for slideshow from @piclist
122 for (my $i=0;$i<=$#piclist;$i++) {
123 my $base=$piclist[$i];
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]);
136 #############################################################
138 #############################################################
141 my ($D,$start,$dir,$prog)=@_;
143 while (my $de=readdir($D)) {
144 next if ($de =~ /^\./);
147 foreach my $de(sort @list) {
148 &$prog($start,$dir,$de);
158 #print STDERR "start include ",$dn."/".$str.".include","\n";
159 while ( ! -d $dn."/".$str.".include" ) {
160 #print STDERR "not include ",$dn."/".$str.".include","\n";
162 last unless ($depth--);
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/";
169 return ""; # won't work anyway but return something
178 if (open($F,"<".$dir."/.title")) {
183 print STDERR "enter title for $dir\n";
185 if ($str =~ /^\s*$/) {
188 if (open($F,">".$dir."/.title")) {
192 print STDERR "cant open .title in $dir for writing: $!";
199 my ($base,$title)=@_;
201 print Tr({-bgcolor=>"#c0c0c0"},
202 td(a({-href=>$base."/"},$base)),
203 td(a({-href=>$base."/"},$title))),"\n";
207 my ($start,$dir,$base,$fn,$info)=@_;
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),
219 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
220 img({-src=>$thumb})),
222 a({-href=>$base},"($w x $h)"),
228 my ($info,$base,$fn)=@_;
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'});
251 foreach my $k(@infokeys) {
252 $msg.=Tr(td($k.":"),td($info->{$k}));
260 my ($start,$dir,$pbase,$base,$nbase,$refresh,$info) =@_;
261 my $en=sprintf("%s/%s/.html/%s-%s.html",$start,$dir,$base,$refresh);
265 $pref=sprintf("%s-%s.html",$pbase,$refresh);
270 $nref=sprintf("%s-%s.html",$nbase,$refresh);
275 my $tdir=sprintf "%s/%s/.html",$start,$dir;
276 mkdir($tdir,0755) unless ( -d $tdir );
278 unless (open(STDOUT,">".$en)) {
279 warn "cannot open $en: $!";
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";
289 print start_html(-title=>$title),"\n";
291 print img({-src=>"../.640/".$base});
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;
302 return $base if ($factor >= 1);
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;
309 my @tstat=stat($tfn);
310 return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime
312 print STDERR "scale by $factor from $fn to $tfn\n";
313 &doscaling($fn,$tfn,$factor,$w,$h);
318 my ($src,$dest,$factor,$w,$h)=@_;
320 my $im=new Image::Magick;
322 #print STDERR "doscale $src -> $dest by $factor\n";
323 $err=$im->Read($src);
325 $im->Scale(width=>$w*$factor,height=>$h*$factor);
326 $err=$im->Write($dest);
327 warn "ImageMagic: write \"$dest\": $err" if ($err);
329 warn "ImageMagic: read \"$src\": $err";
330 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");