pod2grutatxt

   1 #!/usr/bin/perl
   2
   3 # pod2grutatxt - Converts POD format to Grutatxt
   4 # http://triptico.com/software/grutatxt.html
   5 #
   6 # Copyright (C) 2008 Angel Ortega <angel@triptico.com>
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21 #
  22 # http://www.triptico.com
  23
  24 use Pod::Parser;
  25
  26 package GrutatxtParser;
  27 use base 'Pod::Parser';
  28
  29 my $_deferred_title = 0;
  30
  31 sub _build_header {
  32         my $title       = shift;
  33         my $char        = shift;
  34
  35         my $s = $title;
  36         $s =~ s/./$char/g;
  37
  38         return $title . "\n" . $s . "\n\n";
  39 }
  40
  41
  42 sub command {
  43         my ($parser, $command, $paragraph, $line_num) = @_;
  44
  45         my $out_fh = $parser->output_handle();
  46         my $out = $parser->interpolate($paragraph, $line_num);
  47
  48         if ($command =~ /^head(\d)/) {
  49                 my $c = ('=', '-', '~', '~', '~')[$1];
  50                 my ($t) = ($out =~ /^([^\n]+)/s);
  51
  52                 if ($t eq 'NAME') {
  53                         $_deferred_title = 1;
  54                         $out = '';
  55                 }
  56                 else {
  57                         $out = _build_header($t, $c);
  58                 }
  59         }
  60         elsif ($command eq 'item') {
  61                 $out = ' * ' . $out;
  62         }
  63         elsif ($command eq 'over') {
  64                 $out = '';
  65         }
  66         elsif ($command eq 'for') {
  67                 my @w = split(/\s+/, $out);
  68                 my $k = shift(@w);
  69
  70                 $out = '<<' . $k . "\n" . join(' ', @w) . "\n>>\n";
  71         }
  72         elsif ($command eq 'begin') {
  73                 my @w = split(/\s+/, $out);
  74                 my $k = shift(@w);
  75
  76                 $out = '<<' . $k . "\n";
  77         }
  78         elsif ($command eq 'end') {
  79                 $out = ">>\n";
  80         }
  81
  82         print $out_fh $out;
  83 }
  84
  85 sub verbatim {
  86         my ($parser, $paragraph, $line_num) = @_;
  87         ## Format verbatim paragraph; sample actions might be:
  88         my $out_fh = $parser->output_handle();
  89         print $out_fh $paragraph;
  90 }
  91
  92 sub textblock {
  93         my ($parser, $paragraph, $line_num) = @_;
  94         ## Translate/Format this block of text; sample actions might be:
  95         my $out_fh = $parser->output_handle();
  96         my $expansion = $parser->interpolate($paragraph, $line_num);
  97
  98         if ($_deferred_title) {
  99                 my ($t) = ($expansion =~ /^([^\n]+)/s);
 100                 $expansion = _build_header($t, '=');
 101                 $_deferred_title = 0;
 102         }
 103
 104         print $out_fh $expansion;
 105 }
 106
 107 sub interior_sequence {
 108         my ($parser, $seq_command, $seq_argument) = @_;
 109
 110         ## Expand an interior sequence; sample actions might be:
 111         return "*$seq_argument*"     if ($seq_command eq 'B');
 112         return "`$seq_argument'"     if ($seq_command =~ /^(C|F)$/);
 113         return "_${seq_argument}_"   if ($seq_command eq 'I');
 114         return $seq_argument;
 115 }
 116
 117 package main;
 118
 119 ## Create a parser object and have it parse file whose name was
 120 ## given on the command-line (use STDIN if no files were given).
 121 $parser = new GrutatxtParser();
 122 $parser->parse_from_filehandle(\*STDIN)  if (@ARGV == 0);
 123 for (@ARGV) { $parser->parse_from_file($_); }
 124
 125 exit 0;