src/pl/plperl/text2macro.pl

   1
   2 # Copyright (c) 2021, PostgreSQL Global Development Group
   3
   4 # src/pl/plperl/text2macro.pl
   5
   6 =head1 NAME
   7
   8 text2macro.pl - convert text files into C string-literal macro definitions
   9
  10 =head1 SYNOPSIS
  11
  12   text2macro [options] file ... > output.h
  13
  14 Options:
  15
  16   --prefix=S   - add prefix S to the names of the macros
  17   --name=S     - use S as the macro name (assumes only one file)
  18   --strip=S    - don't include lines that match perl regex S
  19
  20 =head1 DESCRIPTION
  21
  22 Reads one or more text files and outputs a corresponding series of C
  23 pre-processor macro definitions. Each macro defines a string literal that
  24 contains the contents of the corresponding text file. The basename of the text
  25 file as capitalized and used as the name of the macro, along with an optional prefix.
  26
  27 =cut
  28
  29 use strict;
  30 use warnings;
  31
  32 use Getopt::Long;
  33
  34 GetOptions(
  35         'prefix=s'  => \my $opt_prefix,
  36         'name=s'    => \my $opt_name,
  37         'strip=s'   => \my $opt_strip,
  38         'selftest!' => sub { exit selftest() },) or exit 1;
  39
  40 die "No text files specified"
  41   unless @ARGV;
  42
  43 print qq{
  44 /*
  45  * DO NOT EDIT - THIS FILE IS AUTOGENERATED - CHANGES WILL BE LOST
  46  * Generated by src/pl/plperl/text2macro.pl
  47  */
  48 };
  49
  50 for my $src_file (@ARGV)
  51 {
  52
  53         (my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
  54
  55         open my $src_fh, '<', $src_file
  56           or die "Can't open $src_file: $!";
  57
  58         printf qq{#define %s%s \\\n},
  59           $opt_prefix || '',
  60           ($opt_name) ? $opt_name : uc $macro;
  61         while (<$src_fh>)
  62         {
  63                 chomp;
  64
  65                 next if $opt_strip and m/$opt_strip/o;
  66
  67                 # escape the text to suite C string literal rules
  68                 s/\\/\\\\/g;
  69                 s/"/\\"/g;
  70
  71                 printf qq{"%s\\n" \\\n}, $_;
  72         }
  73         print qq{""\n\n};
  74 }
  75
  76 print "/* end */\n";
  77
  78 exit 0;
  79
  80
  81 sub selftest
  82 {
  83         my $tmp    = "text2macro_tmp";
  84         my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};
  85
  86         open my $fh, '>', "$tmp.pl" or die;
  87         print $fh $string;
  88         close $fh;
  89
  90         system("perl $0 --name=X $tmp.pl > $tmp.c") == 0 or die;
  91         open $fh, '>>', "$tmp.c";
  92         print $fh "#include <stdio.h>\n";
  93         print $fh "int main() { puts(X); return 0; }\n";
  94         close $fh;
  95         system("cat -n $tmp.c");
  96
  97         system("make $tmp") == 0 or die;
  98         open $fh, '<', "./$tmp |" or die;
  99         my $result = <$fh>;
 100         unlink <$tmp.*>;
 101
 102         warn "Test string: $string\n";
 103         warn "Result     : $result";
 104         die "Failed!" if $result ne "$string\n";
 105         return;
 106 }