#!/usr/bin/perl -w

# Copyright (c) 1999 Mark Summerfield. All Rights Reserved.
# May be used/distributed under the same terms as Perl itself.

# $Id: pod2lout,v 1.5 1999/07/11 16:24:51 root Exp $

# BUG Should set proper footer, e.g. filename page number, but again Lout only
#     seems to allow this if you modify your own doc settings - can't seem to
#     override in the file itself.
# BUG A bit Q&D.


use strict ;

use Getopt::Long ;
use Lout ;

use vars qw( $VERSION ) ;

$VERSION   = '0.02' ;

my $Outfile      = 'STDOUT' ;
my $Wrapper      = 1 ;
my $SmartQuotes  = 1 ;
my $Superscripts = 1 ;


&prepare ;

if( $Outfile ne 'STDOUT' ) {
    open OUT, ">$Outfile" or die "Failed to open $Outfile: $!\n" ;
    select( OUT ) ;
}

&head if $Wrapper ;

my $lino    = 0 ;
my $newpara = 0 ;
my $inlist  = 0 ;

while( <> ) {
    $lino++ ;
    if( /^=(\w+)(\s+([^#]+))?(#.*)?$/o ) {
        my $type = $1 ;
        my $text = $3 ? &pod2lout( $3 ) : '' ;
        chomp $text ;
        my $comment = "$4\n" if $4 ;
        CASE : {
            if( $type eq 'pod' or 
                $type eq 'cut' ) {
                # Ignore.
                last CASE ;
            }
            if( $type eq 'head1' ) {
                print "\@CentredDisplay { Bold +4p } \@Font {$text}\n" ;
                last CASE ;
            }
            if( $type eq 'head2' ) {
                print "\@CentredDisplay { Bold +2p } \@Font {$text}\n" ;
                last CASE ;
            }
            if( $type eq 'over' ) {
                # Ignore - handled by first =item.
                last CASE ;
            }
            if( $type eq 'back' ) {
                $inlist--, print "}" if $inlist ;
                print "\@EndList\n" ;
                last CASE ;
            }
            if( $type eq 'item' ) {
                if( not $inlist ) {
                    if( $text =~ /^\d/ ) {
                        print "\@NumberedList\n" ;
                        $text = '' ;
                    }
                    else {
                        print "\@BulletList\n" ;
                        $text = '' if $text eq '*' ;
                    }
                }
                $inlist--, print "}" if $inlist ;
                print "\@ListItem {$text\n" ;
                $inlist++ ;
                last CASE ;
            }
            DEFAULT : {
                print "# UNHANDLED: $_" ;
                last CASE ;
            }
        }
        print $comment if $comment ;
    }
    elsif( /^\s*#/o ) {
        print ;
    }
    elsif( /^\s*$/o ) {
        if( $newpara ) {
            print "\@LP\n" unless $inlist ;
            $newpara = 0 ;
        }
        else {
            $newpara = 1 ;
        }
    }
    else {
        /^([^#]*)(#.*)$/o ;
        my $comment = "$2\n" if $2 ;
        $_ = $1 if $comment ;
        print &pod2lout( $_ ) ;
        print $comment if $comment ;
    }
    $lino = 0 if eof ;
}
&tail if $Wrapper ;


sub prepare {

    Getopt::Long::config 'no_ignore_case' ;
    GetOptions(
        'h|help'            => \&help,
        'o|outfile=s'       => \$Outfile,
        'q|smartquotes=i'   => \$SmartQuotes,
        's|superscripts=i'  => \$Superscripts,
        'w|wrapper=i'       => \$Wrapper,
        ) or die "\n" ;

    Lout::set_txt2lout( -smart_quotes, $SmartQuotes ) ;
    Lout::set_txt2lout( -superscripts, $Superscripts ) ;
}


sub head {
 
    my( $d, $m, $y ) = (localtime( time ))[3..5] ;
    $y += 1900 ; $m++ ; 
    $m = "0$m" if $m < 10 ; 
    $d = "0$d" if $d < 10 ;

    print <<__EOT__ ;
\@SysInclude { tbl }
\@SysInclude { doc }
# Created by pod2lout on $y/$m/$d.
\@Doc \@Text \@Begin
__EOT__
}


sub tail {
    print <<__EOT__ ;
\@End \@Text
__EOT__
}


sub help {
    print STDERR <<__EOT__ ;
pod2lout v $VERSION. Copyright (c) Mark Summerfield 1999. All Rights Reserved.
May be used/distributed under the same terms as Perl itself.

usage: pod2lout [options] <file>

options:
-h    --help          Print this help screen and exit
-o F  --outfile F     Write to file F [$Outfile]
-q    --smartquotes   Smartquotes [$SmartQuotes]
-s    --superscripts  Superscripts for 1st, 2nd etc [$Superscripts]
-w    --wrapper       Wrap text in lout \@Begin..\@End [$Wrapper]
__EOT__
    exit ;
}


sub pod2lout {
    local $_ = shift ;

    $_ = Lout::txt2lout( $_ ) ;
    s/B<([^>]*)>/\@B{$1}/go ;
    s/I<([^>]*)>/\@I{$1}/go ;
    s/C<([^>]*)>/\@F{$1}/go ;
    s/F<([^>]*)>/\@I \@Underline{$1}/go ;
    s/L<([^>]*)>/\@Underline{$1}/go ;
    s/S<([^>]*)>/'~' x length( $1 )/goe ;
    s/E<gt>/>/go ;
    s/E<lt>/</go ;
    s/E<(\[A-Fa-f\d]+)>/chr oct $1/goe ;
    s/X<([^>]*)>/(\@I{$1})/go ;
    s/Z<([^>]*)>/$1/go ;

    $_ ;
}

