[PATCH 2/4] Perl script to generate online help.

[david@tethera.net]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 3410 bytes --]

From: David Bremner <bremner@unb.ca>

This is a bit more complicated than expected, mainly because it needs
to split a chunk of the docs into 3 pieces corresponding to the
strings currently filled into a struct command_t.

To disable the ANSI escape codes, replace Pod::Text:Color with
Pod::Text. It would not be that much more work to generate colorized
and uncolorized help strings, and choose at runtime.
---
 pod2help_h.pl |  108 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 108 insertions(+), 0 deletions(-)
 create mode 100644 pod2help_h.pl

diff --git a/pod2help_h.pl b/pod2help_h.pl
new file mode 100644
index 0000000..99cfb96
--- /dev/null
+++ b/pod2help_h.pl
@@ -0,0 +1,108 @@
+#!/usr/bin/perl
+
+# Copyright © David Bremner, 2010
+# This file is distributed under the same terms as perl, Artistic or GPL 1+.
+#
+# Authors: David Bremner <david@tethera.net>
+
+use Pod::Select;
+use Pod::Text::Color;
+use strict;
+
+# Create customized version of Pod::Select, that uses Pod::Text to
+# format pieces of the file.
+
+package OurParser;
+our @ISA = qw(Pod::Select);
+
+sub new{
+  my $class = shift;
+  my $self =  { body => "" , name => undef};
+  bless $self, $class;
+  $self->initialize();
+  return $self;
+}
+
+# process verbatim blocks, err, verbatimly. Note that $self->{body} is
+# processed a second time by Pod::Text
+
+sub verbatim {
+  my ($self,$text,$line_num,$pod_para)=@_;
+
+  $self->{body} .= $text;
+}
+
+# process a normal text or command block. Either do some command
+# starting with =for, append to text to be process, or process the
+# current section.  Note that this has the weakness/bug that nested
+# sections are not supported as chunks of text for help.
+sub textblock{
+    my ($self,$text,$line_num,$pod_para) = @_;
+
+    my $cmd = $pod_para -> cmd_name;
+
+    if ($cmd =~ /^head/){
+
+      $self->output() if defined($self->{name});
+
+      # grab name heuristically as the first word.
+      $text =~ m/\s*\w+\s+([\w-]+)/;
+      $self->{name} = $1;
+      $self->{name} =~s/-/_/;
+
+    } elsif ($cmd =~ /^for/){
+
+      $text =~ s/^\s+//;
+      $text =~ s/\s+$//;
+
+      # work around a pod bug/misfeature that requires a blank line between
+      # =for paragraphs.
+
+      my @lines=split("\n",$text);
+      foreach my $line (@lines){
+
+	$line =~ s/^=for\s+help\s+//;
+
+	# override name if specified.
+	$self->{name} = $1 if ($line =~ m/^name\s+(.*)$/);
+
+	# other "subcommands" could be supported here.
+	if ($line =~ s/^(args|desc)\s+//) {
+	  my $quote="\"";
+	  my $subcmd=$1;
+
+	  # special case NULL; we don't want "NULL"
+	  $quote = "" if ($line =~ /^NULL/);
+
+	  print ("#define HELP_$self->{name}_$subcmd $quote$line$quote\n");
+	}
+      }
+    } else {
+      $self->{body} .= $text;
+    }
+}
+
+sub output {
+  my $self = shift;
+  my $formatter = new Pod::Text::Color(margin=>4);
+  my $output;
+  $formatter -> output_string (\$output);
+  $formatter -> parse_string_document ("=pod\n\n".$self->{body});
+
+  # post-process to turn into a C string.
+  $output =~ s/"/\\"/g;
+  $output =~ s/\n/\\n"\\\n"/g;
+  $output =~ s/\e/\\e/g;
+
+  print "#define HELP_$self->{name}_text \\\n\"$output\"\n";
+  $self->{body} = "";
+
+}
+
+package main;
+
+my $parser =  new OurParser();
+
+$parser->select("Commands/..*","Search Syntax");
+$parser->parse_from_filehandle(\*STDIN);
+$parser->output();
-- 
1.7.1