#!/usr/bin/perl
##############################################################################
# File table generator v1.1
# makes table (in ASCII) of all files in the root dir and all subdirs
# (C) 1998 by Cyrille Artho, all rights reserved

if ($^O =~ /mac/i) { $slash = ":" }
else { $slash = "/" }                  # also works under Window~1

$dir = '/usr/local/htmlplain';         # directory where HTML PLAIN is installed

if (-e ".".$slash."config.pl") {
  require ".".$slash."config.pl";
  # prefer local config file
} else {
  require "$ENV{HOME}".$slash.".htmlplain".$slash."config.pl";
}

require "$dir".$slash."getargs.pl";
require "$dir".$slash."output.pl";
require "$dir".$slash."parsing.pl";
require "$dir".$slash."storage.pl";
require "$dir".$slash."variables.pl";
use File::Basename;
use File::Find;
use File::Copy;

# fix paths, if needed

my $startVar = $startPat; # startPat must be tag if this feature is used
$startVar =~ s/^<//;                   # startVar = tagname of startPat
$startVar =~ s/>$//;                   # remove < and >
$vars = { };                           # for <!-- foreach --> documents

$root =~ s/$slash$//;                  # no slash at the end
$outputPath =~ s/$slash$//;            # no slash at the end

my $root2;
#%files = { };
my @buffer;

if ($root =~ /\/$/) { chop $root; } # remove trailing / if any
$root2 = $root;
$root2 =~ s/[$slash]/\//g;
#if ($slash eq "\\") { $root2 =~ tr /\\/\//; } else { $root2 = $root; }
# have real slashes instead of other odd things

my $rootlevel = $root2 =~ tr !/!/!;        # number of '/' in root
 unless (open(OUTPUT, ">$fileTable")) {
    &error ("Could not open file $fileTable for writing: $!\n");
  }

find(\&checkFile, $root.$slash);

foreach $line (sort { $$a[3] <=> $$b[3] or $$a[1] cmp $$b[1]} @buffer) {
  # sort after content level first, then after name
  my $out = "";
  foreach $elt (@$line) {
    $out .= "$elt\t";
  }
  chop $out;
  print OUTPUT "$out\n";
} # print list sorted after last field (level); some pictures may appear between the sorted documents, but this does not matter
close OUTPUT;
exit 0;

# end of main

sub checkFile {
  return if (-d);                      # return if directory
  return if ($File::Find::name =~ /$exclude/io);
  local @current;
  if (/$filter/io) { &extractTitle($_); }
  elsif (/$imageFilter/io) { &imageFile($_); }
  elsif (/$binaries/io) {
    push @current, lcfirst($_);
    &nameAndSize;
    
    my $uploadfile = &uploadName($File::Find::name);
    unless (-e $uploadfile) {
      # upload file does not exist, help with symlink
      if ($verbose) {
	print "$uploadfile -> $File::Find::name\n";
      }
      if ($slash eq "/") {
	s_link($File::Find::name, $uploadfile);
      } else {
	print "copy $File::Find::name $uploadfile\n";
      }
  }
  }
  else { return; }
  unless ($foreach) {
    push @buffer, \@current;
  }
}

sub printLevel {
  my $full = $File::Find::name;
  $full =~ s/[$slash]/\//g;              # have again a pure version of the name
  my $level = $full =~ tr !/!/!;       # count number of slashes
  $level -= ($full =~ /\/index/);        # decrease by one if filename == index
  $level -= $rootlevel;
  push @current, $level;
}

sub nameAndSize { # print name and size of current file to output file
  unless ($foreach) {
    push @current, $File::Find::name;
  }
  my $size = -s $_;                    # filesize
  $size /= $sizeDiv;
  $size = int($size + 0.5);            # round
  $size .= " $sizeSuffix";             # e. g. size in KB
  push @current, $size;
}

sub extractTitle { # greps through file to extract the title information
  # arg1 = filename
  my $filename = shift @_;
  my $state = 0;                    # 0 = beginning, 1 = found, then quit
  my $out = "";
  my $line = 1;                     # line counter

  open (FILE, $filename) or &error ("Could not open file $filename: $!\n");
  # file is not read into buffer since title should be near beginning
  my $_old = $_;
  @lines = <FILE>;
  close FILE;

  $foreach = 0;
  # process html document
  foreach (@lines) {
    $line++;
    if ($state == 0) {
      next unless s/$startPat(.*)//io; # check for pattern and take the rest
      $_ = $1;                         # pattern found, strip text before start
      $state++;
    }
    if (s/(.*)$endPat//io) {           # end found, print everything before it
      $out .= "$1";
      last;
    }
    else { 
      $out .= "$_";                  # print line;
    }
  }
  $out =~ tr/\n\r//d;                # strip carriage returns
  $out =~ s/^\s+//;                  # trim whitespaces
  $out =~ s/\s+$//;
  if ($lines[0] =~ /<!--\s*foreach\s+(.*?)\s+/io) {
    $foreach = 1;
    # using foreach facility which uses document as template for multiple variable files
    my $glob = $1;
    # startVar must be specified as magic tag
#    unless ($startVar =~ /$variableNames/io) {
#      &error ("Starting tag $startTag is not defined as magic variable.", "If <!-- foreach --> is used, this definition has to be made.");
#    }
    # string <!-- foreach (filemask) ...
    my @files = <{$glob}>;
    my %var;
    my $title = $out;                  # use title from generating document
    foreach my $file (@files) {
      local @current; # make a "fresh" copy of that array for each iteration
      my $star = $glob;
      $star =~ s/\*/(.*)/;             # replace "*" with "(.*)"
      $file =~ /$star/;
      $star = $1;
      parseVariables($file, $vars);
      $globfile = $file;
      my $out = replaceVars($title);
      addEntry($out);
      push @current, ($star);
      push @buffer, \@current;
    }
  } else {                             # normal document: add entry to table    
    addEntry($out);
  }
}

sub addEntry {
  my $out = shift @_;
  if (exists($files{$out}) or (!$out)) {
    if ($foreach) {
      &warning ("Duplicate or no title ($startPat...$endPat) in file ".dirname($File::Find::name).$slash.$globfile." found.");
    } else {
      &warning ("Duplicate or no title ($startPat...$endPat) in file $File::Find::name found.");
    }
    my $cnt = 1;
    while (exists($files{"$out$cnt"})) {
      $cnt++;
    }
    &warning ("Using '$out$cnt' as identifier for that file.");
    $out .= $cnt;
  }
  push @current, $out;

  $files{$out} = 1;                    # use hash table for avoiding duplicates
  $_ = $_old;

  if ($foreach) {
    my ($name, $path, $suffix) = fileparse($File::Find::name, '\..*');
    my ($name2, $path2, $suffix2) = fileparse($globfile, '\..*');
    push @current, ($path.$name2.$suffix);
    # output file: use path and suffix from html document having foreach
    &nameAndSize;
    &printLevel;
    push @current, (dirname($File::Find::name).$slash.$globfile); # data file
    push @current, $File::Find::name;  # remember generating document
  } else {
    &nameAndSize;
    &printLevel;
  }
}

sub imageFile { # extracts image height and width from file
  # arg1 = filename
  my $filename = shift @_;
  my ($width, $height);
  my $uploadfile = &uploadName($File::Find::name);
  unless (-e $uploadfile) {
    # upload file does not exist, help with symlink
    if ($verbose) {
      print "$uploadfile -> $File::Find::name\n";
    }
    if ($slash eq "/") {
      s_link($File::Find::name, $uploadfile);
    } else {
      print "copy $File::Find::name $uploadfile\n";
      # the user has better install a real operating system
    }
  }
  $filename =~ /(\..*$)/;              # remove ending = everything after .
  my $suffix = $1;
  if ($suffix =~ /gif/i) {
    open (FILE, $filename) or &error ("Could not open file $filename: $!\n");
    binmode(FILE);                       # read in binary mode
    read(FILE, my $buff, 10);
    unless ($buff =~ s/^gif8..//i) {
      &warning("Could not figure out GIF format, trying with $imageIdentifier.\n");
    }
    ($width, $height) = unpack "v2", $buff;
  }
  unless ($width or $height) { 
    if (!(open IMG, "$imageIdentifier $filename |")) {
      &warning ("Problem with $imageIdentifier $filename:$!\n");
      ($height, $width) = (0, 0);
    }
    else {
      my $buff = <IMG>;                # read from pipe
      close IMG;
      chop $buff;                      # remove trailing \n
      $buff =~ s/.*?\s+//;             # parse output
      ($width, $height) = split /x/, $buff, 2;
      $height =~ s/\s+.*$//;
    }
  }
  $filename =~ s/(\..*$)//;            # remove ending = everything after .
  $filename = lcfirst($filename);      # make name lowercase

  if (exists($files{$filename})) {
    &warning ("Duplicate name ($filename) in file $File::Find::name.");
    my $cnt = 1;
    while (exists($files{"$filename$cnt"})) {
      $cnt++;
    }
    &warning ("Using '$filename$cnt' as identifier for that file.");
    $filename .= $cnt;
  }
  push @current, $filename;
  $files{$filename} = 1;
  close FILE;
  &nameAndSize;
  push @current, "$width"."x$height";
}

sub link_copy { # links or copies files, depending on procedure param. (action)
  my $action = shift;
  my $old = shift;
  my $new = shift;
  my $err = 0;
  unless (&$action($old, $new)) {
    $err = 1;
    if ($! =~ /No.*directory/i) {
      if (-d $old) {               # source is directory
	unless (mkdir $new,0777) { # create destination directory
	  &warning ("Could not create directory $new: $!");
	}
	$err = 0;
      } else {                         # source is some file
	unless (mkdir dirname($new),0777) { # create parent directory
	  &warning ("Could not create directory ",dirname($new),": $!");
	}
	if (&$action($old, $new)) { # symlink to old file
	  $err = 0;
	}
      }
    }
  }
  return $err;
}

sub s_link {
  my $old = shift @_;
  my $new = shift @_;
  $line = 0;

  if ($^O =~ /win/i) {                 # Windows solution
    if ($doCopy) {
      $action = \&copy;
      if (link_copy($action, $old, $new)) {
	&warning("Copy $old to $new failed: $!");
      }
    } else {
      print "copy $old $new\n";
    }
    return;
  }
  unless (symlink $old, $new) {
    $action = \&symln;
    if (link_copy($action, $old, $new)) {
      &warning("Could not link from $new to $old: $!");
    }
  }
}

sub symln {
  symlink(shift, shift);
}
