mirror/postgresql
2
0
Fork 0
mirror of https://git.postgresql.org/git/postgresql.git synced 2024-12-09 08:10:09 +08:00
Code Issues Packages Projects Releases Wiki Activity

Tweak create_help.pl so it will work under either perl 4.* or perl 5.*.

Browse Source 
Remove knowledge of path to documentation source directory from perl
script, instead have Makefile pass it to script.
This commit is contained in:
Tom Lane 2000-04-16 18:07:22 +00:00
parent aae70b2dca
commit ea46ddcfa6
2 changed files with 44 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/bin/psql/Makefile.in
View File

@ -7,14 +7,16 @@
# #
# #
# IDENTIFICATION # IDENTIFICATION
# $Header: /cvsroot/pgsql/src/bin/psql/Attic/Makefile.in,v 1.22 2000/04/14 23:43:44 petere Exp $ # $Header: /cvsroot/pgsql/src/bin/psql/Attic/Makefile.in,v 1.23 2000/04/16 18:07:22 tgl Exp $
# #
#------------------------------------------------------------------------- #-------------------------------------------------------------------------
SRCDIR= ../.. SRCDIR= ../..
include ../../Makefile.global include $(SRCDIR)/Makefile.global
CFLAGS:= -I$(LIBPQDIR) $(CFLAGS) DOCDIR= $(SRCDIR)/../doc/src/sgml/ref
CFLAGS+= -I$(LIBPQDIR)
# #
# And where libpq goes, so goes the authentication stuff... # And where libpq goes, so goes the authentication stuff...
@ -61,8 +63,8 @@ psql: $(OBJS) $(LIBPQDIR)/libpq.a
help.o: sql_help.h help.o: sql_help.h
ifneq ($(strip $(PERL)),) ifneq ($(strip $(PERL)),)
sql_help.h: $(wildcard $(SRCDIR)/../doc/src/sgml/ref/*.sgml) create_help.pl sql_help.h: $(wildcard $(DOCDIR)/*.sgml) create_help.pl
$(PERL) create_help.pl sql_help.h $(PERL) create_help.pl $(DOCDIR) sql_help.h
else else
sql_help.h: sql_help.h:
@echo "*** Perl is needed to build psql help." @echo "*** Perl is needed to build psql help."

53
src/bin/psql/create_help.pl
View File

@ -5,7 +5,7 @@
# #
# Copyright 2000 by PostgreSQL Global Development Group # Copyright 2000 by PostgreSQL Global Development Group
# #
# $Header: /cvsroot/pgsql/src/bin/psql/create_help.pl,v 1.5 2000/03/01 21:09:58 petere Exp $ # $Header: /cvsroot/pgsql/src/bin/psql/create_help.pl,v 1.6 2000/04/16 18:07:22 tgl Exp $
################################################################# #################################################################
# #
@ -14,20 +14,22 @@
# enough that this worked, but this here is by no means an SGML # enough that this worked, but this here is by no means an SGML
# parser. # parser.
# #
# Call: perl create_help.pl sql_help.h # Call: perl create_help.pl docdir sql_help.h
# The name of the header file doesn't matter to this script, but it # The name of the header file doesn't matter to this script, but it
# sure does matter to the rest of the source. # sure does matter to the rest of the source.
# #
$docdir = "./../../../doc/src/sgml/ref"; $docdir = $ARGV[0] || die "$0: missing required argument: docdir\n";
$outputfile = $ARGV[0] or die "$0: missing required argument\n"; $outputfile = $ARGV[1] || die "$0: missing required argument: output file\n";
$define = $outputfile; $define = $outputfile;
$define =~ tr/a-z/A-Z/; $define =~ tr/a-z/A-Z/;
$define =~ s/\W/_/g; $define =~ s/\W/_/g;
opendir DIR, $docdir or die "$0: could not open documentation sources: $!\n"; opendir(DIR, $docdir)
open OUT, ">$outputfile" or die "$0: could not open output file '$outputfile': $!\n"; || die "$0: could not open documentation source dir '$docdir': $!\n";
open(OUT, ">$outputfile")
|| die "$0: could not open output file '$outputfile': $!\n";
print OUT print OUT
"/* "/*
@ -57,29 +59,48 @@ static struct _helpStruct QL_HELP[] = {
$count = 0; $count = 0;
foreach $file (sort readdir DIR) { foreach $file (sort readdir DIR) {
my ($cmdname, $cmddesc, $cmdsynopsis); local ($cmdname, $cmddesc, $cmdsynopsis);
$file =~ /\.sgml$/ || next; $file =~ /\.sgml$/ || next;
open FILE, "$docdir/$file" or next; open(FILE, "$docdir/$file") || next;
$filecontent = join('', <FILE>); $filecontent = join('', <FILE>);
close FILE; close FILE;
# Ignore files that are not for SQL language statements
$filecontent =~ m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i $filecontent =~ m!<refmiscinfo>\s*SQL - Language Statements\s*</refmiscinfo>!i
or next; || next;
$filecontent =~ m!<refname>\s*([a-z ]+?)\s*</refname>!i && ($cmdname = $1); # Extract <refname>, <refpurpose>, and <synopsis> fields, taking the
$filecontent =~ m!<refpurpose>\s*(.+?)\s*</refpurpose>!i && ($cmddesc = $1); # first one if there are more than one. NOTE: we cannot just say
# "<synopsis>(.*)</synopsis>", because that will match the first
$filecontent =~ m!<synopsis>\s*(.+?)\s*</synopsis>!is && ($cmdsynopsis = $1); # 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;
}
}
if ($cmdname && $cmddesc && $cmdsynopsis) { if ($cmdname && $cmddesc && $cmdsynopsis) {
$cmdname =~ s/\"/\\"/g; $cmdname =~ s/\"/\\"/g;
$cmddesc =~ s/<\/?.+?>//sg; $cmddesc =~ s/<[^>]+>//g;
$cmddesc =~ s/\n/ /g; $cmddesc =~ s/\s+/ /g;
$cmddesc =~ s/\"/\\"/g; $cmddesc =~ s/\"/\\"/g;
$cmdsynopsis =~ s/<\/?.+?>//sg; $cmdsynopsis =~ s/<[^>]+>//g;
$cmdsynopsis =~ s/\n/\\n/g; $cmdsynopsis =~ s/\n/\\n/g;
$cmdsynopsis =~ s/\"/\\"/g; $cmdsynopsis =~ s/\"/\\"/g;