#!/usr/bin/perl

# pod2grutatxt - Converts POD format to Grutatxt
# http://triptico.com/software/grutatxt.html
#
# Copyright (C) 2008 Angel Ortega <angel@triptico.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# http://www.triptico.com

use Pod::Parser;

package GrutatxtParser;
use base 'Pod::Parser';

my $_deferred_title = 0;

sub _build_header {
	my $title	= shift;
	my $char	= shift;

	my $s = $title;
	$s =~ s/./$char/g;

	return $title . "\n" . $s . "\n\n";
}


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

	my $out_fh = $parser->output_handle();
	my $out = $parser->interpolate($paragraph, $line_num);

	if ($command =~ /^head(\d)/) {
		my $c = ('=', '-', '~', '~', '~')[$1];
		my ($t) = ($out =~ /^([^\n]+)/s);

		if ($t eq 'NAME') {
			$_deferred_title = 1;
			$out = '';
		}
		else {
			$out = _build_header($t, $c);
		}
	}
	elsif ($command eq 'item') {
		$out = ' * ' . $out;
	}
	elsif ($command eq 'over') {
		$out = '';
	}
	elsif ($command eq 'for') {
		my @w = split(/\s+/, $out);
		my $k = shift(@w);

		$out = '<<' . $k . "\n" . join(' ', @w) . "\n>>\n";
	}
	elsif ($command eq 'begin') {
		my @w = split(/\s+/, $out);
		my $k = shift(@w);

		$out = '<<' . $k . "\n";
	}
	elsif ($command eq 'end') {
		$out = ">>\n";
	}

	print $out_fh $out;
}

sub verbatim {
	my ($parser, $paragraph, $line_num) = @_;
	## Format verbatim paragraph; sample actions might be:
	my $out_fh = $parser->output_handle();
	print $out_fh $paragraph;
}

sub textblock {
	my ($parser, $paragraph, $line_num) = @_;
	## Translate/Format this block of text; sample actions might be:
	my $out_fh = $parser->output_handle();
	my $expansion = $parser->interpolate($paragraph, $line_num);

	if ($_deferred_title) {
		my ($t) = ($expansion =~ /^([^\n]+)/s);
		$expansion = _build_header($t, '=');
		$_deferred_title = 0;
	}

	print $out_fh $expansion;
}

sub interior_sequence {
	my ($parser, $seq_command, $seq_argument) = @_;

	## Expand an interior sequence; sample actions might be:
	return "*$seq_argument*"     if ($seq_command eq 'B');
	return "`$seq_argument'"     if ($seq_command =~ /^(C|F)$/);
	return "_${seq_argument}_"   if ($seq_command eq 'I');
	return $seq_argument;
}

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).
$parser = new GrutatxtParser();
$parser->parse_from_filehandle(\*STDIN)  if (@ARGV == 0);
for (@ARGV) { $parser->parse_from_file($_); }

exit 0;
