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 $haspics=0;
  88         &iteratedir($D,$start,$dir,sub {
  89                 my ($start,$dir,$base)=@_;
  90                 my $en=sprintf("%s/%s/%s",$start,$dir,$base);
  91                 return unless ( -f $en );
  92                 $haspics=1 if (&processfile($start,$dir,$base,$en));
  93         });
  94
  95 # write HTML footer
  96
  97         print br({-clear=>"all"}),"\n";
  98         print hr,"\n" if ($haspics);
  99         print end_center,"\n";
 100         print end_html,"\n";
 101
 102         close(STDOUT);
 103         closedir($D);
 104 }
 105
 106 #############################################################
 107 # helper functions
 108 #############################################################
 109
 110 sub iteratedir {
 111         my ($D,$start,$dir,$prog)=@_;
 112         my @list=();
 113         while (my $de=readdir($D)) {
 114                 next if ($de =~ /^\./);
 115                 push(@list,$de);
 116         }
 117         foreach my $de(sort @list) {
 118                 &$prog($start,$dir,$de);
 119         }
 120         rewinddir($D);
 121 }
 122
 123 sub getinclude {
 124         my ($dn)=@_;
 125
 126         my $depth=20;
 127         my $str="";
 128         #print STDERR "start include ",$dn."/".$str.".include","\n";
 129         while ( ! -d $dn."/".$str.".include" ) {
 130                 #print STDERR "not include ",$dn."/".$str.".include","\n";
 131                 $str.="../";
 132                 last unless ($depth--);
 133         }
 134         #print STDERR "end include ",$dn."/".$str.".include","\n";
 135         if ( -d $dn."/".$str.".include" ) {
 136                 #print STDERR "return include ".$str.".include/".$fn,"\n";
 137                 return $str.".include/";
 138         } else {
 139                 return ""; # won't work anyway but return something
 140         }
 141 }
 142
 143 sub gettitle {
 144         my ($dir,$dflt)=@_;
 145
 146         my $F;
 147         my $str;
 148         if (open($F,"<".$dir."/.title")) {
 149                 $str=<$F>;
 150                 chop $str;
 151                 close($F);
 152         } else {
 153                 print STDERR "enter title for $dir\n";
 154                 $str=<>;
 155                 if ($str =~ /^\s*$/) {
 156                         $str=$dflt;
 157                 }
 158                 if (open($F,">".$dir."/.title")) {
 159                         print $F $str,"\n";
 160                         close($F);
 161                 } else {
 162                         print STDERR "cant open .title in $dir for writing: $!";
 163                 }
 164         }
 165         return $str;
 166 }
 167
 168 sub subalbum {
 169         my ($base,$title)=@_;
 170
 171         print Tr({-bgcolor=>"#c0c0c0"},
 172                 td(a({-href=>$base."/"},$base)),
 173                 td(a({-href=>$base."/"},$title))),"\n";
 174 }
 175
 176 sub processfile {
 177         my ($start,$dir,$base,$fn)=@_;
 178
 179         my $info = image_info($fn);
 180         if (my $error = $info->{error}) {
 181                 if (($error !~ "Unrecognized file format") &&
 182                     ($error !~ "Can't read head")) {
 183                         print STDERR "File \"$fn\": $error\n";
 184                 }
 185                 return 0;
 186         }
 187         my ($w,$h) = dim($info);
 188         my $title=$info->{'Comment'};
 189         $title=$base unless ($title);
 190         my $thumb=&scale($start,$dir,$base,$fn,160,$info);
 191         my $medium=&scale($start,$dir,$base,$fn,640,$info);
 192         print &infobox($info,$base,$fn),"\n";
 193         print table({-class=>'slide'},Tr(td(
 194                 a({-href=>".info/$base.html",
 195                         -onClick=>"return showIbox('$base');"},$title),
 196                 br,
 197                 a({-href=>$medium,-rel=>"lightbox",-title=>$title},
 198                         img({-src=>$thumb})),
 199                 br,
 200                 a({-href=>$base},"($w x $h)"),
 201                 br))),"\n";
 202         #for my $k(keys %$info) {
 203         #       print "\t$k:\t$info->{$k}<br>\n";
 204         #}
 205         return 1;
 206 }
 207
 208 sub infobox {
 209         my ($info,$base,$fn)=@_;
 210
 211         my @infokeys=(
 212                 'DateTime',
 213                 'ExposureTime',
 214                 'FNumber',
 215                 'Flash',
 216                 'ISOSpeedRatings',
 217                 'MeteringMode',
 218                 'ExposureProgram',
 219                 'FocalLength',
 220                 'FileSource',
 221                 'Make',
 222                 'Model',
 223                 'Software',
 224         );
 225
 226         my $msg=start_div({-class=>'ibox',-id=>$base,-OnClick=>"HideIbox('$base');"});
 227         $msg.=span({-style=>'float: left;'},"Info for $base").
 228                 span({-style=>'float: right;'},
 229                         a({-href=>"#",-OnClick=>"HideIbox('$base');"},"Close"));
 230         $msg.=br({-clear=>'all'});
 231         $msg.=start_table;
 232         foreach my $k(@infokeys) {
 233                 $msg.=Tr(td($k.":"),td($info->{$k}));
 234         }
 235         $msg.=end_table;
 236         $msg.=end_div;
 237         return $msg;
 238 }
 239
 240 sub scale {
 241         my ($start,$dir,$base,$fn,$tsize,$info)=@_;
 242         my ($w,$h) = dim($info);
 243         my $max=($w>$h)?$w:$h;
 244         my $factor=$tsize/$max;
 245
 246         return $base if ($factor >= 1);
 247
 248         my $tdir=sprintf "%s/%s/.%s",$start,$dir,$tsize;
 249         mkdir($tdir,0755) unless ( -d $tdir );
 250         my $tbase=sprintf ".%s/%s",$tsize,$base;
 251         my $tfn=sprintf "%s/%s",$tdir,$base;
 252         my @sstat=stat($fn);
 253         my @tstat=stat($tfn);
 254         return $tbase if (@tstat && ($sstat[9] < $tstat[9])); # [9] -> mtime
 255
 256         print STDERR "scale by $factor from $fn to $tfn\n";
 257         &doscaling($fn,$tfn,$factor,$w,$h);
 258         return $tbase;
 259 }
 260
 261 sub doscaling {
 262         my ($src,$dest,$factor,$w,$h)=@_;
 263
 264         my $im=new Image::Magick;
 265         my $err;
 266         #print STDERR "doscale $src -> $dest by $factor\n";
 267         $err=$im->Read($src);
 268         unless ($err) {
 269                 $im->Scale(width=>$w*$factor,height=>$h*$factor);
 270                 $err=$im->Write($dest);
 271                 warn "ImageMagic: write \"$dest\": $err" if ($err);
 272         } else {
 273                 warn "ImageMagic: read \"$src\": $err";
 274                 system("djpeg \"$src\" | pnmscale \"$factor\" | cjpeg >\"$dest\"");
 275         }
 276         undef $im;
 277 }