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