#!/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; }