#!/usr/bin/env perl
use Getopt::Std;
use integer;
require 'ctime.pl';

# Options #############################################################
# -h ................ pipe man page to less (and exit).
# -H ................ print man page without using less.
# -v ................ print version number and exit.
# -e ................ echo each file/directory read to standard output.  
# -o outfile ........ print listing of files to outfile instead of 
#                     lslist.html
# -s ................ simple titles (just put the name of the current
#                     directory in the title of the listing)
# -t titledir ....... use titledir instead of ~dir as the name of the
#                     top directory in the title of each HTML listing
# -w width .......... set the first column of each listing to be width
#                     characters wide (default is 42 columns)
# Process Options #####################################################
getopts('hHveo:st:w:');
$opt_v  && do { print "Htmlls: version 1.3 [1999/07/05]\n";exit;};   
$opt_h  && do { system("htmlls -H |less"); exit; };   
                              # Help! Pipe man page to less.
$opt_H  && do { write;exit;}; # Help! Print man page without using less.
$lslist = ($opt_o) ? $opt_o : "lslist.html";
$width = ($opt_w) ? $opt_w : 42;
$dir = (@ARGV) ? shift(@ARGV) : '.';
chdir $dir;
$titledir = ($opt_t) ? $opt_t : "~".&dir;
#######################################################################
$date = &ctime(time);
&dodir($titledir);
#######################################################################
sub dir {
    chomp(my $dir = `pwd`);
    $dir =~ s#.*/##;
    return $dir;
}
sub dofile {
    my($name, $filetype) = @_;
    if ($filetype eq "d") {
        print LSLIST "<a href=\"$name$lslist\">$name</a>\n";
    } elsif (-l $name) {
        print LSLIST defined($where = readlink($name))
                        ? ((-d $where) 
                            ? "<a href=\"$where/$lslist\">$name</a> -> $where\n"
                            : "<a href=\"$where\">$name</a> -> $where\n")
                        : "$name\@ (broken link)\n";
    } else {
        print LSLIST "<a href=\"$name\">$name</a> ".
                     ("." x ($width - length($name)));
        my ($size, $modtime) = (stat($name))[7,9];
        ($size <1000) 
            ? do { $size .= "  b";}
            : ($size <1000000) 
                ? do { $size /= 1000; $size .= " kb";}
                : ($size <1000000000)
                    ? do { $size /= 1000000; $size .= " Mb";}
                    : do { $size /= 1000000000; $size .= " Gb";};
        print LSLIST ("." x (6 - length($size)))." $size";
        $modtime = &ctime($modtime);
        print LSLIST " .. $modtime";
    }
    print "$name\n" if $opt_e;
}
sub dodir{
    local($dir,$nlink) = @_;
    local($dev,$ino,$mode,$subcount);
    local(%subdir) = ();
    local(%tail) = ();
    # At top level we need to find nlink ourselves.
    ($dev,$ino,$mode,$nlink) = stat('.') 
         unless ($hasparent = defined($nlink));
    # Get the list of files in current directory.
    opendir(DIR,'.') || die "Can't open $dir: $!\n";
    local(@filenames) = sort(readdir(DIR));
    closedir(DIR);
    open(LSLIST,">$lslist");
    $title = ($opt_s) ? &dir() : "Listing of $dir as at $date";
    &writefile("LSLIST_HEAD",LSLIST);
    &dofile("../", "d") if $hasparent;
    if ($nlink == 2) {       # This dir has no subdirectories.
       for (@filenames) {
           next if $_ eq '.';
           next if $_ eq '..';
           next if $_ eq $lslist;
           &dofile($_, "f");
       }
    } else {                 # This dir has subdirectories.
       $subcount = $nlink - 2;
       for (@filenames) {
           next if $_ eq '.';
           next if $_ eq '..';
           next if $_ eq $lslist;
           $name = "$dir/$_";
           do { &dofile($_, "f"); next; } if $subcount == 0;
                             # Once subcount is 0 remaining
                             # filenames are all files ...
                             # no subdirectories left.
           # If we are still going ... we get the link count
           # to check current array element is a directory.
           ($dev,$ino,$mode,$nlink) = lstat($_);
           do { &dofile($_, "f"); next; } unless -d _;
                             # If we exit here, it was a file.
           # If we are still going current array element is a 
           # directory.
           &dofile("$_/", "d");
           $tail{$name} = $_;
           $subdir{$name} = $nlink; # We will recurse to these later
       }
    }
    &writefile("LSLIST_END",LSLIST);
    close(LSLIST);
    system("chmod a+r $lslist");
    print "Wrote: $dir/$lslist\n";
    while (($name, $nlink) = each(%subdir)) {
       chdir $tail{$name} || die "Can't cd to $name: $!\n";
       &dodir("$name",$nlink);
       chdir '..';
       --$subcount;
    }
}
sub writefile {
    my($format, $FILEH) = @_;
    select($FILEH);
    $~ = $format; write($FILEH);
    select(STDOUT);
}
# Formats ############################################################
format LSLIST_HEAD =
<!DOCTYPE HTML PUBLIC "-//Netscape Comm. Corp.//DTD HTML//EN">
<HTML>
<HEAD>
 <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
 <TITLE>
@*
$title
 </TITLE>
</HEAD>
<BODY TEXT="#000000" BGCOLOR="#FFFFFF">
<H1>
@*
$title
</H1>
<pre>
.

format LSLIST_END =
</pre>
</BODY>
</HTML>
.
# Manpage ##############################################################
format STDOUT =
       htmlls - recursively create HTML contents lists of a directory

SYNOPSIS
       htmlls [-hHves] [-o outfile] [-t titledir] [-w width] [dir]

DESCRIPTION
       If called with the  -h  option htmlls pipes  this  manpage
       to less.  With the -H option this manpage is printed with-
       out piping through less. The -v option  prints the version 
       number. 
       
       Otherwise,  htmlls compiles listings in HTML format of dir
       and any subdirectories of dir.  If dir is omitted the cur-
       rent directory  is assumed.  Htmlls  recursively  descends 
       through subdirectories if necessary, compiling lslist.html 
       files  in each  subdirectory,  each of which is linked to, 
       from their parent directories. Each listing may be printed
       to the user's choice of outfile instead of lslist.html  by
       using the  -o  option.  Each listing contains a title with 
       the name of the current directory relative to the start or
       top directory  dir,  which is represented as ~dir,  unless
       altered via the -t option,  or the -s option.  Each  file/
       directory written to a  HTML listing is echoed to standard 
       output if the -e option is used.  The default width of the
       first colum of each listing is 42 characters wide; use the
       -w option to change this.

   OPTIONS
       -h     Print this man page, by piping to less.

       -H     Print this man page, but do not pipe to less.

       -v     Print version number and exit.

       -e     Echo each file/directory read to standard output, 
              as it is printed to lslist.html.

       -o outfile
              Direct output listing to outfile instead of 
              lslist.html.

       -s     Simple titles.  Use just the name of the directory
              being listed in the title.

       -t titledir
              Use titledir instead of ~dir as the name of the
              top directory in the title of each HTML listing.

       -w width
              Make the first column width characters wide. By
              default the first column is 42 characters wide.

ACKNOWLEDGEMENT
       The subroutine dodir is based on an example on pp56-57 of
       `Programming Perl' by Larry Wall  and  Randal L. Schwartz
       (1991).
       
CHANGES
       Version 1.0: 1999/05/13: First release.  

       Version 1.1: 1999/05/17: Added -s and -w options.

       Version 1.2: 1999/06/28: For symbolic links the HTML link
       now links to where the symbolic link points.

       Version 1.3: 1999/07/05: Now makes each lslist.html world
       readable.

BUGS
       htmlls is only known to work properly with Perl 5.004_04. 
       It may also work with versions as early as Perl 5.001.

AUTHOR
       Greg Gamble @<<<<<<<<<<<<<<<<<<<<<<<<<
"<gregg\@csee.uq.edu.au>"


VERSION 1.3                5 July 1999                         1
.