2 #-------------------------------------------------------------------------
5 # Perl script that generates probes.h file when dtrace is not available
7 # Portions Copyright (c) 2008-2016, PostgreSQL Global Development Group
11 # src/backend/utils/Gen_dummy_probes.pl
13 # This program was generated by running perl's s2p over Gen_dummy_probes.sed
15 #-------------------------------------------------------------------------
17 $0 =~ s/^.*?(\w+)[\.\w+]*$/$1/;
21 use vars qw{ $isEOF $Hold %wFiles @Q $CondReg
22 $doAutoPrint $doOpenWrite $doPrint };
32 # Run: the sed loop reading input and applying the script
36 my ($h, $icnt, $s, $n);
38 # hack (not unbreakable :-/) to avoid // matching an empty string
46 $doPrint = $doAutoPrint;
51 $CondReg = 0; # cleared on t
55 unless (m /^[ \t]*probe /s)
61 # s/^[ ]*probe \([^(]*\)\(.*\);/\1\2/
63 $s = s /^[ \t]*probe ([^(]*)(.*);/${1}${2}/s;
73 # y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
74 { y{abcdefghijklmnopqrstuvwxyz}{ABCDEFGHIJKLMNOPQRSTUVWXYZ}; }
76 # s/^/#define TRACE_POSTGRESQL_/
78 $s = s /^/#define TRACE_POSTGRESQL_/s;
82 # s/([^,)]\{1,\})/(INT1)/
84 $s = s /\([^,)]+\)/(INT1)/s;
88 # s/([^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2)/
90 $s = s /\([^,)]+, [^,)]+\)/(INT1, INT2)/s;
94 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3)/
96 $s = s /\([^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3)/s;
100 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4)/
103 s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4)/s;
107 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5)/
110 s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5)/s;
114 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6)/
117 s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6)/s;
121 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/
124 s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/s;
128 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/
131 s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/s;
137 if (/^(.*)/) { print $1, "\n"; }
140 # s/(.*$/_ENABLED() (0)/
142 $s = s /\(.*$/_ENABLED() (0)/s;
151 $doPrint = $doAutoPrint;
160 # openARGV: open 1st input file
164 unshift(@ARGV, '-') unless @ARGV;
165 my $file = shift(@ARGV);
167 || die("$0: can't open $file for reading ($!)\n");
171 # getsARGV: Read another input line into argument (default: $_).
172 # Move on to next input file, and reset EOF flag $isEOF.
175 my $argref = @_ ? shift() : \$_;
176 while ($isEOF || !defined($$argref = <ARG>))
179 return 0 unless @ARGV;
180 my $file = shift(@ARGV);
182 || die("$0: can't open $file for reading ($!)\n");
188 # eofARGV: end-of-file test
192 return @ARGV == 0 && ($isEOF = eof(ARG));
195 # makeHandle: Generates another file handle for some file (given by its path)
196 # to be written due to a w command or an s command's w flag.
201 if (!exists($wFiles{$path}) || $wFiles{$path} eq '')
203 $handle = $wFiles{$path} = gensym();
206 if (!open($handle, ">$path"))
208 die("$0: can't open $path for writing: ($!)\n");
214 $handle = $wFiles{$path};
219 # printQ: Print queued output which is either a string or a reference
227 # flush open w files so that reading this file gets it all
228 if (exists($wFiles{$$q}) && $wFiles{$$q} ne '')
230 open($wFiles{$$q}, ">>$$q");
233 # copy file to stdout: slow, but safe
234 if (open(RF, "<$$q"))
236 while (defined(my $line = <RF>))