#!/usr/bin/perl -w
#<log2troff: make printable LOG file

use Getopt::Long;
use File::Basename;
use Carp;
use strict;
use diagnostics;

use subs qw/border manpage myuuid tab_expand usage version where/;
$ENV{'PATH'} = join ":", qw(/bin /usr/bin /usr/local/bin /opt/sfw/bin);

my $myname = basename($0);
$myname =~ s/\.\w*$//;   # strip any extension

my %options;
my @getopt_args = (
    'h|?',    # print usage
    'm',      # print manpage
    'u',      # print UUID
    'v',      # print version
    'w',      # print source location
    );

Getopt::Long::config("noignorecase", "bundling");
usage unless GetOptions(\%options, @getopt_args);

manpage if $options{'m'};
myuuid  if $options{'u'};
version if $options{'v'};
where   if $options{'w'};
usage   if $options{'h'};

#
# Read a LOG file.  Need to read twice because we need the
# first date found to form the top section number.
#

my $file = shift(@ARGV) || 'LOG';
my ($banner, $fh, $section, @a);
open($fh, "< $file") || die "$file: can't open: $!\n";

while (<$fh>) {
    chomp;
    s/\\/\\\\/g;    # Make sure backslashes print properly.

    # section header
    if (/^BEGINNING OF LOG FOR/) {
        s/=*//g;
        s/^BEGINNING OF LOG FOR //;
        $banner = $_;
    }

    # begin dated entry - see final pass for better notes
    elsif (/^[A-Z]/) {
        @a       = split;
        $section = $a[1] . '-' . $a[2] . '-' . $a[3];
        last;
    }

}
seek($fh, 0, 0);

#
# Final pass.  Write introduction, macros.  The Vb/Ve macro pair is
# used to write things that must appear exactly as printed.  In this
# example, the 5 lines shown would appear in Courier type, and they will
# NOT be broken across a page boundary.
#
#       .Vb 5
#       \&    This is line 1
#       \&    This is line 2
#       \&    This is line 3
#       \&    This is line 4
#       \&    This is line 5
#       .Ve
#
# Leaving off the argument will allow page breaks at any point.
#

print <<"EOF";
.de Vb
.ft CW
.nf
.na
.in 0
.if \\\\\$1 .ne \\\\\$1
..
.de Ve
.in 2
.ft R
.fi
.ad
..
.eh '$banner''$section-%'
.oh '$banner''$section-%'
EOF

#
# Main loop.
#

my $preformat = 0;
my $newsect;        # section and page number.
my $emailhdr;       # looks like an email message.

while (<$fh>) {
    chomp;
    $_ = tab_expand($_);
    s/\\/\\\\/g;    # Make sure backslashes print properly.

    # section header
    if (/^BEGINNING OF LOG FOR/) {
        s/=*//g;
        print ".in 0\n\\s+3\\fB$_\\fR\\s-3\n";
    }

    # begin dated entry
    elsif (/^[A-Z]/) {
        print ".in 0\n.sp\n.ad\n.fi\n.ne 1\n";

        # Increment section and page if date changes.  Example:
        #     a0   a1 a2  a3   a4       a5
        #     Thu, 17 Sep 2009 23:54:04 -0400
        #
        # If we're on an even page and we're printing this
        # double-sided, we'll have a new month starting on
        # the back of a page; this makes replacement of a
        # section difficult, so we add an additional page break.

        @a       = split;
        $newsect = $a[1] . '-' . $a[2] . '-' . $a[3];

        if ($newsect ne $section) {
            $section = $newsect;

            print ".br\n";
            print ".ie e \\{\\\n";
            print ".    eh '$banner''$section-%'\n";
            print ".    oh '$banner''$section-%'\n";
            print ".    bp 1 \\}\n";
            print ".el \\{\\\n";
            print ".    eh ''''\n";
            print ".    oh ''''\n";
            print ".    bp\n";
            print ".    sp 10\n";
            print "    This page intentionally left blank.\n";
            print ".    eh '$banner''$section-%'\n";
            print ".    oh '$banner''$section-%'\n";
            print ".    bp 1 \\}\n";
        }

        print "\\s+2\\fB$_\\fR\\s-2\n";
        print ".in 2\n";
    }

    # text, possibly preformatted
    else {
        if (/----S$/) {
            print ".Vb\n";
            $preformat = 1;
        }
        elsif (/----E$/) {
            print ".Ve\n";
            $preformat = 0;
        }
        else {
            if ($preformat == 0) {
                s/^\s*//g;
                print "$_\n";
            }
            else {
                # s/^    //;   # only if tabs = 8 spaces; should be 4.

                # Emphasize typed commands.
                if (/^\s*(you\%|me\%|me\$|root#)/) {
                    s/^/\\fB/;
                    s/$/\\fC/;
                }

                # Emphasize email headers.
                if (/^\s*(date|message-id|from|sent|to):/i) {
                    $emailhdr = 1;
                }
                elsif (/^\s*(subject|reply-to|cc|org.*):/i) {
                    $emailhdr = 1;
                }
                elsif (/^\s*$/) {
                    $emailhdr = 0;
                }

                # Keep leading spaces, or header shifts to the left.
                if ($emailhdr) {
                    s/^(\s*)/$1\\fI/;
                    s/$/\\fC/;
                }

                print "\\\& $_\n";
            }
        }
    }
}

print ".sp\n.in 0\n";
border();
print ".br\n\\fBEND\\fR\n";

close($fh);
exit(0);


#---------------------------------------------------------------------
# Expand tabs in a string to 8 spaces.
#
# This seems to work best; if you want to shrink the size of a line with
# lots of tabs, use "expand -5" to preserve most of the formatting.
#
# The leading 4 spaces are removed from preformatted lines to keep
# line size down; see the bottom portion of the main program loop.

sub tab_expand {
    local($_) = shift;
    my $tl = 8;
    1 while s/\t+/' ' x (length($&) * $tl - length($`) % $tl)/e;
    return $_;
}

#---------------------------------------------------------------------
# Print long horizontal line.

sub border {
    print '_' x 80, "\n";
}

#---------------------------------------------------------------------
# Print a usage message from the comments and exit.

sub usage {
    my ($emsg) = @_;
    use Pod::Usage qw(pod2usage);
    warn "$emsg\n" if defined $emsg;
    pod2usage(-verbose => 99, -sections => "NAME|SYNOPSIS|OPTIONS");
}

sub manpage {
    my @args = ("perldoc", "$0");
    exec { $args[0] } @args;          # safe even with one-arg list
    die("should not get here\n");
}

#---------------------------------------------------------------------
# Print the UUID, current version, or source location.

sub myuuid {
    my $UUID = $1
        if q$UUID: e66e0146-0ece-3dc9-a76f-950204c35ea0 $ =~ /UUID: (.*) /;
    print "$UUID\n";
    exit(0);
}

sub version {
    my $VERSION = sprintf("%d.%02d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/);
    my $DATE = $1 if q$Date: 2012-07-26 17:11:48-04 $ =~ /Date: (.*) /;
    print "$myname $VERSION $DATE\n";
    exit(0);
}

sub where {
    my $SOURCE = $1
        if q$Source: /home/vogelke/bin/RCS/log2troff,v $ =~
          /Source: (.*) /;
    my $HOST = $1 if q$Host: sys7.com $ =~ /Host: (.*) /;
    print "file://$HOST", "$SOURCE\n";
    exit(0);
}

#---------------------------------------------------------------------
__END__

=head1 NAME

log2troff - make printable LOG file

=head1 SYNOPSIS

log2troff [-hmuvw] [log ...]

=head1 OPTIONS

=over 4

=item B<-h>

Print a brief help message and exit.

=item B<-m>

Print the manual page and exit.

=item B<-u>

Print the script UUID and exit.

=item B<-v>

Print the version and exit.

=item B<-w>

Print the source location and exit.

=back

=head1 DESCRIPTION

B<log2troff> reads a LOG file (created by remark) and writes
the troff equivalent to stdout.  Use -me to format.

=head1 EXAMPLE

  log2troff LOG | groff -me -Tps > /tmp/LOG.ps

=head1 AUTHOR

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

=cut