From 8b4da404878ede01c16868f31fb666985b896034 Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter_e@gmx.net>
Date: Wed, 19 Nov 2008 09:51:55 +0000
Subject: [PATCH] Change this script to Perl 5 style.  Add support for multiple
 refnames. Sort the output by command name.  This previously only worked by
 source file name, which doesn't always match the command name exactly.  And
 it certainly won't work for multiple refnames.

---
 src/bin/psql/create_help.pl | 78 ++++++++++++++++---------------------
 1 file changed, 33 insertions(+), 45 deletions(-)

diff --git a/src/bin/psql/create_help.pl b/src/bin/psql/create_help.pl
index 0fc0f487ce..03314475c5 100644
--- a/src/bin/psql/create_help.pl
+++ b/src/bin/psql/create_help.pl
@@ -1,11 +1,11 @@
-#! /usr/bin/perl
+#! /usr/bin/perl -w
 
 #################################################################
 # create_help.pl -- converts SGML docs to internal psql help
 #
 # Copyright (c) 2000-2008, PostgreSQL Global Development Group
 #
-# $PostgreSQL: pgsql/src/bin/psql/create_help.pl,v 1.17 2008/01/20 21:13:55 tgl Exp $
+# $PostgreSQL: pgsql/src/bin/psql/create_help.pl,v 1.18 2008/11/19 09:51:55 petere Exp $
 #################################################################
 
 #
@@ -19,9 +19,12 @@
 # sure does matter to the rest of the source.
 #
 
-$docdir = $ARGV[0] || die "$0: missing required argument: docdir\n";
-$outputfile = $ARGV[1] || die "$0: missing required argument: output file\n";
+use strict;
 
+my $docdir = $ARGV[0] or die "$0: missing required argument: docdir\n";
+my $outputfile = $ARGV[1] or die "$0: missing required argument: output file\n";
+
+my $outputfilebasename;
 if ($outputfile =~ m!.*/([^/]+)$!) {
     $outputfilebasename = $1;
 }
@@ -29,14 +32,14 @@ else {
     $outputfilebasename = $outputfile;
 }
 
-$define = $outputfilebasename;
+my $define = $outputfilebasename;
 $define =~ tr/a-z/A-Z/;
 $define =~ s/\W/_/g;
 
 opendir(DIR, $docdir)
-    || die "$0: could not open documentation source dir '$docdir': $!\n";
+    or die "$0: could not open documentation source dir '$docdir': $!\n";
 open(OUT, ">$outputfile")
-    || die "$0: could not open output file '$outputfile': $!\n";
+    or die "$0: could not open output file '$outputfile': $!\n";
 
 print OUT
 "/*
@@ -64,46 +67,29 @@ struct _helpStruct
 static const struct _helpStruct QL_HELP[] = {
 ";
 
-$count = 0;
-$maxlen = 0;
+my $maxlen = 0;
 
-foreach $file (sort readdir DIR) {
-    local ($cmdname, $cmddesc, $cmdsynopsis);
-    $file =~ /\.sgml$/ || next;
+my %entries;
 
-    open(FILE, "$docdir/$file") || next;
-    $filecontent = join('', <FILE>);
+foreach my $file (sort readdir DIR) {
+    my (@cmdnames, $cmddesc, $cmdsynopsis);
+    $file =~ /\.sgml$/ or next;
+
+    open(FILE, "$docdir/$file") or next;
+    my $filecontent = join('', <FILE>);
     close FILE;
 
     # Ignore files that are not for SQL language statements
     $filecontent =~ m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i
-	|| next;
+	or next;
 
-    # Extract <refname>, <refpurpose>, and <synopsis> fields, taking the
-    # first one if there are more than one.  NOTE: we cannot just say
-    # "<synopsis>(.*)</synopsis>", because that will match the first
-    # occurrence of <synopsis> and the last one of </synopsis>!  Under
-    # Perl 5 we could use a non-greedy wildcard, .*?, to ensure we match
-    # the first </synopsis>, but we want this script to run under Perl 4
-    # too, and Perl 4 hasn't got that feature.  So, do it the hard way.
-    # Also, use [\000-\377] where we want to match anything including
-    # newline --- Perl 4 does not have Perl 5's /s modifier.
-    $filecontent =~ m!<refname>\s*([a-z ]*[a-z])\s*</refname>!i && ($cmdname = $1);
-    if ($filecontent =~ m!<refpurpose>\s*([\000-\377]+)$!i) {
-	$tmp = $1;		# everything after first <refpurpose>
-	if ($tmp =~ s!\s*</refpurpose>[\000-\377]*$!!i) {
-	    $cmddesc = $tmp;
-	}
-    }
-    if ($filecontent =~ m!<synopsis>\s*([\000-\377]+)$!i) {
-	$tmp = $1;		# everything after first <synopsis>
-	if ($tmp =~ s!\s*</synopsis>[\000-\377]*$!!i) {
-	    $cmdsynopsis = $tmp;
-	}
-    }
+    # Collect multiple refnames
+    LOOP: { $filecontent =~ m!\G.*?<refname>\s*([a-z ]+?)\s*</refname>!cgis and push @cmdnames, $1 and redo LOOP; }
+    $filecontent =~ m!<refpurpose>\s*(.+?)\s*</refpurpose>!is and $cmddesc = $1;
+    $filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is and $cmdsynopsis = $1;
 
-    if ($cmdname && $cmddesc && $cmdsynopsis) {
-        $cmdname =~ s/\"/\\"/g;
+    if (@cmdnames && $cmddesc && $cmdsynopsis) {
+        s/\"/\\"/g foreach @cmdnames;
 
 	$cmddesc =~ s/<[^>]+>//g;
 	$cmddesc =~ s/\s+/ /g;
@@ -113,22 +99,24 @@ foreach $file (sort readdir DIR) {
 	$cmdsynopsis =~ s/\r?\n/\\n/g;
         $cmdsynopsis =~ s/\"/\\"/g;
 
-	print OUT "    { \"$cmdname\",\n      N_(\"$cmddesc\"),\n      N_(\"$cmdsynopsis\") },\n\n";
-
-	$count++;
-	$maxlen = ($maxlen >= length $cmdname) ? $maxlen : length $cmdname;
+        foreach my $cmdname (@cmdnames) {
+	    $entries{$cmdname} = { cmddesc => $cmddesc, cmdsynopsis => $cmdsynopsis };
+	    $maxlen = ($maxlen >= length $cmdname) ? $maxlen : length $cmdname;
+	}
     }
     else {
-	print STDERR "$0: parsing file '$file' failed (N='$cmdname' D='$cmddesc')\n";
+	die "$0: parsing file '$file' failed (N='@cmdnames' D='$cmddesc')\n";
     }
 }
 
+print OUT "    { \"$_\",\n      N_(\"".$entries{$_}{cmddesc}."\"),\n      N_(\"".$entries{$_}{cmdsynopsis}."\") },\n\n" foreach (sort keys %entries);
+
 print OUT "
     { NULL, NULL, NULL }    /* End of list marker */
 };
 
 
-#define QL_HELP_COUNT	$count		/* number of help items */
+#define QL_HELP_COUNT	".scalar(keys %entries)."		/* number of help items */
 #define QL_MAX_CMD_LEN	$maxlen		/* largest strlen(cmd) */