#!/usr/bin/perl -w

use Image::Size;
use Getopt::Std;
getopts('Ias:i:d:') or die "Usage: $0 [-a] [-D] [-I] [-s size] [-i indexpage] [-d dir]\n";
use vars qw($opt_a $opt_i $opt_d $opt_s $opt_D $opt_I);
$SIZE = $opt_s || 100;
$INDEX = $opt_i || "index%s.html";
$INDEX =~ s/%s/$SIZE/g;
$THUMBDIR = $opt_d || 'thumbs%s';
$THUMBDIR =~ s/%s/$SIZE/g;
$LIST_DIRS = $opt_D;
$INCREMENTAL = $opt_a;
$INDEX_ONLY = $opt_I;

if ($INDEX_ONLY && $INCREMENTAL) {
  die "-I incompatible with -a.\n";
}

unless (-d $THUMBDIR || mkdir $THUMBDIR, 0777) {
  die "Couldn't make thumbnail directory $THUMBDIR: $!\n";
}
tie %URL => URL_Encode;

%progs = ('gif' => 'giftopnm',
          'jpg' => 'djpeg',
          'jpeg' => 'djpeg',
          'pnm' => 'cat',
          'ppm' => 'cat',
          'pgm' => 'cat',
          'pbm' => 'cat',
          'png' => 'pngtopnm',
         );

{ my $mode = $INCREMENTAL ? '>>' : '>' ;
  my $add_line = ($INCREMENTAL && -e $INDEX);
  open INDEX, "$mode $INDEX"
      or die "Couldn't open index.html for writing: $!; aborting";
  print INDEX "\n<br>\n" if $add_line;
}

unless (@ARGV) {
  @ARGV = <STDIN>;
  chomp @ARGV;
}

for (sort byfiles @ARGV) {
  push @dirs, $_ if -d;
  next unless -f;
  my $thumb = thumbname($_);
  my ($x, $y) = imgsize($_);
  my ($nx, $ny);
  if ($INCREMENTAL) {
    my $thumb_time = -M "$THUMBDIR/$thumb";
    next if defined $thumb_time && -M $_ > $thumb_time;
  }
  unless (defined $x) {
    print STDERR "Couldn't determine image size for $_; skipping.\n";
    next;
  }
  if ($x == 0 || $y == 0) {
    print STDERR "Image $_ has zero size; skipping.\n";
    next;
  }
  if ($x > $y) {
    ($nx, $ny) = ($SIZE, int $y*$SIZE/$x);
  } else {
    ($nx, $ny) = (int $x*$SIZE/$y, $SIZE);
  }
  my ($suf) = (/\.([^.]*)$/);
  $suf = filetype($_) unless exists $progs{lc $suf};
  unless (defined $suf) {
    warn "Couldn't figure out file type for $_; skipping.\n";
    next;
  }
  my $prog = $progs{lc $suf};
                 
  unless ($INDEX_ONLY || -e "$THUMBDIR/\Q$thumb") {
    system("$prog \Q$_\E | pnmscale -xysize $nx $ny | cjpeg > $THUMBDIR/\Q$thumb\E");
  }
  
  print INDEX qq{<a href="$URL{$_}"><img border=0 width=$nx height=$ny src="$URL{$THUMBDIR}/$URL{$thumb}"></a>\n};
  print STDERR $_, "\n";
}

if ($LIST_DIRS) {
  for (@dirs) {
    print INDEX  qq{<a href="$URL{$_}">$_</a>\n};
  }
}

# sub thumbname {
#   my ($n) = @_;
#   my ($suf, $name) = split /\./, reverse $n, 2;
#   (reverse $name) . "T.jpg";
# }

sub thumbname { $_[0] }

sub byfiles {
  my @a = split /(\d+)/, $a;
  my @b = split /(\d+)/, $b;
  my $M = @a > @b ? @a : @b;
  my $res = 0;
  for (my $i = 0; $i < $M; $i++) {
    return -1 if ! defined $a[$i];
    return 1 if  ! defined $b[$i];
    if ($a[$i] =~ /\d/) {
      $res = $a[$i] <=> $b[$i];
    } else {
      $res = $a[$i] cmp $b[$i];
    }
    last if $res;
  }
  $res;
}

sub filetype {
  open TYPE, "file $_[0] |"
    or return;
  local $_ = <TYPE>;
  return 'jpg' if /JPEG/;
  return 'gif' if /GIF/;
  return 'ppm' if /PPM/;
  return 'pgm' if /PGM/;
  return 'pbm' if /PBM/;
  return;
}

package URL_Encode;

sub TIEHASH { my $x = "dummy"; bless \$x => __PACKAGE__ }
sub FETCH { my ($dummy, $url) = @_;
            $url =~ s/([\/\s\%\&\;\?])/'%' . sprintf("%2x", ord($1))/ge;
            $url;
          }



__END__

=head1 NAME

Sample - a sample script indicating the format of a single-file
script upload to CPAN

=head1 DESCRIPTION

This script does very little.

=head1 README

If there is any text in this section, it will be extracted into
a separate README file.

=head1 PREREQUISITES

This script requires the C<strict> module.  It also requires
C<Mail::Send 1.08>.

=head1 COREQUISITES

CGI

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

CPAN/Administrative
Fun/Educational

=cut