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
|
#! /usr/bin/perl -w
#---------------------------------------------------------------------
# $Id: genfile.pl 4653 2005-11-12 04:31:57Z cjm $
# 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, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#--------------------------------------------------------------------
use strict;
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);
## 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
|
