t/rewrite-config-test.PL

   1 # Copyright 2008 LibLime
   2 #
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 2 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along with
  15 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  16 # Suite 330, Boston, MA  02111-1307 USA
  17 #
  18
  19 use strict;
  20 use warnings;
  21
  22 use Sys::Hostname;
  23 use Socket;
  24 use Getopt::Long;
  25 use Pod::Usage;
  26 use Data::Dumper;
  27
  28 # These variables get set from command line options
  29 my ( $fname );
  30 GetOptions( 'file=s', \$fname )
  31   or pod2usage();
  32
  33
  34 =head1 NAME
  35
  36 rewrite-test-config.PL - helper for the Koha packager and installer
  37
  38 =head1 SYNOPSIS
  39
  40         perl rewrite-test-config.PL configurationfile
  41
  42 =head1 DESCRIPTION
  43
  44 This helper script replaces keywords in the
  45 configuration file with value either supplied through
  46 the environment
  47
  48 I intend to make this part of hte normal make process eventually.
  49
  50 =head2 KEYWORDS
  51
  52 The following configuration keywords are available:
  53
  54 =head1 EXAMPLES
  55
  56 =cut
  57
  58 my $configfile = 'test-config.txt';
  59 my $configuration = read_config_file( $configfile );
  60
  61 # Override configuration from the environment
  62 foreach my $key (keys %$configuration) {
  63   if (defined($ENV{$key})) {
  64     $configuration->{$key} = $ENV{$key};
  65   }
  66 }
  67
  68 $configuration = add_underscores( $configuration );
  69 my %configuration = replace_test_params( $configuration );
  70
  71 my $file = read_file($fname);
  72 $file =~ s/__.*?__/exists $configuration{$&} ? $configuration{$&} : $&/seg;
  73
  74 # At this point, file is in 'blib' and by default
  75 # has mode a-w.  Therefore, must change permission
  76 # to make it writable.  Note that stat and chmod
  77 # (the Perl functions) should work on Win32
  78 my $old_perm;
  79 $old_perm = (stat $fname)[2] & 07777;
  80 my $new_perm = $old_perm | 0200;
  81 chmod $new_perm, $fname;
  82
  83 open(OUTPUT,">$fname") || die "Can't open $fname for write: $!";
  84 print OUTPUT $file;
  85 close(OUTPUT);
  86
  87 chmod $old_perm, $fname;
  88
  89 =head2 read_config_file
  90
  91   takes the filename pointing to the configuration file that the
  92   top-level Makefile wrote
  93
  94   returns a hashref that contains the configuration determined by
  95   that file.
  96
  97 =cut
  98
  99 sub read_config_file {
 100     my $config_file = shift;
 101     if ( not -e $config_file ) {
 102         die "unable to find configuration file: $config_file";
 103     }
 104     my $config;
 105     if ( open( my $confighandle, '<', $config_file ) ) {
 106         while ( my $line = <$confighandle> ) {
 107             chomp $line;
 108             next if ( $line eq '' );
 109             next if ( $line =~ /^\s*#/ );
 110             my ( $var, $value ) = split( /\s*=\s*/, $line );
 111             $config->{ $var } = $value;
 112         }
 113     } else {
 114         warn "unable to open configuration file: $config_file";
 115         return;
 116     }
 117     return $config;
 118 }
 119
 120 =head2 add_underscores
 121
 122 =cut
 123
 124 sub add_underscores {
 125     my $config = shift;
 126
 127     my $newconfig;
 128     foreach my $key ( keys %$config ) {
 129         $newconfig->{ '__' . $key . '__' } = $config->{ $key };
 130     }
 131     return $newconfig;
 132 }
 133
 134
 135 =head2 replace_test_params
 136
 137 =cut
 138
 139 sub replace_test_params {
 140     my $config = shift;
 141
 142     my $testconfig;
 143     foreach my $key ( keys %$config ) {
 144         if ( $key =~ /^__TEST_/ ) {
 145             my $newkey = $key;
 146             $newkey =~ s/^__TEST_/__/;
 147             $testconfig->{ $newkey } = $config->{ $key };
 148         }
 149     }
 150     # override variables with the "TEST_" variety.
 151     my %newconfig = ( %$config, %$testconfig );
 152     return %newconfig;
 153 }
 154
 155 # Idea taken from perlfaq5
 156 sub read_file {
 157   local(*INPUT,$/);
 158   open(INPUT,$_[0]) || die "Can't open $_[0] for read";
 159   my $file = <INPUT>;
 160   return $file;
 161 }
 162
 163 __END__
 164
 165
 166 =head1 SEE ALSO
 167
 168 Makefile.PL, ExtUtils::MakeMaker(3)
 169
 170 =head1 ACKNOWLEDGEMENTS
 171
 172 based on rewrite-config.PL by MJ Ray.
 173
 174 =head1 AUTHOR
 175
 176 Andrew Moore <andrew.moore@liblime.com>
 177
 178 =cut
 179