$title

#!/usr/bin/perl my $rcsid = '$Id: log2html,v 2.2 2008/04/24 22:25:06 vogelke Exp $'; =head1 NAME log2html =head1 SYNOPSIS log2html [-v] file =head1 DESCRIPTION log2html reads a LOG file (created by remark) and writes the HTML equivalent to stdout. =head1 OPTIONS -v prints the version and exits. =head1 AUTHOR Karl Vogel Sumaria Systems, Inc. =cut # To generate manpage: # pod2man -c 'User docs' -r "`date`" -d version log2html #--------------------------------------------------------------------- use strict; use warnings; use subs qw(arpadate h3 prep subject usage version); use File::Basename; use Regexp::Common qw /URI/; my $gotbegin; # read BEGIN line yet? my $gotdated; # read dated entry yet? my $myname; # script basename. my $preformat; # found a

 line?
my $wasdated;    # was the previous line a dated entry?

$myname = basename ($0, ".pl");

# Get args:
my $logfile = '';

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

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

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

    $logfile = $_;
}

# If anything is coming in via STDIN,
# use it.  If not, try the $logfile.

if (-f STDIN || -p STDIN) {
    open (F, "<&STDIN");
} else {
    open (F, "$logfile") || die "$logfile: can't read: $!\n";
}

#
# Main loop.
#

$gotbegin = 0;
$gotdated = 0;
$wasdated = 0;
$preformat = 0;

TOP: while () {
    $_ = prep ($_);

    # section header
    /^BEGINNING OF LOG FOR\s+(.*)\s+==*$/ and do {
        if ($gotbegin == 0) {
            htmltop ($1);
            subject ($1);
        } else {
            print "\n";
            subject ($1);
            print "\n";
        }

        $gotbegin++;
        $wasdated = 0;
        next TOP;
    };

    # begin dated entry
    /^[0-9A-Z]/ and do {
        s/  /\ \ \ /g;
        print "\n" if $gotdated;
        h3 ($_);
        $gotdated++;
        $wasdated = 1;
        next TOP;
    };

    # preformatted section; leave it alone except
    # for command line prompts "me%" and "root#".

    /---------S$/ and do {
        print "\n";
        while () {
            $_ = prep ($_);
            s!^  !!;
            s!me\%!me%!;
            s!user\%!user%!;
            s!root#!root#!;

            last if /---------E$/;
            print "$_\n";
        }
        print "\n";
        next TOP;
    };

    # row of dashes.

    /^\s*\-\-\-\-+\s*$/ and do {
        print "\n";
        next TOP;
    };

    /^$/ and do {
        print "\n";
        next TOP;
    };

    # let blockquote take care of indent, but keep
    # two spaces after periods.

    s!^\s*!!g;
    s!\.  !.\ \ !g;

    print "$_\n";
}

htmlbot();
exit (0);

#---------------------------------------------------------------------
# Start a new web page, including style sheet.

sub htmltop
{
    my ($title) = @_;

    print <

$title



EOH
}

#---------------------------------------------------------------------
# Finish web page.

sub htmlbot
{
    my ($title) = @_;
    $_ = version();
    my ($name, $v) = split;
    my $date = arpadate();

    print <



Created by $name $v
$date




EOH
}

#---------------------------------------------------------------------
# Headers.

sub subject
{
    my ($s) = @_;
    print "$s\n";
}

sub h3
{
    my ($s) = @_;
    print "\ \  $s\n";
    print "\n";
}

#---------------------------------------------------------------------
# Prepare string by expanding tabs, etc.

sub prep
{
    local($_) = shift;
    chomp;
    1 while s/\t+/' ' x (length($&) * 5 - length($`) % 5)/e;

    # Special characters?
    s!\&!\&!g;
    s!!\>!g;

    # Test for lines containing only URIs.
    my $addbr = 0;
    /^\s*$RE{URI}{HTTP}\s*$/ and $addbr = 1;

    # URIs?
    # FIXME: use common regexes for this?

    s#\[URL:(.*)\]#$1#g;  # embedded URL
    s#(http://\S+)#$1#g;
    s#(https://\S+)#$1#g;
    s#(ftp://\S+)#$1#g;

    # Add breaks after lines containing only URIs.
    $addbr and $_ .= '
';

    return $_;
}

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

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

    require Pod::Usage;
    import Pod::Usage qw(pod2usage);
    warn "$emsg\n";
    pod2usage(-verbose => 1);
}

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

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

#---------------------------------------------------------------------
# Accept a date in total seconds since the epoch, and write it
# in ARPA-mail standard form:
#       Fri, 28 Mar 1997 15:40:57 -0500

sub arpadate
{
    require "timelocal.pl";
    my ($mday,$mon,$year,$wday);

    my $seconds = time();
    $[ = 0;
    my @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    my @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
        'Jul','Aug','Sep','Oct','Nov','Dec');

    # Figure out the timezone.
    my @zone = gmtime ($seconds);
    my $sec = &timelocal (@zone);
    my $tzmin = ($seconds - $sec) / 60;

    my $sign = "+";
    if ($tzmin < 0) {   # west of GMT
        $sign = "-";
        $tzmin = -$tzmin;
    }

    # Turn minutes into a recognizable offset from GMT.
    my $hr = sprintf ("%2.2d", int ($tzmin / 60));
    my $min = sprintf ("%2.2d", $tzmin % 60);
    my $offset = $sign . $hr . $min;      # like +0430 or -0500

    # Now create complete time string.
    ($sec,$min,$hr,$mday,$mon,$year,$wday,undef) = localtime ($seconds);
    $year += ($year < 70) ? 2000 : 1900;

    my $result = sprintf ("%s, %d %s %4d %2.2d:%2.2d:%2.2d %s",
        $DoW[$wday], $mday, $MoY[$mon], $year, $hr, $min, $sec,
        $offset);

    return $result;
}