1
2# Copyright (c) 2021, PostgreSQL Global Development Group
3
4# src/pl/plperl/text2macro.pl
5
6=head1 NAME
7
8text2macro.pl - convert text files into C string-literal macro definitions
9
10=head1 SYNOPSIS
11
12  text2macro [options] file ... > output.h
13
14Options:
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
22Reads one or more text files and outputs a corresponding series of C
23pre-processor macro definitions. Each macro defines a string literal that
24contains the contents of the corresponding text file. The basename of the text
25file as capitalized and used as the name of the macro, along with an optional prefix.
26
27=cut
28
29use strict;
30use warnings;
31
32use Getopt::Long;
33
34GetOptions(
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
40die "No text files specified"
41  unless @ARGV;
42
43print 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
50for 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
76print "/* end */\n";
77
78exit 0;
79
80
81sub 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}
107