imagedir

   1 #!/usr/bin/perl
   2 use utf8;
   3 use Encode;
   4 use locale;
   5 use open OUT => ":locale";
   6 use constant THUMBSIZE => 150;
   7 use constant COLUMNS=>5;
   8 use constant THUMBDIR=>".thumbs";
   9 use constant INLINESIZE=> 600;
  10 use constant INLINEDIR=>".inline";
  11 use Image::Info qw(image_info dim);
  12 use Cwd;
  13 use Getopt::Std;
  14
  15 =head1 NAME
  16
  17 imagedir - generates HTML index for directory of pictures.
  18
  19 =head1 SINOPSIS
  20
  21 imagedir [-f] [B<-n>] [B<-l>] [B<-t> I<title>]
  22
  23 =head1 DESCRIPTION
  24
  25 Generates two hidden subdirs under current directory - B<.thumbs> and
  26 B<.inlines> with smaller copies of the images and generates
  27 B<index.html> with small (fit in the square 150x150) copies of the
  28 images as table.
  29
  30 Each image is a link to generated HTML page with bigger (fit into
  31 600x600) copy of the image and (unless supressed) link to full sized
  32 image. If image contain JPEG or GIF comment, comment is inserted into
  33 HTML.
  34
  35 =head1 OPTIONS
  36
  37 =over 4
  38
  39 =item B<-f>
  40
  41  Don't use filenames as headers of individual picture page
  42
  43 =item B<-l>
  44
  45 Supress link to fullsized images
  46
  47 =item B<-n>
  48
  49 If specified, all links in B<index.html> would have target="_blank"
  50 attribute.
  51
  52 =item B<-t> I<string>
  53
  54 Title. If none given, directory name is used.
  55
  56 =back
  57
  58 =cut
  59
  60 use vars qw($opt_t $opt_n $opt_l $opt_f);
  61 our %decoders=('image/gif'=>'giftopnm','image/tiff'=>'tifftopnm','image/jpeg'=>'djpeg');
  62
  63 getopts("t:lnf");
  64
  65 my $dir = $opt_t || (split ("/",cwd()))[-1];
  66 mkdir THUMBDIR if (! -d THUMBDIR);
  67 mkdir INLINEDIR if (! -d INLINEDIR);
  68 my $i=0;
  69 open OUT,">","index.html";
  70 print OUT "<HTML><HEAD><TITLE>$dir</TITLE>\n<BODY>\n<H1>$dir</H1>\n"
  71 ."<p align=\"center\"><A HREF=\"..\">back</A></p>".
  72  "<TABLE CELLSPACING=10 CELLPADDING=0 BORDER=0>\n";
  73 my @piclist=grep (/\.(jpe?g|png|tiff?|gif)$/i, <*>) ;
  74 my @movielist= grep(/\.(mp4|avi|flv|mpg)$/i,<*>);
  75 print STDERR "Pictures found @piclist\n";
  76 print STDERR "Videos found @movielist\n";
  77 my ($prev,$next);
  78 for ($j=0;$j<=$#piclist;$j++) {
  79   $_ = $piclist[$j];
  80   $prev = $piclist[$j-1] if $j>0;
  81   if ($j<$#piclist) {
  82   $next = $piclist[$j+1];
  83   } else {
  84    $next = undef;
  85   }
  86   print STDERR "$j:$_";
  87   chmod 0644, $_;
  88   my $info = image_info($_);
  89   my $thumbname=rescale($_,THUMBDIR,THUMBSIZE,$info);
  90   my $inlinename=rescale($_,INLINEDIR,INLINESIZE,$info);
  91   my $comment = make_comment_html($info);
  92   my ($w,$h) = dim(image_info(THUMBDIR."/$_"));
  93   print OUT "<tr>\n" if ($i % COLUMNS == 0);
  94   print OUT "<td valign=top align=center><a href=\"$_.html\"",($opt_n?"
  95   target=\"_blank\"":""),"><img border=0 width=$w height=$h src=\"$thumbname\"></a><br>$comment</td>\n";
  96   print OUT "</tr>\n" if (++$i % COLUMNS == 0);
  97   print STDERR " html...";
  98   make_html($_,$info,$comment,$inlinename);
  99   print STDERR "\b\b\b done";
 100   print STDERR "\n";
 101
 102 }
 103 print OUT "</tr>\n" unless ($i % COLUMNS == 0);
 104 print OUT "</table></body></html>\n";
 105 close OUT;
 106
 107 sub rescale {
 108   no locale;
 109   my ($name,$out_dir,$maxsize,$info) = @_;
 110   my ($w,$h) = dim($info);
 111   if ($w<$maxsize && $h<$maxsize) {
 112         #picture is small enough to be used without rescaling
 113         return $name;
 114   }
 115   my $result = "$out_dir/$name";
 116   $result .= ".jpg" unless $result=~/\.jpe?g$/i;
 117   if ( ! -f $result || -M $name < -M $result) {
 118     print STDERR "  $out_dir...";
 119         my $scale;
 120         if ($w > $h) {
 121                 $scale = $maxsize*1.0/$w;
 122         } else {
 123                 $scale = $maxsize*1.0/$h;
 124         }
 125         my $ftype= $info->{file_media_type};
 126         die "Unknown image type for $name: $ftype\n"
 127                 if (not exists $decoders{$ftype});
 128         my $decoder=$decoders{$ftype};
 129     system "$decoder \"$name\" | pnmscale -xscale ". $scale . " -yscale " .
 130                 "$scale |cjpeg > $result";
 131     print STDERR "\b\b\b ";
 132   }
 133   return $result;
 134 }
 135
 136 sub make_comment_html {
 137   my $info = shift;
 138 my $comment = Encode::decode("koi8-r",ref($info->{"Comment"})?join("\n",@{$info->{"Comment"}}):$info->{"Comment"});
 139         $comment =~s/\&/&amp;/;
 140         $comment =~s/"/&quot;/;
 141         $comment =~s/>/&gt;/;
 142         $comment =~s/</&lt;/;
 143         return $comment;
 144 }
 145
 146 sub make_html {
 147         my $imgfile = shift;
 148         my $info = shift;
 149         my $comment = shift;
 150         my $inline = shift;
 151         open HTML, ">", "$imgfile.html";
 152         my ($w,$h) = dim($info);
 153         my ($w1,$h1) = dim(image_info(INLINEDIR."/".$imgfile));
 154         print HTML "<html><head><title>$dir:$imgfile</title></head><body>
 155 <h2>$dir</h2>",($opt_f?"":"<h1>$imgfile</h1>"),(defined($info->{'DateTime'})?"<p
 156 class=\"timestamp\">Time: $info->{'DateTime'}</p>":""),"<p>$comment</p>",
 157 "<img src=\"".$inline."\" width=$w1 height=$h1>",
 158 "<br clear=all><hr>
 159
 160 <hr>
 161 <table width=100%><tr><td align=left>
 162 ",($prev?"<a href=\"$prev.html\">&lt;&lt</a>":"&nbsp;"),
 163 "</td><td align=center><a href=\".\">Up</A></td><td align=right>\n",
 164 ,($next?"<a href=\"$next.html\">&gt;&gt</a>":"&nbsp;"),
 165 "</td></tr></table>\n",
 166 ($opt_l?"":"<a href=\"$imgfile\">$imgfile ($w x $h)</a>"),"
 167 </body></html>
 168 ";
 169 close HTML;
 170 }
 171
 172 sub fix_html {
 173         my $imgfile = shift;
 174         unlink "$imgfile.html";
 175         make_html($imgfile);
 176 }