#!/usr/bin/perl

my $rcsid = '$Id: tip2html,v 1.1 2004/06/17 21:11:30 vogelke Exp $';

=head1 NAME

 tip2html

=head1 SYNOPSIS

 tip2html [-m max] [-p pre] [-t title] file
 tip2html [-hv]

=head1 DESCRIPTION

 Read tip file in "chunks", write HTML output.
 Tip files are similar to LOG files, but lines starting in column 1
 are short section headers instead of timestamps.

=head1 OPTIONS

 -h        prints help and exits.
 -v        prints the version and exits.
 -t title  sets the HTML title.
 -m max    maximum number of lines in preformatted output before
           writing a "continued here..." link; default is unlimited.
 -p pfx    write preformatted data to files starting with "pfx".

=head1 AUTHOR

 Karl Vogel <vogelke@pobox.com>
 Sumaria Systems, Inc.

=cut

# To generate manpage:
#   pod2man -c 'User docs' -r "`date`" -d version tip2html

use strict;
use warnings;
use File::Basename;
use Date::Parse;
use Date::Format qw(time2str);

use subs qw/cend cstart endentry getchunk pranchor prep prfooter
            prheader prsec otherpages startentry usage version/;

$ENV{"PATH"} = "/bin:/usr/bin:/usr/local/bin";
my $myname = basename ($0, ".pl");

my $maxlines = 0;  # max lines allowed before continuation link.
my $prefix = '';   # prefix for storing preformatted output.

my $file = '';     # input file.
my $title = '';

#
# Handle any arguments.
#

ARG: while (@ARGV) {
    $_ = shift @ARGV;
    next ARG unless length;

    # Title.
    /^-t/ and do {
        $title = shift @ARGV || '';
	usage ("no title supplied") unless length ($title);
        next ARG;
    };

    # Max lines in preformatted output.
    /^-m/ and do {
        $maxlines = shift @ARGV || '';
	usage ("no max lines supplied") unless length ($maxlines);
	usage ("max lines must be a number")
	    unless $maxlines =~ m/^\d+$/;
	$maxlines = 0 unless $maxlines > 0;
        next ARG;
    };

    # Preformatted output stored in files.
    /^-p/ and do {
        $prefix = shift @ARGV || '';
	usage ("no prefix supplied") unless length ($prefix);
        next ARG;
    };

    # Version.
    /^-v/ and do {
        my $vers = version();
        warn "$vers\n";
        exit (0);
    };

    # Bad option.
    /^-.*/ and do {
        usage ("unrecognized option: [$_]");
    };

    # Non-option argument.
    if (length ($file) == 0) {
        $file = "$_";
    }
    else {
        usage ("extra arg: [$_]");
    }
}

usage ("need a file") unless length ($file);
open (F, "< $file") || die "$file: can't read: $!\n";

#
# Read LOG-style file, print page content.
#
# Timestamp for a log entry looks like this:
#    Wed,  10   Mar   2004   20:40:26
#    $day  $dom $mon  $yr    $hms
#

my ($section, @x);
my $en = 0;  # entry number
my %chunk;

while (%chunk = getchunk (*F))
{
    $_ = $chunk{'str'};

    # BEGIN line.  Print page header.

    if ($chunk{'type'} eq 'begin') {
        $title = $_;
        prheader();
        pranchor("top");
        otherpages();
        cstart();
    }

    # If we have a timestamp, and entries have been written,
    # close the current entry row.  Then open a new timestamp row.

    elsif ($chunk{'type'} eq 'section') {
	endentry() if $en > 0;
        $section = $_;
        $en++;
        prsec ($section, $en);
	startentry();
    }

    # Non-formatted portion of an entry.

    elsif ($chunk{'type'} eq 'entry') {
        print "     <p>\n";
        print "$_";
        print "     </p>\n";
    }

    # Preformatted portion of an entry.

    elsif ($chunk{'type'} eq 'pre') {
        print "     <pre>\n";
        print "$_";
        print "     </pre>\n";
    }
}

close (F);
endentry();
cend();

#
# Print page footer.
#

pranchor("bottom");
otherpages();
prfooter();
exit (0);

#---------------------------------------------------------------------
# Print a usage message from the comment header and exit.

sub usage
{
    my ($emsg) = @_;

    require Pod::Text;
    import Pod::Text;

    my $formatter = 'Pod::Text';
    my $parser = $formatter->new ();

    warn "$emsg\n";
    $parser->parse_from_file ($0);
    exit (1);
}

#---------------------------------------------------------------------
# Return the current version.

sub version
{
    $_ = $rcsid;
    s/,v / /;
    @_ = split;
    return "$_[1]  v$_[2]  $_[3] $_[4]";
}

#---------------------------------------------------------------------
# Print HTML header.

sub prheader
{
    print <<"PageHeader";
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 3.2//EN">
<html>
  <head>
    <title>$title</title>
    <style type="text/css" media="all">
body {
  line-height:     120%;
  color:           black;
  background:      white;
  font-weight:     normal;
  font-family:     sans-serif;
  font-style:      normal;
  text-decoration: none;
}

a:hover {
  color: blue;
  background-color: #eee;
}

a:active {
  color: red;
  background-color: yellow;
}

pre, code, tt {
  font-family: monospace;
  line-height: 100%;
  white-space: pre;
}

ol li {
  max-width: 75ex;
  padding: .1em;
}

h1#title {
  background-color: #eee;
  border-bottom: 1px solid black;
  padding: .25em;
}

address img {
  float: right;
  width: 88px;
}

address {
  padding-top:     .5em;
  padding-right:    1em;
  padding-left:     1em;
  padding-bottom:  .5em;
  margin-top:       3em;;
  border-top:       1px solid black;
  background-color: #eee;
  clear:            right;
}

h1 {
  font-family: Tahoma, Verdana, "Myriad Web", Syntax, sans-serif;
  font-size-adjust: .53;
  font-size: 2em;
  font-weight: bold;
  font-style: normal;
  text-decoration: none;
  color: #053188
}

h2 {
  font-family: Tahoma, Verdana, "Myriad Web", Syntax, sans-serif;
  font-size-adjust: .53;
  font-size: 1.75em;
  font-weight: 500;
  font-style: normal;
  text-decoration: none;
}

h3 {
  font-family: Tahoma, Verdana, "Myriad Web", Syntax, sans-serif;
  font-size-adjust: .53;
  font-size: 1.58em;
  font-weight: 500;
  font-style: italic;
  text-decoration: none;
}

h4 {
  font-family: Tahoma, Verdana, "Myriad Web", Syntax, sans-serif;
  font-size-adjust: .53;
  font-size: 1.33em;
  font-weight: 500;
  font-style: normal;
  text-decoration: none;
}

h5, dt {
  font-family: Tahoma, Verdana, "Myriad Web", Syntax, sans-serif;
  font-size-adjust: .53;
  font-size: 1.17em;
  font-weight: 500;
  font-style: normal;
  text-decoration: none;
  margin-top: 1em;
}
                
h6 {
  font-family: Tahoma, Verdana, "Myriad Web", Syntax, sans-serif;
  font-size-adjust: .53;
  font-size: 1em;
  font-weight: 500;
  font-style: normal;
  text-decoration: none;
}

pre {
  padding: 10px 1px 1px 1px;
  background: #f2f2f2
}
  </style>
  </head>

  <body bgcolor="#ffffff">
    <h3>$title</h3>
PageHeader

    1;
}

#---------------------------------------------------------------------
# Print HTML footer.

sub prfooter
{
    print <<"PageFooter";
    <br>
  </body>
</html>
PageFooter

    1;
}

#---------------------------------------------------------------------
# Print internal anchor.

sub pranchor
{
    my ($name) = @_;
    die "no anchor name given" unless length ($name);
    print "    <a name=\"$name\"></a>\n";
    1;
}

#---------------------------------------------------------------------
# Print pointers to other pages.

sub otherpages
{
    print << "OtherPages";
    <table border="0" width="100%" bgcolor="#006699" cellpadding="2"
      cellspacing="0">
      <tr>
        <td>
          <table bgcolor="#ffe4b5" width="100%" border="0"
              cellpadding="2" cellspacing="0">
            <tr align="left" valign="middle">
              <td>
              <a href="/">Home</a> |
              <a class="menubar" href="other.htm">Other Tips</a>
              </td>

              <td align="right" valign="middle">
                <form action="/cgi-bin/search.cgi" method="GET">
                  <input type="text" name="keywords" value="" size="10"
                  maxlength="50">
                  <input type="submit" value="Search" name="keywords">
                </form>
              </td>
            </tr>
          </table>
        </td>
      </tr>
    </table>

OtherPages

    1;
}

#---------------------------------------------------------------------
# Start content.

sub cstart
{
    print <<"StartContent";
    <!-- begin page content -->
    <p></p>
    <table cellpadding="10" cellspacing="10" border="0" width="100%">
StartContent

    1;
}

#---------------------------------------------------------------------
# End content.

sub cend
{
    print <<"EndContent";
    </table>
    <!-- end page content -->

EndContent

    1;
}

#---------------------------------------------------------------------
# Left field is the tip section plus entry pointers.
# The first field written has the "previous" entry pointing to
# the top, and the last one has the "next" entry pointing to
# the bottom.

sub prsec
{
    my ($section, $en) = @_;

    # $kn, $kp = next and previous numbers.
    # $sn, $sp, $sc = next, previous, and current name strings.

    my $fmt = "entry_%d";
    my $kn = $en + 1;
    my $kp = $en - 1;
    my ($sn, $sp, $sc);

    if ($kp <= 0) {
        $sp = 'top';
    } else {
        $sp = sprintf ($fmt, $kp);
    }

    $sn = sprintf ($fmt, $kn);
    $sc = sprintf ($fmt, $en);

    print <<"EndLeft";

    <tr>
     <td bgcolor="#ffe4b5" valign="top" width="30%">
     <a name="$sc"></a>
     <font size="-1">
     $section
     <br><br><br><i>
     <a href="#top">Top</a> &nbsp;
     <a href="#$sn">Next</a> &nbsp;
     <a href="#$sp">Prev</a> &nbsp;
     <a href="#bottom">End</a>
     </i>
     </font>
     </td>
EndLeft

    1;
}

#---------------------------------------------------------------------
# Right field is the log entry.

sub startentry
{
    print <<"StartRight";
     <td valign="top" width="70%">
StartRight

    1;
}

sub endentry
{
    print <<"EndRight";
     </td>
    </tr>
EndRight

    1;
}


# -------------------------------------------------------------------------
# Read file in chunks.

sub getchunk
{
    my $fh = shift;
    my %result = ();

    # No more records.
    return (%result) if eof($fh);

    # Skip leading blank lines.
    my $pat = '^\s*$';
    while (<$fh>) {
        last unless /$pat/;
    }

    # We've found a complete timestamp, or at least part of the
    # associated comment.  A chunk can be either a paragraph
    # from the comment, or a complete piece of preformatted text.

    if (/^BEGIN/) {
        $result{'type'} = 'begin';
	if (/BEGINNING OF LOG FOR (.*) ==+/) {
            $result{'str'} = $1;
	} else {
            $result{'str'} = $_;
	}
        $pat = '^\s*$';
    }

    elsif (/^\s+--+S$/) {
        $result{'type'} = 'pre';
        $result{'str'} = '';        # don't keep this string.
        $pat = '^\s+--+E$';
    }

    elsif (/^\s/) {
        $result{'type'} = 'entry';
        $result{'str'} = $_;
        $pat = '^\s*$';
    }

    else {
        $result{'type'} = 'section';
        $result{'str'} = $_;
        $pat = '^\s*$';
    }

    # Store strings until terminating pattern found.
    # Special strings like "root#" and "me%" indicate commands
    # where the entire line should be in bold.
    # Preformatted output can drop some leading spaces.

    while (<$fh>) {
        last if /$pat/;
        $_ = prep ($_);

	if (/\sroot#|\sme\%|\sme\$|^\s+\$ /) {
	    chomp;
	    s!^!<b>!;
	    s!$!</b>\n!;
	}

        $result{'str'} .= $_;
    }

    return (%result);
}

# -------------------------------------------------------------------------
# Prepare string by fixing special characters.

sub prep
{
    local($_) = shift;

    # Tabs?
    1 while s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;

    # Leading spaces?
    s/^\s\s\s\s//;

    # Special characters?
    s!\&!\&amp;!g;
    s!<!\&lt;!g;
    s!>!\&gt;!g;

    # URLs?
    s#(http://\S+)#<a href="$1">$1</a>#g;
    s#(https://\S+)#<a href="$1">$1</a>#g;
    s#(ftp://\S+)#<a href="$1">$1</a>#g;

    return $_;
}