#!/usr/bin/perl

### Conf

my $cache_dir = '/home/tommicat/public_html/cache';
my $cache_url = '/cache/';

my $file_dir = '/home/tommicat/public_html/gallery';
my $file_url = '/gallery/';

my $icondir  = '/home/tommicat/public_html/icons';
my $iconurl  = '/icons/';

my $thisurl  = '/~tommicat/gallery.cgi';
my $template = '/home/tommicat/public_html/gallery.tmpl';
my $spacer   = '/icons/space.gif';

my $debug   = 0; # debug messages 
my $rebuild = 0; # pretend the check failed
my $force_rebuild_files = 0; # rebuild EVERYTHING reguardless of status

my $thumbsize = 250;
my $columns   = 3;

### Bootstrap

use CGI;
use Digest::MD5 'md5_hex';
use HTML::Template;
use Image::Magick;
use Storable;
use strict;

my $cgi = new CGI 'all';

my $debug_message; # populated with the debug information if necessary
my %icons;         # index of icons for use if icons are necessary

my @months = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
my $now    = scalar localtime;

print $cgi->header;

# select files

my $work_dir  = $cgi->path_info || '/';
my $work_file = 'index.html';

if ( $work_dir =~ /^(.*)\/(.*\.html)$/ ) {
  $work_dir  = $1;
  $work_file = $2;
}

&debug(
  "File Selections:",
  $cgi->ul(
    $cgi->li('Cache Dir',$cache_dir),
    $cgi->li('Cache URL',$cache_url),
    $cgi->li('File Dir',$file_dir),
    $cgi->li('File URL',$file_url),
    $cgi->li('Work Dir',$work_dir),
    $cgi->li('Work File',$work_file)
  )
);

# MAIN

if ( $force_rebuild_files or $rebuild or not &check($work_dir,$work_file) ) { 
  &build_dirs;
  &build_files;
  &build_html;
}

&dump_html($work_dir,$work_file);

### Subs

=item build_dirs()

Build all of the necessary cache directories below this position

=cut

sub build_dirs {
  my @chain = split '/', $work_dir;
  my $root  = $cache_dir;

  for my $step ( @chain ) {
    $root = &url($root,$step);
    next if -d $root;
    &debug("Making directory $root");
    mkdir($root);
  }
}

=item build_files()

Rebuild the cache, thumbnails, and html for the current directory.

=cut

sub build_files {
  &debug($cgi->b("Rebuilding."));

  my $c_dir  = &url($cache_dir,$work_dir);
  my $c_file = &url($c_dir,$work_file);
  my $w_dir  = &url($file_dir,$work_dir);

  ### Synch and build files

  my %infiles; my %outfiles;
  map { $infiles{$_}++  } &read_dir($w_dir);
  map { $outfiles{$_}++ } &read_dir($c_dir);

  for my $file ( keys %infiles ) {
    if ( $outfiles{$file} > 0 && $outfiles{$file.'.db'} > 0 && not $force_rebuild_files ) {
      &debug("'$file' is OK"); ### Eventually should load and check mtimes
    } else {
      &debug($cgi->b("Building '$file'"));
      &build_item($file);
    }

    $outfiles{$file}--;
    $outfiles{$file.'.db'}--;
  }

  for my $file ( keys %outfiles ) {
    next unless $outfiles{$file} > 0;
    my $ret = unlink &url($c_dir,$file);
    &debug("'$file' needs to be deleted. Delete returned '$ret'");
  }

  # Checksum

  &debug('Marking Checksum');
  my $checksum  = &checksum($w_dir);
  my $checkfile = &url($c_dir,'check.'.$checksum);
  open  CHECKFILE, ">$checkfile";
  print CHECKFILE  $now;
  close CHECKFILE;
}

=item build_html

Build the output HTML files from the current data.

=cut

sub build_html {
  &debug('Writing HTML');

  my $c_dir = &url($cache_dir,$work_dir);
  my @files = &read_dir($c_dir);

  my $info = {};

  for my $file ( @files ) {
    next unless $file =~ /\.db$/;
    $info->{$file} = retrieve &url($c_dir,$file);
  }

  ###

  my $outfile = &url($c_dir,'index.html');
  &debug("Writing $outfile");

  my $title = 'FTP Index - '.&url($work_dir);
  my $body = $debug ? $debug_message . $cgi->hr : '';

  my @time_order = sort { 
                     $info->{$b}->{IS_DIR} <=> $info->{$a}->{IS_DIR}
                     or $info->{$b}->{MTIME} <=> $info->{$a}->{MTIME} 
                     or lc($a) cmp lc($b)
                   } keys %$info;
  my $rows = &table_rows(\@time_order,$info);
  my $link = &url($thisurl,$work_dir,'name.html');
  my $header = $cgi->Tr($cgi->td({-colspan=>($columns+2),-align=>'right'},
                 '[ Sort by Date |',$cgi->a({-href=>$link},'Sort by Name'),']'
               ));
  $body .= $cgi->table({-cellspacing=>5,-bgcolor=>'#999999'},$header,@$rows);
  &write_html($body,$title,$outfile);

  ###

  $outfile = &url($c_dir,'name.html');
  &debug("Writing $outfile");

  $body = $debug ? $debug_message . $cgi->hr : '';
  my @name_order = sort { 
                     $info->{$b}->{IS_DIR} <=> $info->{$a}->{IS_DIR}
                     or lc($a) cmp lc($b) 
                   } keys %$info;
  $rows = &table_rows(\@name_order,$info);
  $link = &url($thisurl,$work_dir,'index.html');
  $header = $cgi->Tr($cgi->td({-colspan=>($columns+2),-align=>'right'},
              '[', $cgi->a({-href=>$link},'Sort by Date'), '| Sort by Name ]'
            ));
  $body .= $cgi->table({-cellspacing=>5,-bgcolor=>'#999999'},$header,@$rows);
  &write_html($body,$title,$outfile);
}

=item build_item($file)

Given a file, make a thumbnail or return the icon and url.

=cut

sub build_item {
  my $file = shift @_;

  my $original  = &url($file_dir,$work_dir,$file);
  my $thumbnail = &url($cache_dir,$work_dir,$file);
  my $db        = $thumbnail . '.db';

  my $thumb_url = &url($cache_url,$work_dir,$file);
  my $file_url  = &url($file_url,$work_dir,$file);

  my @stat = stat $original;
  my $info = { 
    'FILE'  => $file,
    'MTIME' => $stat[9]
  };

  my $size = &clean_size($stat[7]);
  my $date = &clean_date($stat[9]);

  if ( &is_image($file) ) {
    my ($iconx, $icony, $x, $y) = &make_thumb($original,$thumbnail);

    $info->{DESC} = $cgi->a({-href=>$file_url},$file) . $cgi->br
                  . $cgi->font({-size=>'-1'},"($x x $y) - $size",$cgi->br,$date);
    $info->{IMAGE} = $cgi->a({-href=>$file_url},
                       $cgi->img({-width=>$iconx,-height=>$icony,
                                 -src=>$thumb_url,-border=>0})
                     );
    $info->{IS_DIR} = 0;

  } else {
    my ($url,$iconx,$icony) = &iconify($original);

    # Cheap directory hack!
    my $is_dir = -d $original ? 1 : 0;
    $file_url = &url($thisurl,$work_dir,$file) if $is_dir;

    $info->{IS_DIR} = $is_dir;
    $info->{IMAGE} = $cgi->a({-href=>$file_url},
                       $cgi->img({-width=>$iconx,-height=>$icony,
                                  -src=>$url,-border=>0})
                     );
    $info->{DESC} = $cgi->a({-href=>$file_url},$file)
                  . $cgi->br . $cgi->font({-size=>'-1'},
                      $is_dir ? '(directory)' 
                              : "(non-image file) $size".$cgi->br.$date
                    );
  }

  &debug("Writing $db");

  unlink $db if -f $db;
  return store $info, $db;
}

=item check($work_dir,$work_file)

Check to see if a rebuild is necessary.

=cut

sub check {
  my $work_dir  = shift @_;
  my $work_file = shift @_;

  my $c_dir  = &url($cache_dir,$work_dir);
  my $c_file = &url($c_dir,$work_file);
  my $w_dir  = &url($file_dir,$work_dir);

  # Check for the cache

  my $ret = -f $c_file;
  &debug("File check for $c_file returned '$ret'");
  return $ret unless $ret > 0;

  # Check the checksum

  my $checksum  = &checksum($w_dir);
  my $checkfile = &url($c_dir,'check.'.$checksum);
  $ret = -f $checkfile;
  &debug("Search for checksum file $checkfile returned '$ret'");
  return 0 unless $ret > 0;

  &debug("Checks passed.");
  return 1;
}

=item checksum($directory)

=cut

sub checksum {
  my $dir   = shift @_;
  my @files = &read_dir($dir);
  my @info;
  for my $file ( sort @files ) {  
    my @stat = stat &url($dir,$file);
    push @info, $file, $stat[7];
  }
  my $out = md5_hex(@info);
  &debug("Built checksum $out for directory $dir with ".scalar(@files).' files');
  return $out;
}

=item clean_date($seconds)

=cut

sub clean_date {
    my @time = localtime(shift @_);
    my $month = $months[$time[4]];
    my $year  = $time[5] + 1900;
    return "$month $time[3], $year";
}

=item clean_size($bytes)

### clean_size : returns a preety version of size given an input in bytes

=cut

sub clean_size {
  my $bytes = shift @_;
  my $out;

  if ($bytes < 1024) {
    $out = "$bytes bytes";
  } elsif ($bytes < 1024 * 1024) {
    $out = ( int( ( $bytes * 100 ) / ( 1024               ) ) / 100 ) . ' K';
  } elsif ($bytes < 1024 * 1024 * 1024) {
    $out = ( int( ( $bytes * 100 ) / ( 1024 * 1024        ) ) / 100 ) . ' Mb';
  } else {
    $out = ( int( ( $bytes * 100 ) / ( 1024 * 1024 * 1024 ) ) / 100 ) . ' Gb';
  }

  return $out;
}

=item debug(@messages)

Appends into to the debug message if debugging is turned on.

=cut

sub debug {
  return unless $debug;
  for my $message ( @_ ) {
    $debug_message .= $cgi->p($message);
  }
}

=item dump_html()

=cut

sub dump_html {
  my $work_dir  = shift @_;
  my $work_file = shift @_;

  my $file = &url($cache_dir,$work_dir,$work_file);
  &debug("Running out $file");

  if ( -f $file ) {
    open INFILE, $file;
    while ( my $line = <INFILE> ) { 
      print $line;
    }
    close INFILE;
  } else {
    print $cgi->p($cgi->b("$file does not exist"));
  }

  print $cgi->end_html;
}

=grab_icons

# This will be used later by the 'iconify' routine to post icons for
# non-image files. Rather than checking size on every pass, a single
# pass builds a handy reference hash and thus saves CPU cycles. Icons are
# named on extension keyed (IE the icon for mp3s is 'mp3.gif') Gifs only
# at the moment. They are the optimized icon size. Icons larger than
# default thumbnail sizes look really stupid but can be used.

=cut

sub grab_icons {
  my $icondir = shift @_;
  my %icons;

  foreach my $icon ( &read_dir($icondir) ) {
    next unless $icon =~ /\.gif$/i;
    my ($width,$height) = &image_size(&url($icondir,$icon));
    $icon =~ /^(.*)\.gif$/;
    $icons{$1}= [ $width,$height ];
  }

  &debug('Loading Icons: '.scalar(keys %icons).' icons found');

  return %icons;
}

=item iconify($file)

Returns a URL directory, height and width of the appropriate icon for
the submitted directory file.

=cut

sub iconify {
  my $file = shift @_;
  my $type = 'unknown';

  %icons = &grab_icons($icondir) unless %icons;

  if ( -d $file ) {
    $type = 'directory';
  } elsif ( $file =~ /\.(\w\w\w+)$/ ) {
    my $test = $1;
    $test =~ tr/A-Z/a-z/;
    $type = $test if $icons{$test};
  }

  &debug("Getting icon for $file which looks like type $type");

  return &url($iconurl,$type.'.gif'), @{ $icons{$type} };
  # previous line is an ugly form of: return ($icon,$width,$height)
}

=item image_size($file)

=cut 

sub image_size {
  my $file   = shift @_;
  my $image  = Image::Magick->new;
  my $ret    = $image->Read($file);
     warn      "$ret\n" if $ret;
  my $width  = $image->Get('width' );
  my $height = $image->Get('height');
  &debug("$file is $width x $height in size");
     return    ($width, $height);
}

=item is_image($file)

Based upon the filename, responds on weather the file is an image or not.

=cut

sub is_image {
  my $file = shift @_;
  if ( $file =~ /.bmp$/i || $file =~ /.gif$/i || $file =~ /.jpg$/i ||
       $file =~ /.png$/i || $file =~ /.psd$/i ) { 
    &debug("is_image: $file is an image.");
    return 1;
  } else { 
    &debug("is_image: $file is not an image.");
    return 0;
  }
}

=item make_thumb($infile,$thumbfile)

### Makes a thumbnail or uses existing. Returns 
(filex,filey,thumbx,thumby)

=cut

sub make_thumb {
  my $file      = shift @_;
  my $thumbfile = shift @_;

  my $image  = Image::Magick->new;
  my $ret    = $image->Read($file);
  my $width  = $image->Get('width' );
  my $height = $image->Get('height');

  if ($height > $thumbsize || $width > $thumbsize ) {
    if ($height > $width) {
      my $newwidth = int (($thumbsize / $height) * $width);
      $image->Scale(height=>$thumbsize,width=>$newwidth);
    } else {
      my $newheight = int (($thumbsize / $width) * $height);
      $image->Scale(height=>$newheight,width=>$thumbsize);
    }
  }

  my $new_width  = $image->Get('width' );
  my $new_height = $image->Get('height');

  $image->Write($thumbfile);

  &debug("Generated $thumbfile ( $new_width x $new_height )");

  return ($new_width, $new_height, $height, $width);
}

=item read_dir($dir)

Quickly reads a dir and returns the contents

=cut

sub read_dir {
  my $dir = shift @_;
  opendir READDIR, $dir;
  my @dir = grep !/^\.$/, grep !/^\.\.$/, readdir READDIR;
  closedir READDIR;
  return @dir;
}

=item table_rows($filearrayref,$infohashref)

Given an arrayref of filenames and the hasref $info construct, assemble 
the table rows for display and return them as an arrayref.

=cut

sub table_rows {
  my $order = shift @_;
  my $info  = shift @_;

  my $line = $cgi->Tr($cgi->td({-colspan=>($columns+2)},$cgi->hr({-noshade=>undef})));

  my $spacer_size = int($thumbsize/2) - 1;
  my $spacer_row  = 
       $cgi->Tr(
         $cgi->td('&nbsp;'),
         ( map { $cgi->td(
           $cgi->img({-src=>$spacer,-width=>1,-height=>1,-hspace=>$spacer_size})
         ) } (1 .. $columns) ),
         $cgi->td('&nbsp;')
       );
  my $spacer_cell = $cgi->td({-rowspan=>2},$cgi->img({-src=>$spacer,-width=>1,-height=>1,-vspace=>int($spacer_size/2)}));

  my @rows = ( $spacer_row, $line );
  while (@$order) {
    my @row1; my @row2;
    for ( 1 .. $columns ) {
      my $file = shift @$order || undef;
      push @row1, $cgi->td({-align=>'center'},$info->{$file}->{IMAGE} || '&nbsp;');
      push @row2, $cgi->td({-align=>'center'},$info->{$file}->{DESC}  || '&nbsp;');
    }
    push @rows, 
           $cgi->Tr({-valign=>'middle'},$spacer_cell,@row1,$spacer_cell),
           $cgi->Tr({-valign=>'top'},@row2),
           $line;
  }

  return \@rows;
}

=item url()

Takes an array of input and joins it with slashes '/' and then dedupes 
them.

=cut

sub url {
  my $url = join('/',@_);
  $url =~ s/\/+/\//g;
  return $url;
}

=item write_html()

=cut

sub write_html {
  my $body  = shift @_;
  my $title = shift @_;
  my $file  = shift @_;

  my $tmpl = new HTML::Template ( filename => $template );

  $tmpl->param(
     body  => $body,
     time  => "Generated $now",
     title => $title
  );

  open  HTML, ">$file";
  print HTML  $tmpl->output;
  close HTML;

}