#!/usr/bin/perl -w
#
# Name: dir2ndx.pl
# Param 1 : "DIR"
#
# lists DIR + sorts, writes to INDEX.HTML filename + size + date
# OS-undependent
#
# by Gerd Hoffmann (C)
#
# 081026, 081128, 081201, 081213, 081219, 090423, 110504
#
# todo: Directory in Listing als solches kennzeichnen
#	option to write errs to /var/log/messages or some file
#
#

# # #   begin main
#
#

use strict;
use warnings;
use Cwd;
use File::Find;
use Getopt::Std;


my ( $OS, $dir_separator ) ;
# from Modul: Config
unless ($OS) {
  unless ($OS = $^O) {
	eval { use Config } ;
    $OS = $Config::Config{'osname'};
  }
}
if ($OS=~/Win/i) {
  $dir_separator = '\\';
} elsif ($OS=~/vms/i) {
  $dir_separator = '/';
} elsif ($OS=~/bsdos/i) {
  $dir_separator = '/';
} elsif ($OS=~/dos/i) {
  $dir_separator = '\\';
} elsif ($OS=~/^MacOS$/i) {
  $dir_separator = ':';
} elsif ($OS=~/os2/i) {
  $dir_separator = '\\';
} else {
  $dir_separator = '/';
}


#################################################
#      !!!    Vars to cstomize     !!!
#################################################
#
my $Author = "Gerd Hoffmann" ;
# webroot: root of the website. 
# Under Linux there is expected a link to the appropriate Image directory 
# Under windows ???
my $webroot = "/";
my $Icons = "Images";             # IconPath
my $IconBlank = "${webroot}$Icons${dir_separator}blank.gif" ;
my $IconGeneric = "${webroot}$Icons${dir_separator}generic.gif" ;
my $IconFolder = "${webroot}$Icons${dir_separator}folder.gif" ;
my $IconUp = "${webroot}$Icons${dir_separator}up.gif" ;
my $IconBack = "${webroot}$Icons${dir_separator}back.gif" 			;
#my $Home = "home.html";        # parent file == back file == home file
my $get_format = 1;		# get background etc. from css-file
my $no_robots = 1;
my $Format = "formate.css";   # CSS-File
my $FormatPath = "/";         # should end with slash !
my $Index = "index.html";      # File to create
my $Parent = "../" . $Index ;
my $Title ="Index";
#
#################################################

# code
# Vars
$main::VERSION = "0.1rc11p" ;	#  displayed by option -V or --version
our ($opt_r,$opt_a,$opt_w,$opt_s,$opt_d,$opt_h,$opt_V); # needed because of pragma strict
my ( $usage, @filelist, @dirlist );
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime();
$year += 1900;
$mon += 1;
my $Year = $year;
# my $Modified = "$year-$mon-${mday}, $hour:$min:$sec MEZ";
my $Modified = sprintf("%d-%02d-%02d, %02d:%02d:%02d MEZ", $year, $mon, ${mday}, $hour, $min, $sec) ;
my $recursive = 0 ;
# my $debug = 0;  #  debug-mode: 0, 1, 2
# $path_description: header of the index-list, used in PrintIndexHead(), 
# can be changed by commandline
my $path_description = "./" ;  
my $startdir = cwd ;  # where to start indexing from

getopts('raw:s:d:hV') or die "Illegal option!\n\n&HELP_MESSAGE()";
$opt_r and $recursive = 1 ;
$opt_a and $no_robots = 0 ;
$opt_w and $webroot = $opt_w ;
$opt_s and $startdir = $opt_s ;
die "$startdir does not exist, $!\n\n&HELP_MESSAGE()" unless ( -d $startdir ) ;
#die "$startdir does not exist, $!\n\n&$usage" unless ( -d $startdir ) ;
$opt_d and $path_description = $opt_d;
$opt_h and &HELP_MESSAGE();
$opt_V and print "Version: $main::VERSION\n" and exit ;

if ( $recursive ) { 
	find ( \&WriteIndices, $startdir ) ; 
}
else {
	ReadFilesFromDir( $startdir );
	WriteIndexOfDir( $startdir );
}
#
#
# # #   end main


################################
# HELP_MESSAGE()
#
sub HELP_MESSAGE() {	#  called by option -h or --help
	my $source = cwd ;
	print "\nusage: perl dir2ndx.pl [-s <startdir>] [-d <path description>]\n" .
	"\t[-w <webroot>] [-a] [-r] [-V] [-h] [--help] [--version]\n\n";
	print "\t-s startdir, source (default: $source)\n" . 
			"\t-d path description in Index-header (default: ./)\n" .
			"\t-w root in web, dir of formate.css, Images-dir (default: /)\n" .
			"\t-a robots allowed (no_follow, no_index is default)\n" .
			"\t-r recursive\n\t-h help, usage\n\t-V version\n\n";
	exit;
}
#$usage = \&HELP_MESSAGE() ;



################################
# WriteIndices()
#
sub WriteIndices {
	return unless ( -d $File::Find::name ) ;
	ReadFilesFromDir( $File::Find::name );
	WriteIndexOfDir(  $File::Find::name );
}
################################


################################
# ReadFilesFromDir()
#
sub ReadFilesFromDir {
	my ( $dir ) = @_ ;
	@filelist = () ;
	opendir(IN, "$dir" ) || die "no \"$dir\"?, $!";
	foreach  my $fname (sort (readdir(IN)) ) {
		if ( ($fname =~ /^\.\.?.*/ ) ||( $fname =~ $Index ) ) { next } ;
#		if ( ($fname =~ /^\.\.?$/ ) || ($fname =~ /^\..+$/ ) ||( $fname =~ $Index ) ) { next } ;
#		if ( ($fname =~ /^\.\.?$/ ) ||( $fname =~ $Index ) ) { next } ;
		@filelist = ( @filelist, $fname );
	}
	closedir(IN);
}


################################
# WriteIndexOfDir()
# creates index-file, 
# for each file/dir is written a line into the index-file
#
sub WriteIndexOfDir {
	my ( $dir ) = @_ ;
	# $description provided for future extension, suitable module not yet programmed
	my ( $i, $fname, $filename, $size, $date, $Sizes, $Count, $mtime, $description, $IsDir );
	my ( $sec, $min, $hour, $mday, $mon, $year ) = ();
	$description=" ";

	open(OUT, ">$dir$dir_separator$Index") || die "Cannot open ${dir}$dir_separator${Index}! Abbruch !, $!\n" ;
	PrintIndexHead( $dir );

	$Count = 0;
	$Sizes = 0; 
	foreach $fname ( @filelist ) {
		$IsDir = 0 ;
		$filename = "$dir$dir_separator$fname" ;  # ?????  path ???????? $dir ???    wrong !
		($size, $mtime) = ( stat( $filename ) )[7,9];
		($sec, $min, $hour, $mday, $mon, $year) = localtime($mtime);
		$date = sprintf ( "%02i.%02i.%04i %02i:%02i\n", $mday, $mon+1, $year+1900, $hour, $min ) ;
		if (-d $filename) { $size = "-"; $IsDir = 1 ; }  else { $Sizes += $size ; } 
		PrintIndexRow( $fname, $date, $size, $description, $IsDir );
		++$Count;   
	}
	PrintIndexBottom( $Count, $Sizes ) ;
}


################################
# PrintIndexHead()
# extracts the part of path deeper than startdir, prints $showdir
# writes header of table
#
sub PrintIndexHead {
	my ( $dir ) = @_ ;
	my $str = $dir ;
	my ($get_format_meta, $no_robots_meta ) = ( " ", " " ) ;
	$str =~ m#^${startdir}(.*)# ; # $1 gets the rest of the path without startdir
	my	$showdir = $path_description . ($1?"/$1":"") ;
	$showdir = remove_multiple__slash($showdir);
	if ( $get_format == 1 ) {
		$get_format_meta = "<!-- ... Link !  ... -->" .
		"<link rel=\"stylesheet\" media=\"all\" href=\"$FormatPath$Format\">"
	}
	if( $no_robots) {
		$no_robots_meta = '<!-- <meta name="robots" content="noindex,nofollow"> -->' ;
	}


	print OUT <<IndexFirst;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<!-- <meta name="GENERATOR" content="\$ThisFile"> -->
<meta name="Author" content="$Author">
<meta name="date" content="$Modified">
$no_robots_meta
<!-- <meta name="keywords" lang="en" content="Index"> -->
<meta http-equiv="content-type" content="text/html; charset=ISO-8859-1">
<!-- <meta http-equiv="Content-Script-Type" content="text/javascript"> -->
<!-- <meta http-equiv="Content-Style-Type" content="text/css"> -->
$get_format_meta
<title>$Title</title>
</head>

<body style="font-size:small">
<p style="font-size:x-large; font-weight:bold;"><a name= "Top"> Index of $showdir</a>
</p>
<p>
<table cellpadding="0" cellspacing="5" border="0">
<tr>
<td align="left" valign="middle"><a href="$Parent"><img src="$IconBack" alt="Icon " border=0 ></td>
<td align="left" valign="middle"><a href="$Parent">Parent Directory</a></td>
</tr>
</table>
<hr>
</p>

<p>
<!-- <table width="96%" cellpadding="2" cellspacing="0" border="0"> -->
<table cellpadding="1" cellspacing="0" border="0">
   <tr>
   <th align="left" valign="middle"><img src="$IconBlank" alt="Icon "></th>
   <th align="left" valign="middle">File-Name</th>
<!--   <th align="left">Size&nbsp;&nbsp;Dir</th>  -->
   <th align="left" valign="middle">&nbsp;&nbsp;Last Modified</th>
   <th align="left" valign="middle">&nbsp;&nbsp;Size</th>
   <th align="left" valign="middle">&nbsp;&nbsp;Description</th>
   </tr>
IndexFirst
# Ende HERE-Dokument
}


################################
# PrintIndexRow()
#
sub PrintIndexRow {
#my $CutName = substr( $FileName, 0, 14 );
	my ( $FileName, $FileDate, $FileSize, $FileDescription, $IsDir ) = @_ ;
	my ( $altDir, $link ) = () ;

#	if( $IsDir ) { $IsDir = "folder.gif" ; $altDir = "DIR " ; }
	if( $IsDir ) { $IsDir = "$IconFolder" ; $altDir = "DIR " ; $link = $FileName . $dir_separator . $Index ; }
	else { $IsDir = "$IconGeneric" ; $altDir = "file" ; $link = $FileName ; }
	print OUT <<IndexRow;
   <tr>
   <td align="left" valign="middle"><a href="$link" /a><img border=0 src="$IsDir" alt="$altDir" /img></td>
   <td align="left" valign="middle"><a href="$link">$FileName</a></td>
   <td align="left" valign="middle">&nbsp;&nbsp;$FileDate</td>
   <td align="center" valign="middle">&nbsp;&nbsp;${FileSize}</td>
   <td align="left" valign="middle">&nbsp;&nbsp;$FileDescription</td>
   </tr>
IndexRow
# Ende HERE-Dokument
#   <td align="left" valign="top"><a href="$FileName">$CutName</a></td>
}


################################
# PrintIndexBottom()
#
sub PrintIndexBottom {
my ( $Count, $Sizes ) = @_ ;

	print OUT <<IndexLast;
</table>
<p>
$Count Files with total size of $Sizes Bytes
<br><br></p>

<p>
<hr>
<table width="100%" cellpadding="0" cellspacing="5" border="0">
<tr>
<td align="left" valign="middle"><a href="#Top" /a><img src="$IconUp" alt="top" border=0 /img> top</td>
<td align="right" valign="middle">(C)opyright by $Author $Year</td>
<!-- <td><a href="\${relPath}\$Back">back</a></td> -->
</tr>
<tr>
<td align="right" valign="middle">Last change at $Modified</td>
</tr>
</table>
<br><br>
</p>

</body>
</html>
IndexLast
# Ende HERE-Dokument
}


################################
# push_slash()
#
#
sub push_slash {
	my ($str) = (@_) ;
	if( $str =~ m#.*[^/]$# ) { return($str .= "/");  }
	return($str);
}
################################


################################
# remove_multiple_slash()
#
#
sub remove_multiple__slash {
	my ($str) = (@_) ;
	$str =~ s#//+#/#g ;
#	return ( $str =~ s#//#/#g ) ;
#	if( $str =~ s#//#/#g ) { return( $str = "/" . $str );  }
	return($str);
}
################################


################################
# unshift_slash()
#
#
sub unshift_slash {
	my ($str) = (@_) ;
	if( $str =~ m#^[^/].*# ) { return( $str = "/" . $str );  }
	return($str);
}
################################


__END__


################################
# pop_slash()
#
#
sub pop_slash {
	my ($str) = (@_) ;
#	if( $str =~ m#^\./$# ) { return("$str");  }
	if( $str =~ m#(.*)/$# ) { return("$1");  }
	return($str);
}
################################


################################
# ltrim()
#
sub ltrim {
   $_[0] =~ /^\s*(.*?)$/ ;
   return ( $1 );
}


################################
# rtrim()
#
sub rtrim {
   $_[0] =~ /^(.*?)\s*$/ ;
   return ( $1 );
}


################################
# rpad()
#
sub rpad {
   return ( $_[0] . " " x ( $_[1] - length( $_[0] )) );
}


# fits filenames, changes forbidden letters
#sub fitfilename {
#   my $fname = $_[0] ;;  
#   $fname =~ s/Ä/AE/g ;
#   $fname =~ s/ä/ae/g ;
#   $fname =~ s/Ö/OE/g ;
#   $fname =~ s/ö/oe/g ;
#   $fname =~ s/Ü/UE/g ;
#   $fname =~ s/ü/ue/g ;
#   $fname =~ s/ß/ss/g ;
#   $fname =~ s/[\s\$!~+'`´#&]/_/g ; # no err   
#   return $fname ;
#}

#-------------------------------------------------------

my $startdir_isdefined = 0 ;
# path-description is only shown in the header of the index-file, 
# should be the path from webroot to cwd
my $path_description_isdefined = 0 ;
foreach my $opt ( @ARGV ) {
	my $str ; 

	if ( $opt =~ /^-+(.*)/i ) {		# is it an option?
		$str = $1 ;
		if ( $str =~ /^h/i ) {			# help
			usage(); 
			exit;
		}
		elsif ( $str =~ /^s/i ) {		# single directory
			$recursive = 0;
		}
		elsif ( $str =~ /^r/i ) {		# no robots
			$no_robots = 0;
		}
#		elsif ( $str =~ /^w/i ) {
#			$webroot = "";  # wie pfad zuweisen? ist naechster param ! shift?
#		}
		else { warn "wrong option: $opt\n"; usage() ; exit() ; }
	}
	else {                          # is it a directory?
		if ( defined $opt && ( -d $opt ) && ! $startdir_isdefined && ! $path_description_isdefined ) { 
			$startdir = $opt ;        # directory to be indexed
			$startdir_isdefined = 1 ;
		}
		elsif ( $startdir_isdefined && ! $path_description_isdefined ) { 
			$path_description = $opt ;    # path shown on the head of the index-list
#			$path_description = push_slash($path_description);  # slash ends string?
			$path_description_isdefined = 1 ;
		}
		else { warn "srcdir does not exist or path_description not defined $!\n" ; usage() ; exit() ; }
	}
}

	print "usage: perl dir2ndx.pl [start-path] [-p] [-s] [-r] [-h]\n" .
			"		-p shown path in header\n" .
			"		-h help, -s  single directory (not recusivly)\n" .
			"		-r robots allowed to follow and to index site\n" ;