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