/
rewrite-config-test.PL
179 lines (132 loc) · 4.07 KB
/
rewrite-config-test.PL
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
# Copyright 2008 LibLime
#
# This file is part of Koha.
#
# Koha 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.
#
# Koha 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
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
#
use strict;
use warnings;
use Sys::Hostname;
use Socket;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper;
# These variables get set from command line options
my ( $fname );
GetOptions( 'file=s', \$fname )
or pod2usage();
=head1 NAME
rewrite-test-config.PL - helper for the Koha packager and installer
=head1 SYNOPSIS
perl rewrite-test-config.PL configurationfile
=head1 DESCRIPTION
This helper script replaces keywords in the
configuration file with value either supplied through
the environment
I intend to make this part of hte normal make process eventually.
=head2 KEYWORDS
The following configuration keywords are available:
=head1 EXAMPLES
=cut
my $configfile = 'test-config.txt';
my $configuration = read_config_file( $configfile );
# Override configuration from the environment
foreach my $key (keys %$configuration) {
if (defined($ENV{$key})) {
$configuration->{$key} = $ENV{$key};
}
}
$configuration = add_underscores( $configuration );
my %configuration = replace_test_params( $configuration );
my $file = read_file($fname);
$file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg;
# At this point, file is in 'blib' and by default
# has mode a-w. Therefore, must change permission
# to make it writable. Note that stat and chmod
# (the Perl functions) should work on Win32
my $old_perm;
$old_perm = (stat $fname)[2] & 07777;
my $new_perm = $old_perm | 0200;
chmod $new_perm, $fname;
open(OUTPUT,">$fname") || die "Can't open $fname for write: $!";
print OUTPUT $file;
close(OUTPUT);
chmod $old_perm, $fname;
=head2 read_config_file
takes the filename pointing to the configuration file that the
top-level Makefile wrote
returns a hashref that contains the configuration determined by
that file.
=cut
sub read_config_file {
my $config_file = shift;
if ( not -e $config_file ) {
die "unable to find configuration file: $config_file";
}
my $config;
if ( open( my $confighandle, '<', $config_file ) ) {
while ( my $line = <$confighandle> ) {
chomp $line;
next if ( $line eq '' );
next if ( $line =~ /^\s*#/ );
my ( $var, $value ) = split( /\s*=\s*/, $line );
$config->{ $var } = $value;
}
} else {
warn "unable to open configuration file: $config_file";
return;
}
return $config;
}
=head2 add_underscores
=cut
sub add_underscores {
my $config = shift;
my $newconfig;
foreach my $key ( keys %$config ) {
$newconfig->{ '__' . $key . '__' } = $config->{ $key };
}
return $newconfig;
}
=head2 replace_test_params
=cut
sub replace_test_params {
my $config = shift;
my $testconfig;
foreach my $key ( keys %$config ) {
if ( $key =~ /^__TEST_/ ) {
my $newkey = $key;
$newkey =~ s/^__TEST_/__/;
$testconfig->{ $newkey } = $config->{ $key };
}
}
# override variables with the "TEST_" variety.
my %newconfig = ( %$config, %$testconfig );
return %newconfig;
}
# Idea taken from perlfaq5
sub read_file {
local(*INPUT,$/);
open(INPUT,$_[0]) || die "Can't open $_[0] for read";
my $file = <INPUT>;
return $file;
}
__END__
=head1 SEE ALSO
Makefile.PL, ExtUtils::MakeMaker(3)
=head1 ACKNOWLEDGEMENTS
based on rewrite-config.PL by MJ Ray.
=head1 AUTHOR
Andrew Moore <andrew.moore@liblime.com>
=cut