contrib/texi2pod.pl

   1 #! /usr/bin/perl -w
   2
   3 # This does trivial (and I mean _trivial_) conversion of Texinfo
   4 # markup to Perl POD format.  It's intended to be used to extract
   5 # something suitable for a manpage from a Texinfo document.
   6
   7 $in = $ARGV[0];
   8 $out = "x";
   9 die "usage: $0 infile outfile\n" unless defined $in && defined $out;
  10
  11 close STDIN;
  12 open(IN,$in);
  13
  14 $output = 0;
  15 $ignore = 0;
  16 %sects = ();
  17 $section = "";
  18 @icstack = ();
  19 @endwstack = ();
  20 $shift = "";
  21
  22 while(<IN>)
  23 {
  24     chomp;
  25     /^\@end ignore/ and $ignore = 0, next;
  26     next if $ignore;
  27     /^\@c man begin ([A-Z]+)/ and $sect = $1, $output = 1, next;
  28     /^\@c man end/ and do {
  29         $_ = $section;
  30         s/</&lt;/g;
  31         s/>/&gt;/g;
  32
  33         s/\@(?:dfn|var|emph|cite)\{([^\}]*)\}/I<$1>/g;
  34         s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
  35         s/\@(?:samp|strong|key)\{([^\}]*)\}/B<$1>/g;
  36         s/\@file\{([^\}]*)\}/F<$1>/g;
  37         s/\@(?:url|email)\{([^\}]*)\}/E<lt>C<$1>E<rt>/g;
  38         s/\@[a-z]?ref\{(?:[^\}]*)\}.?//g;
  39         s/\(\@p[a-z]?ref\{(?:[^\}]*)\}\).?//g;
  40         s/\@copyright\{\}//g;
  41         s/\@noindent\s*//g;
  42         s/\@refill//g;
  43         s/\@\././g;
  44
  45         s/&lt;/E<lt>/g;
  46         s/&gt;/E<gt>/g;
  47         s/&LT;/</g;
  48         s/&GT;/>/g;
  49
  50         $sects{$sect} = $_;
  51         $section = "";
  52         $output = 0;
  53         next;
  54     };
  55
  56     /^\@(c|[a-z]+index)\b/ and next;
  57
  58     /^\@setfilename\s+([^.]+)/ and $fn = $1, next;
  59     /^\@settitle\s+([^.]+)/ and $tl = $1, next;
  60
  61     next unless $output;
  62
  63     /^\@ignore/ and $ignore = 1, next;
  64
  65     /^\@itemize (\@[a-z]+)/ and do {
  66         push @endwstack, $endw;
  67         push @icstack, $ic;
  68         $ic = $1;
  69         $ic =~ s/\@bullet/*/;
  70         $ic =~ s/\@minus/-/;
  71         $_ = "\n=over 4\n";
  72         $endw = "itemize";
  73     };
  74
  75     /^\@enumerate\s+([A-Z0-9]+)/ and do {
  76         push @endwstack, $endw;
  77         push @icstack, $ic;
  78         $ic = $1 . ".";
  79         $_ = "\n=over 4\n";
  80         $endw = "enumerate";
  81     };
  82
  83     /^\@table\s+(\@[a-z]+)/ and do {
  84         push @endwstack, $endw;
  85         push @icstack, $ic;
  86         $ic = $1;
  87         $ic =~ s/\@(?:samp|strong|key)/B/;
  88         $ic =~ s/\@(?:code|kbd)/C/;
  89         $ic =~ s/\@(?:dfn|var|emph|cite)/I/;
  90         $ic =~ s/\@(?:file)/F/;
  91         $_ = "\n=over 4\n";
  92         $endw = "table";
  93     };
  94
  95     /^\@((?:small)?example)/ and do {
  96         push @endwstack, $endw;
  97         $endw = $1;
  98         $shift = "\t";
  99         next;
 100     };
 101
 102     /^\@end\s+([a-z]+)/ and do {
 103         if(defined $endw)
 104         {
 105             die "\@$endw ended by \@end $1 at line $.\n"
 106                 unless $1 eq $endw;
 107
 108             if($endw =~ /example$/)
 109             {
 110                 $shift = "";
 111                 $_ = "";
 112             }
 113             else
 114             {
 115                 $_ = "\n=back\n";
 116                 undef $endw;
 117                 $ic = pop @icstack;
 118             }
 119             $endw = pop @endwstack;
 120         }
 121     };
 122
 123     /^\@itemx?\s*(.+)?$/ and do {
 124         if(defined $1)
 125         {
 126             $_ = "=item $ic\&LT;$1\&GT;\n";
 127         }
 128         else
 129         {
 130             $_ = "=item $ic\n";
 131             $ic =~ y/A-Ya-y1-8/B-Zb-z2-9/;
 132         }
 133     };
 134
 135     $section .= $shift.$_."\n";
 136 }
 137
 138 $sects{NAME} = "$fn \- $tl\n";
 139
 140 for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
 141               BUGS NOTES SEEALSO AUTHOR COPYRIGHT))
 142 {
 143     if(exists $sects{$sect})
 144     {
 145         $head = $sect;
 146         $head =~ s/SEEALSO/SEE ALSO/;
 147         print "=head1 $head\n\n";
 148         print $sects{$sect};
 149         print "\n";
 150     }
 151 }