pod2otl

#!/usr/bin/perl -w
# translates POD to TVO outliner format
# By Ned Konz Aug 2002
# $Id: pod2otl 73 2002-12-19 19:08:59Z ned $
use strict;

use IO::File;
use Text::Wrap;
use Pod::Parser;
use File::Basename;

package MyParser;
@MyParser::ISA = qw(Pod::Parser);

my $level  = 0;
my $indent = "";
my $perl_fh;

$Text::Wrap::columns = 80;

sub level
{
	$level  = shift;
	$indent = "\t" x $level;

	# $Text::Wrap::columns = 80 - ($level * 8)
}

sub command
{
	my ( $parser, $command, $paragraph, $line_num ) = @_;
	my $prefix = "";

	# correct level
	if    ( $command eq 'head1' ) { level(0) }
	elsif ( $command eq 'head2' ) { level(1) }
	elsif ( $command eq 'over' )  { level( ++$level ); return }
	elsif ( $command eq 'back' )  { level( --$level ); return }
	elsif ( $command eq 'item' ) { $prefix = '* ' }

	my $out_fh = $parser->output_handle();
	my $expansion = $parser->interpolate( $paragraph, $line_num );
	chomp($paragraph);
	$out_fh->print( $indent, $prefix, $paragraph );
}

sub verbatim
{
	my ( $parser, $paragraph, $line_num ) = @_;

	my $out_fh = $parser->output_handle();
	for my $line ( split ( /\n/, $paragraph ) )
	{
		$line =~ s/^    //;
		$out_fh->print( $indent, "|| ", $line, "\n" );
	}
}

sub textblock
{
	my ( $parser, $paragraph, $line_num ) = @_;

	my $out_fh = $parser->output_handle();
	my $expansion = $parser->interpolate( $paragraph, $line_num );
	$out_fh->print(
		Text::Wrap::fill( $indent . "| ", $indent . "| ", $expansion ), "\n" );
}

sub preprocess_paragraph
{
	my ( $parser, $text, $line_num ) = @_;
	if ( $perl_fh && $parser->cutting() ) { $perl_fh->print($text) }
	return $text;
}

sub perl_to
{
	my $parser   = shift;
	my $filename = shift;
	$perl_fh = IO::File->new( $filename, 'w' )
	  or die "can't open $filename\: $!\n";
}

package main;

## Create a parser object and have it parse file whose name was
## given on the command-line (use STDIN if no files were given).
my $parser = new MyParser();
$parser->parseopts( -want_nonPODs => 1 );

if ( @ARGV == 0 )
{
	# write Perl to pod2otlout.pl
	# write OTL to STDOUT
	$parser->perl_to('pod2otlout.pl');
	$parser->parse_from_filehandle( \*STDIN );
}
else
{
	for (@ARGV)
	{
		my $filename = $_;
		my ($name, $path, $suffix) = fileparse($filename, '.p[lm]');
		$parser->perl_to( $path . $name . ".p2o" );
		$parser->parse_from_file($filename, $path . $name . ".otl");
	}
}