granicus.if.org Git - postgresql/blob - src/backend/utils/Gen_dummy_probes.pl

   1 #! /usr/bin/perl -w
   2 #-------------------------------------------------------------------------
   3 #
   4 # Gen_dummy_probes.pl
   5 #    Perl script that generates probes.h file when dtrace is not available
   6 #
   7 # Portions Copyright (c) 2008-2019, PostgreSQL Global Development Group
   8 #
   9 #
  10 # IDENTIFICATION
  11 #    src/backend/utils/Gen_dummy_probes.pl
  12 #
  13 # This program was generated by running perl's s2p over Gen_dummy_probes.sed
  14 #
  15 #-------------------------------------------------------------------------
  16
  17 # turn off perlcritic for autogened code
  18 ## no critic
  19
  20 $0 =~ s/^.*?(\w+)[\.\w+]*$/$1/;
  21
  22 use strict;
  23 use Symbol;
  24 use vars qw{ $isEOF $Hold %wFiles @Q $CondReg
  25   $doAutoPrint $doOpenWrite $doPrint };
  26 $doAutoPrint = 1;
  27 $doOpenWrite = 1;
  28
  29 # prototypes
  30 sub openARGV();
  31 sub getsARGV(;\$);
  32 sub eofARGV();
  33 sub printQ();
  34
  35 # Run: the sed loop reading input and applying the script
  36 #
  37 sub Run()
  38 {
  39         my ($h, $icnt, $s, $n);
  40
  41         # hack (not unbreakable :-/) to avoid // matching an empty string
  42         my $z = "\000";
  43         $z =~ /$z/;
  44
  45         # Initialize.
  46         openARGV();
  47         $Hold    = '';
  48         $CondReg = 0;
  49         $doPrint = $doAutoPrint;
  50   CYCLE:
  51         while (getsARGV())
  52         {
  53                 chomp();
  54                 $CondReg = 0;    # cleared on t
  55           BOS:;
  56
  57                 # /^[   ]*probe /!d
  58                 unless (m /^[ \t]*probe /s)
  59                 {
  60                         $doPrint = 0;
  61                         goto EOS;
  62                 }
  63
  64                 # s/^[  ]*probe \([^(]*\)\(.*\);/\1\2/
  65                 {
  66                         $s = s /^[ \t]*probe ([^(]*)(.*);/${1}${2}/s;
  67                         $CondReg ||= $s;
  68                 }
  69
  70                 # s/__/_/g
  71                 {
  72                         $s = s /__/_/sg;
  73                         $CondReg ||= $s;
  74                 }
  75
  76                 # y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
  77                 { y{abcdefghijklmnopqrstuvwxyz}{ABCDEFGHIJKLMNOPQRSTUVWXYZ}; }
  78
  79                 # s/^/#define TRACE_POSTGRESQL_/
  80                 {
  81                         $s = s /^/#define TRACE_POSTGRESQL_/s;
  82                         $CondReg ||= $s;
  83                 }
  84
  85                 # s/([^,)]\{1,\})/(INT1)/
  86                 {
  87                         $s = s /\([^,)]+\)/(INT1)/s;
  88                         $CondReg ||= $s;
  89                 }
  90
  91                 # s/([^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2)/
  92                 {
  93                         $s = s /\([^,)]+, [^,)]+\)/(INT1, INT2)/s;
  94                         $CondReg ||= $s;
  95                 }
  96
  97                 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3)/
  98                 {
  99                         $s = s /\([^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3)/s;
 100                         $CondReg ||= $s;
 101                 }
 102
 103                 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4)/
 104                 {
 105                         $s =
 106                           s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4)/s;
 107                         $CondReg ||= $s;
 108                 }
 109
 110                 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5)/
 111                 {
 112                         $s =
 113                           s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5)/s;
 114                         $CondReg ||= $s;
 115                 }
 116
 117                 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6)/
 118                 {
 119                         $s =
 120                           s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6)/s;
 121                         $CondReg ||= $s;
 122                 }
 123
 124                 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/
 125                 {
 126                         $s =
 127                           s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/s;
 128                         $CondReg ||= $s;
 129                 }
 130
 131                 # s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/
 132                 {
 133                         $s =
 134                           s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/s;
 135                         $CondReg ||= $s;
 136                 }
 137
 138                 # P
 139                 {
 140                         if (/^(.*)/) { print $1, "\n"; }
 141                 }
 142
 143                 # s/(.*$/_ENABLED() (0)/
 144                 {
 145                         $s = s /\(.*$/_ENABLED() (0)/s;
 146                         $CondReg ||= $s;
 147                 }
 148           EOS: if ($doPrint)
 149                 {
 150                         print $_, "\n";
 151                 }
 152                 else
 153                 {
 154                         $doPrint = $doAutoPrint;
 155                 }
 156                 printQ() if @Q;
 157         }
 158
 159         exit(0);
 160 }
 161 Run();
 162
 163 # openARGV: open 1st input file
 164 #
 165 sub openARGV()
 166 {
 167         unshift(@ARGV, '-') unless @ARGV;
 168         my $file = shift(@ARGV);
 169         open(ARG, "<$file")
 170           || die("$0: can't open $file for reading ($!)\n");
 171         $isEOF = 0;
 172 }
 173
 174 # getsARGV: Read another input line into argument (default: $_).
 175 #           Move on to next input file, and reset EOF flag $isEOF.
 176 sub getsARGV(;\$)
 177 {
 178         my $argref = @_ ? shift() : \$_;
 179         while ($isEOF || !defined($$argref = <ARG>))
 180         {
 181                 close(ARG);
 182                 return 0 unless @ARGV;
 183                 my $file = shift(@ARGV);
 184                 open(ARG, "<$file")
 185                   || die("$0: can't open $file for reading ($!)\n");
 186                 $isEOF = 0;
 187         }
 188         1;
 189 }
 190
 191 # eofARGV: end-of-file test
 192 #
 193 sub eofARGV()
 194 {
 195         return @ARGV == 0 && ($isEOF = eof(ARG));
 196 }
 197
 198 # makeHandle: Generates another file handle for some file (given by its path)
 199 #             to be written due to a w command or an s command's w flag.
 200 sub makeHandle($)
 201 {
 202         my ($path) = @_;
 203         my $handle;
 204         if (!exists($wFiles{$path}) || $wFiles{$path} eq '')
 205         {
 206                 $handle = $wFiles{$path} = gensym();
 207                 if ($doOpenWrite)
 208                 {
 209                         if (!open($handle, ">$path"))
 210                         {
 211                                 die("$0: can't open $path for writing: ($!)\n");
 212                         }
 213                 }
 214         }
 215         else
 216         {
 217                 $handle = $wFiles{$path};
 218         }
 219         return $handle;
 220 }
 221
 222 # printQ: Print queued output which is either a string or a reference
 223 #         to a pathname.
 224 sub printQ()
 225 {
 226         for my $q (@Q)
 227         {
 228                 if (ref($q))
 229                 {
 230
 231                         # flush open w files so that reading this file gets it all
 232                         if (exists($wFiles{$$q}) && $wFiles{$$q} ne '')
 233                         {
 234                                 open($wFiles{$$q}, ">>$$q");
 235                         }
 236
 237                         # copy file to stdout: slow, but safe
 238                         if (open(RF, "<$$q"))
 239                         {
 240                                 while (defined(my $line = <RF>))
 241                                 {
 242                                         print $line;
 243                                 }
 244                                 close(RF);
 245                         }
 246                 }
 247                 else
 248                 {
 249                         print $q;
 250                 }
 251         }
 252         undef(@Q);
 253 }