On Sun, Mar 6, 2016 at 5:55 AM, Andrew Dunstan <[email protected]> wrote:
> On 03/05/2016 01:31 PM, Michael Paquier wrote:
>> On Sat, Mar 5, 2016 at 11:34 PM, Andrew Dunstan <[email protected]>
>> wrote:
>>>
>>> Here is a translation into perl of the sed script, courtesy of the s2p
>>> incarnation of psed:
>>> <https://gist.github.com/adunstan/d61b1261a4b91496bdc6>
>>> The sed script appears to have been stable for a long time, so I don't
>>> think
>>> we need to be too concerned about possibly maintaining two versions.
>>
>> That's 95% of the work already done, nice! If I finish wrapping up a
>> patch for this issue at least would you backpatch? It would be saner
>> to get rid of this dependency everywhere I think regarding compilation
>> with perl 5.22.
>
> Sure.
OK, so after some re-lecture of the script and perltidy-ing I finish
with the attached. How does that look?
--
Michael
diff --git a/src/backend/utils/Gen_dummy_probes.pl b/src/backend/utils/Gen_dummy_probes.pl
new file mode 100644
index 0000000..30c6d65
--- /dev/null
+++ b/src/backend/utils/Gen_dummy_probes.pl
@@ -0,0 +1,247 @@
+#! /usr/bin/perl -w
+#-------------------------------------------------------------------------
+#
+# Gen_dummy_probes.pl
+# Perl script that generates probes.h file when dtrace is not available
+#
+# Portions Copyright (c) 2008-2016, PostgreSQL Global Development Group
+#
+#
+# IDENTIFICATION
+# src/backend/utils/Gen_dummy_probes.pl
+#
+#-------------------------------------------------------------------------
+
+$0 =~ s/^.*?(\w+)[\.\w+]*$/$1/;
+
+use strict;
+use Symbol;
+use vars qw{ $isEOF $Hold %wFiles @Q $CondReg
+ $doAutoPrint $doOpenWrite $doPrint };
+$doAutoPrint = 1;
+$doOpenWrite = 1;
+
+# prototypes
+sub openARGV();
+sub getsARGV(;\$);
+sub eofARGV();
+sub printQ();
+
+# Run: the sed loop reading input and applying the script
+#
+sub Run()
+{
+ my ($h, $icnt, $s, $n);
+
+ # hack (not unbreakable :-/) to avoid // matching an empty string
+ my $z = "\000";
+ $z =~ /$z/;
+
+ # Initialize.
+ openARGV();
+ $Hold = '';
+ $CondReg = 0;
+ $doPrint = $doAutoPrint;
+ CYCLE:
+ while (getsARGV())
+ {
+ chomp();
+ $CondReg = 0; # cleared on t
+ BOS:;
+
+ # /^[ ]*probe /!d
+ unless (m /^[ \t]*probe /s)
+ {
+ $doPrint = 0;
+ goto EOS;
+ }
+
+ # s/^[ ]*probe \([^(]*\)\(.*\);/\1\2/
+ {
+ $s = s /^[ \t]*probe ([^(]*)(.*);/${1}${2}/s;
+ $CondReg ||= $s;
+ }
+
+ # s/__/_/g
+ {
+ $s = s /__/_/sg;
+ $CondReg ||= $s;
+ }
+
+ # y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
+ { y{abcdefghijklmnopqrstuvwxyz}{ABCDEFGHIJKLMNOPQRSTUVWXYZ}; }
+
+ # s/^/#define TRACE_POSTGRESQL_/
+ {
+ $s = s /^/#define TRACE_POSTGRESQL_/s;
+ $CondReg ||= $s;
+ }
+
+ # s/([^,)]\{1,\})/(INT1)/
+ {
+ $s = s /\([^,)]+\)/(INT1)/s;
+ $CondReg ||= $s;
+ }
+
+ # s/([^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2)/
+ {
+ $s = s /\([^,)]+, [^,)]+\)/(INT1, INT2)/s;
+ $CondReg ||= $s;
+ }
+
+ # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3)/
+ {
+ $s = s /\([^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3)/s;
+ $CondReg ||= $s;
+ }
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4)/
+ {
+ $s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4)/s;
+ $CondReg ||= $s;
+ }
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5)/
+ {
+ $s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5)/s;
+ $CondReg ||= $s;
+ }
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6)/
+ {
+ $s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6)/s;
+ $CondReg ||= $s;
+ }
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/
+ {
+ $s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/s;
+ $CondReg ||= $s;
+ }
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/
+ {
+ $s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/s;
+ $CondReg ||= $s;
+ }
+
+ # P
+ {
+ if (/^(.*)/) { print $1, "\n"; }
+ }
+
+ # s/(.*$/_ENABLED() (0)/
+ {
+ $s = s /\(.*$/_ENABLED() (0)/s;
+ $CondReg ||= $s;
+ }
+ EOS: if ($doPrint)
+ {
+ print $_, "\n";
+ }
+ else
+ {
+ $doPrint = $doAutoPrint;
+ }
+ printQ() if @Q;
+ }
+
+ exit(0);
+}
+Run();
+
+# openARGV: open 1st input file
+#
+sub openARGV()
+{
+ unshift(@ARGV, '-') unless @ARGV;
+ my $file = shift(@ARGV);
+ open(ARG, "<$file")
+ || die("$0: can't open $file for reading ($!)\n");
+ $isEOF = 0;
+}
+
+# getsARGV: Read another input line into argument (default: $_).
+# Move on to next input file, and reset EOF flag $isEOF.
+sub getsARGV(;\$)
+{
+ my $argref = @_ ? shift() : \$_;
+ while ($isEOF || !defined($$argref = <ARG>))
+ {
+ close(ARG);
+ return 0 unless @ARGV;
+ my $file = shift(@ARGV);
+ open(ARG, "<$file")
+ || die("$0: can't open $file for reading ($!)\n");
+ $isEOF = 0;
+ }
+ 1;
+}
+
+# eofARGV: end-of-file test
+#
+sub eofARGV()
+{
+ return @ARGV == 0 && ($isEOF = eof(ARG));
+}
+
+# makeHandle: Generates another file handle for some file (given by its path)
+# to be written due to a w command or an s command's w flag.
+sub makeHandle($)
+{
+ my ($path) = @_;
+ my $handle;
+ if (!exists($wFiles{$path}) || $wFiles{$path} eq '')
+ {
+ $handle = $wFiles{$path} = gensym();
+ if ($doOpenWrite)
+ {
+ if (!open($handle, ">$path"))
+ {
+ die("$0: can't open $path for writing: ($!)\n");
+ }
+ }
+ }
+ else
+ {
+ $handle = $wFiles{$path};
+ }
+ return $handle;
+}
+
+# printQ: Print queued output which is either a string or a reference
+# to a pathname.
+sub printQ()
+{
+ for my $q (@Q)
+ {
+ if (ref($q))
+ {
+ # flush open w files so that reading this file gets it all
+ if (exists($wFiles{$$q}) && $wFiles{$$q} ne '')
+ {
+ open($wFiles{$$q}, ">>$$q");
+ }
+
+ # copy file to stdout: slow, but safe
+ if (open(RF, "<$$q"))
+ {
+ while (defined(my $line = <RF>))
+ {
+ print $line;
+ }
+ close(RF);
+ }
+ }
+ else
+ {
+ print $q;
+ }
+ }
+ undef(@Q);
+}
diff --git a/src/backend/utils/Gen_dummy_probes.sed b/src/backend/utils/Gen_dummy_probes.sed
deleted file mode 100644
index 5a79fdb..0000000
--- a/src/backend/utils/Gen_dummy_probes.sed
+++ /dev/null
@@ -1,23 +0,0 @@
-#-------------------------------------------------------------------------
-# sed script to create dummy probes.h file when dtrace is not available
-#
-# Copyright (c) 2008-2016, PostgreSQL Global Development Group
-#
-# src/backend/utils/Gen_dummy_probes.sed
-#-------------------------------------------------------------------------
-
-/^[ ]*probe /!d
-s/^[ ]*probe \([^(]*\)\(.*\);/\1\2/
-s/__/_/g
-y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
-s/^/#define TRACE_POSTGRESQL_/
-s/([^,)]\{1,\})/(INT1)/
-s/([^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/
-P
-s/(.*$/_ENABLED() (0)/
diff --git a/src/backend/utils/Makefile b/src/backend/utils/Makefile
index 8374533..43fa255 100644
--- a/src/backend/utils/Makefile
+++ b/src/backend/utils/Makefile
@@ -30,7 +30,7 @@ errcodes.h: $(top_srcdir)/src/backend/utils/errcodes.txt generate-errcodes.pl
$(PERL) $(srcdir)/generate-errcodes.pl $< > $@
ifneq ($(enable_dtrace), yes)
-probes.h: Gen_dummy_probes.sed
+probes.h: Gen_dummy_probes.pl
endif
probes.h: probes.d
@@ -39,7 +39,7 @@ ifeq ($(enable_dtrace), yes)
sed -e 's/POSTGRESQL_/TRACE_POSTGRESQL_/g' [email protected] >$@
rm [email protected]
else
- sed -f $(srcdir)/Gen_dummy_probes.sed $< >$@
+ $(PERL) $(srcdir)/Gen_dummy_probes.pl $< > $@
endif
diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm
index c5a43f9..60bcd7e 100644
--- a/src/tools/msvc/Solution.pm
+++ b/src/tools/msvc/Solution.pm
@@ -313,7 +313,7 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
{
print "Generating probes.h...\n";
system(
-'psed -f src/backend/utils/Gen_dummy_probes.sed src/backend/utils/probes.d > src/include/utils/probes.h'
+'perl src/backend/utils/Gen_dummy_probes.pl src/backend/utils/probes.d > src/include/utils/probes.h'
);
}
--
Sent via pgsql-hackers mailing list ([email protected])
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
