1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
#! /usr/bin/env perl
#---------------------------------------------------------------------
# genfile.pl
# Copyright 2005 Christopher J. Madsen
#
# Process files through Template Toolkit
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
#--------------------------------------------------------------------
use strict;
use warnings;
use File::Spec::Functions 'rel2abs';
use FindBin '$Bin';
use Getopt::Long;
use Template;
#---------------------------------------------------------------------
my ($redirect, @vars);
Getopt::Long::config(qw(bundling no_getopt_compat));
GetOptions(
'define|D=s' => \@vars,
'output|o=s' => \$redirect,
);
# Filenames are relative to initial working directory:
foreach (@ARGV) { $_ = rel2abs($_) }
#---------------------------------------------------------------------
# Get version information from configure.ac:
our ($name, $major, $minor);
do "$Bin/getversion.pm";
#---------------------------------------------------------------------
my %data = (
major => $major,
minor => $minor,
name => $name,
version => "$major.$minor",
map { s/=(.*)// ? ($_ => $1) : ($_ => 1) } @vars
);
my $tt = Template->new({
ABSOLUTE => 1,
INCLUDE_PATH => $Bin,
EVAL_PERL => 1,
POST_CHOMP => 1,
});
foreach my $file (@ARGV) {
my $output;
$tt->process($file, \%data, \$output) or die $tt->error;
$output =~ s/\r\n/\n/g;
## print $output;
# Get the output directive from the first non-blank line,
# and skip the line after it:
$output =~ s/^\s*([>|].+)\n.*\n// or die;
# The user can override this with the --output option:
my $outfile = ($redirect || $1);
open(OUT, $outfile) or die;
print OUT $output or die;
close OUT or die;
} # end foreach $file
|
