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 $output = 0;
   8 $ignore = 0;
   9 $skipping = 0;
  10 %sects = ();
  11 $section = "";
  12 @icstack = ();
  13 @endwstack = ();
  14 @skstack = ();
  15 $shift = "";
  16 %defs = ();
  17
  18 while($_ = shift)
  19 {
  20     if (/^-D(.*)$/) {
  21         if ($1 ne "") {
  22             $flag = $1;
  23         } else {
  24             $flag = shift;
  25         }
  26         die "no flag specified for -D\n"
  27             unless $flag ne "";
  28         die "flags may only contain letters, digits, hyphens, and underscores\n"
  29             unless $flag =~ /^[a-zA-Z0-9_-]+$/;
  30         $defs{$flag} = "";
  31     } elsif (/^-/) {
  32         usage();
  33     } else {
  34         $in = $_, next unless defined $in;
  35         $out = $_, next unless defined $out;
  36         usage();
  37     }
  38 }
  39
  40 if (defined $in) {
  41     open(STDIN, $in) or die "opening \"$in\": $!\n";
  42 }
  43 if (defined $out) {
  44     open(STDOUT, ">$out") or die "opening \"$out\": $!\n";
  45 }
  46
  47 while(<STDIN>)
  48 {
  49     chomp;
  50     /^\@c man begin ([A-Z]+)/ and $sect = $1, $output = 1, next;
  51     /^\@c man end/ and do {
  52         $_ = $section;
  53
  54         s/\@(?:dfn|var|emph|cite)\{([^\}]*)\}/I<$1>/g;
  55         s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
  56         s/\@(?:samp|strong|key)\{([^\}]*)\}/B<$1>/g;
  57         s/\@value\{([a-zA-Z0-9_-]+)\}/$defs{$1}/g;
  58         s/\@sc\{([^\}]*)\}/\U$1/g;
  59         s/\@file\{([^\}]*)\}/F<$1>/g;
  60         s/\@(?:url|email)\{([^\}]*)\}/E<lt>C<$1>E<rt>/g;
  61         s/\@xref\{(?:[^\}]*)\}[^.]*.//g;
  62         s/\s+\(\@p[a-z]?ref\{(?:[^\}]*)\}\)//g;
  63         s/\@copyright\{\}//g;
  64         s/\@noindent\s*//g;
  65         s/\@refill//g;
  66         s/\@\././g;
  67
  68         # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to
  69         # match Texinfo semantics of @emph inside @samp.
  70
  71         s/&LT;/</g;
  72         s/&GT;/>/g;
  73         1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g);
  74         1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g);
  75         s/[BI]<>//g;
  76         s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
  77         s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
  78
  79         s/&lt;/E<lt>/g;
  80         s/&gt;/E<gt>/g;
  81         s/&lbrace;/\{/g;
  82         s/&rbrace;/\}/g;
  83
  84         $sects{$sect} = $_;
  85         $section = "";
  86         $output = 0;
  87         next;
  88     };
  89
  90     /^\@(c|[a-z]+index)\b/ and next;
  91     /^\@subsection/ and next;
  92     /^\@need/ and next;
  93     /^\@node/ and next;
  94
  95     /^\@setfilename\s+([^.]+)/ and $fn = $1, next;
  96     /^\@settitle\s+([^.]+)/ and $tl = $1, next;
  97
  98     next unless $output;
  99
 100     /^\@end\s+([a-z]+)/ and do {
 101         if(defined $endw)
 102         {
 103             die "\@$endw ended by \@end $1 at line $.\n"
 104                 unless $1 eq $endw;
 105
 106             if($endw =~ /example$/)
 107             {
 108                 $shift = "";
 109                 $_ = "";
 110             }
 111             elsif($endw =~ /^if/)
 112             {
 113                 $skipping = pop @skstack;
 114                 $_ = "";
 115             }
 116             else
 117             {
 118                 $_ = "\n=back\n";
 119                 $ic = pop @icstack;
 120             }
 121             $endw = pop @endwstack;
 122         }
 123     };
 124
 125     /^\@end ignore/ and $ignore = 0, next;
 126     next if $ignore;
 127     next if $skipping;
 128
 129     /^\@ignore/ and $ignore = 1, next;
 130
 131     /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and $defs{$1} = $2, next;
 132     /^\@clear\s+([a-zA-Z0-9_-]+)/ and delete $defs{$1}, next;
 133
 134     /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
 135         push @endwstack, $endw;
 136         push @skstack, $skipping;
 137         $endw = "ifset";
 138         $skipping = 1 unless exists $defs{$1};
 139     };
 140
 141     /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
 142         push @endwstack, $endw;
 143         push @skstack, $skipping;
 144         $endw = "ifset";
 145         $skipping = 1 if exists $defs{$1};
 146     };
 147
 148     /^\@itemize (\@[a-z]+)/ and do {
 149         push @endwstack, $endw;
 150         push @icstack, $ic;
 151         $ic = $1;
 152         $ic =~ s/\@bullet/*/;
 153         $ic =~ s/\@minus/-/;
 154         $_ = "\n=over 4\n";
 155         $endw = "itemize";
 156     };
 157
 158     /^\@enumerate\s+([A-Z0-9]+)/ and do {
 159         push @endwstack, $endw;
 160         push @icstack, $ic;
 161         $ic = $1 . ".";
 162         $_ = "\n=over 4\n";
 163         $endw = "enumerate";
 164     };
 165
 166     /^\@table\s+(\@[a-z]+)/ and do {
 167         push @endwstack, $endw;
 168         push @icstack, $ic;
 169         $ic = $1;
 170         $ic =~ s/\@(?:samp|strong|key)/B/;
 171         $ic =~ s/\@(?:code|kbd)/C/;
 172         $ic =~ s/\@(?:dfn|var|emph|cite)/I/;
 173         $ic =~ s/\@(?:file)/F/;
 174         $_ = "\n=over 4\n";
 175         $endw = "table";
 176     };
 177
 178     /^\@((?:small)?example)/ and do {
 179         push @endwstack, $endw;
 180         $endw = $1;
 181         $shift = "\t";
 182         next;
 183     };
 184
 185     /^\@itemx?\s*(.+)?$/ and do {
 186         if(defined $1)
 187         {
 188             $_ = "=item $ic\&LT;$1\&GT;\n";
 189         }
 190         else
 191         {
 192             $_ = "=item $ic\n";
 193             $ic =~ y/A-Ya-y1-8/B-Zb-z2-9/;
 194         }
 195     };
 196
 197     /^\@section\s+(.+)$/ and do {
 198         $_ = "\n=head2 $1\n";
 199     };
 200
 201     # POD doesn't interpret E<> inside a verbatim block.
 202     if ($shift eq "") {
 203         s/</&lt;/g;
 204         s/>/&gt;/g;
 205     } else {
 206         s/</&LT;/g;
 207         s/>/&GT;/g;
 208     }
 209     s/\@\{/&lbrace;/g;
 210     s/\@\}/&rbrace;/g;
 211     $section .= $shift.$_."\n";
 212 }
 213
 214 $sects{NAME} = "$fn \- $tl\n";
 215
 216 for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
 217               BUGS NOTES SEEALSO AUTHOR COPYRIGHT))
 218 {
 219     if(exists $sects{$sect})
 220     {
 221         $head = $sect;
 222         $head =~ s/SEEALSO/SEE ALSO/;
 223         print "=head1 $head\n\n";
 224         print $sects{$sect};
 225         print "\n";
 226     }
 227 }
 228
 229 sub usage
 230 {
 231     die "usage: $0 [-D toggle...] [infile [outfile]]\n";
 232 }