1 files changed, 106 insertions, 0 deletions
diff --git a/src/pl/plperl/text2macro.pl b/src/pl/plperl/text2macro.pl
new file mode 100644
index 0000000..70b7c3f
--- /dev/null
+++ b/src/pl/plperl/text2macro.pl
@@ -0,0 +1,106 @@
+
+# Copyright (c) 2021-2022, PostgreSQL Global Development Group
+
+# src/pl/plperl/text2macro.pl
+
+=head1 NAME
+
+text2macro.pl - convert text files into C string-literal macro definitions
+
+=head1 SYNOPSIS
+
+  text2macro [options] file ... > output.h
+
+Options:
+
+  --prefix=S   - add prefix S to the names of the macros
+  --name=S     - use S as the macro name (assumes only one file)
+  --strip=S    - don't include lines that match perl regex S
+
+=head1 DESCRIPTION
+
+Reads one or more text files and outputs a corresponding series of C
+pre-processor macro definitions. Each macro defines a string literal that
+contains the contents of the corresponding text file. The basename of the text
+file as capitalized and used as the name of the macro, along with an optional prefix.
+
+=cut
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+
+GetOptions(
+	'prefix=s'  => \my $opt_prefix,
+	'name=s'    => \my $opt_name,
+	'strip=s'   => \my $opt_strip,
+	'selftest!' => sub { exit selftest() },) or exit 1;
+
+die "No text files specified"
+  unless @ARGV;
+
+print qq{
+/*
+ * DO NOT EDIT - THIS FILE IS AUTOGENERATED - CHANGES WILL BE LOST
+ * Generated by src/pl/plperl/text2macro.pl
+ */
+};
+
+for my $src_file (@ARGV)
+{
+
+	(my $macro = $src_file) =~ s/ .*? (\w+) (?:\.\w+) $/$1/x;
+
+	open my $src_fh, '<', $src_file
+	  or die "Can't open $src_file: $!";
+
+	printf qq{#define %s%s \\\n},
+	  $opt_prefix || '',
+	  ($opt_name) ? $opt_name : uc $macro;
+	while (<$src_fh>)
+	{
+		chomp;
+
+		next if $opt_strip and m/$opt_strip/o;
+
+		# escape the text to suite C string literal rules
+		s/\\/\\\\/g;
+		s/"/\\"/g;
+
+		printf qq{"%s\\n" \\\n}, $_;
+	}
+	print qq{""\n\n};
+}
+
+print "/* end */\n";
+
+exit 0;
+
+
+sub selftest
+{
+	my $tmp    = "text2macro_tmp";
+	my $string = q{a '' '\\'' "" "\\"" "\\\\" "\\\\n" b};
+
+	open my $fh, '>', "$tmp.pl" or die;
+	print $fh $string;
+	close $fh;
+
+	system("perl $0 --name=X $tmp.pl > $tmp.c") == 0 or die;
+	open $fh, '>>', "$tmp.c";
+	print $fh "#include <stdio.h>\n";
+	print $fh "int main() { puts(X); return 0; }\n";
+	close $fh;
+	system("cat -n $tmp.c");
+
+	system("make $tmp") == 0 or die;
+	open $fh, '<', "./$tmp |" or die;
+	my $result = <$fh>;
+	unlink <$tmp.*>;
+
+	warn "Test string: $string\n";
+	warn "Result     : $result";
+	die "Failed!" if $result ne "$string\n";
+	return;
+}