configpm

   1 #!./miniperl -w
   2
   3 $config_pm = $ARGV[0] || 'lib/Config.pm';
   4 @ARGV = "./config.sh";
   5
   6 # list names to put first (and hence lookup fastest)
   7 @fast = qw(archname osname osvers prefix libs libpth
   8         dynamic_ext static_ext extensions dlsrc so
   9         sig_name cc ccflags cppflags
  10         privlibexp archlibexp installprivlib installarchlib
  11         sharpbang startsh shsharp
  12 );
  13
  14 # names of things which may need to have slashes changed to double-colons
  15 @extensions = qw(dynamic_ext static_ext extensions known_extensions);
  16
  17
  18 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
  19 $myver = sprintf("%.3f", $]);
  20
  21 print CONFIG <<"ENDOFBEG";
  22 package Config;
  23 use Exporter ();
  24 \@ISA = (Exporter);
  25 \@EXPORT = qw(%Config);
  26 \@EXPORT_OK = qw(myconfig config_sh config_vars);
  27
  28 \$] == $myver or die sprintf
  29     "Perl lib version ($myver) doesn't match executable version (%.3f)\\n", \$];
  30
  31 # This file was created by configpm when Perl was built. Any changes
  32 # made to this file will be lost the next time perl is built.
  33
  34 ENDOFBEG
  35
  36
  37 @fast{@fast} = @fast;
  38 @extensions{@extensions} = @extensions;
  39 @non_v=();
  40 @v_fast=();
  41 @v_others=();
  42
  43 while (<>) {
  44     next if m:^#!/bin/sh:;
  45     # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
  46     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
  47     unless (m/^(\w+)='(.*)'\s*$/){
  48         push(@non_v, "#$_"); # not a name='value' line
  49         next;
  50     }
  51     $name = $1;
  52     if ($extensions{$name}) { s,/,::,g }
  53     if (!$fast{$name}){ push(@v_others, $_); next; }
  54     push(@v_fast,$_);
  55 }
  56
  57 foreach(@non_v){ print CONFIG $_ }
  58
  59 print CONFIG "\n",
  60     "my \$config_sh = <<'!END!';\n",
  61     join("", @v_fast, sort @v_others),
  62     "!END!\n\n";
  63
  64 # copy config summary format from the myconfig script
  65
  66 print CONFIG "my \$summary = <<'!END!';\n";
  67
  68 open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
  69 1 while( ($_=<MYCONFIG>) !~ /^Summary of/);
  70 do { print CONFIG $_ } until ($_ = <MYCONFIG>) =~ /^\s*$/;
  71 close(MYCONFIG);
  72
  73 print CONFIG "\n!END!\n", <<'EOT';
  74 my $summary_expanded = 0;
  75
  76 sub myconfig {
  77         return $summary if $summary_expanded;
  78         $summary =~ s/\$(\w+)/$Config{$1}/ge;
  79         $summary_expanded = 1;
  80         $summary;
  81 }
  82 EOT
  83
  84 # ----
  85
  86 print CONFIG <<'ENDOFEND';
  87
  88 tie %Config, Config;
  89 sub TIEHASH { bless {} }
  90 sub FETCH {
  91     # check for cached value (which maybe undef so we use exists not defined)
  92     return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
  93
  94     my($value); # search for the item in the big $config_sh string
  95     return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
  96
  97     $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
  98     $_[0]->{$_[1]} = $value; # cache it
  99     return $value;
 100 }
 101
 102 my $prevpos = 0;
 103
 104 sub FIRSTKEY {
 105     $prevpos = 0;
 106     my($key) = $config_sh =~ m/^(.*?)=/;
 107     $key;
 108 }
 109
 110 sub NEXTKEY {
 111     my $pos = index($config_sh, "\n", $prevpos) + 1;
 112     my $len = index($config_sh, "=", $pos) - $pos;
 113     $prevpos = $pos;
 114     $len > 0 ? substr($config_sh, $pos, $len) : undef;
 115 }
 116
 117 sub EXISTS {
 118      exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
 119 }
 120
 121 sub STORE  { die "\%Config::Config is read-only\n" }
 122 sub DELETE { &STORE }
 123 sub CLEAR  { &STORE }
 124
 125
 126 sub config_sh {
 127     $config_sh
 128 }
 129 sub config_vars {
 130     foreach(@_){
 131         my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
 132         $v='undef' unless defined $v;
 133         print "$_='$v';\n";
 134     }
 135 }
 136
 137 1;
 138 __END__
 139
 140 =head1 NAME
 141
 142 Config - access Perl configuration information
 143
 144 =head1 SYNOPSIS
 145
 146     use Config;
 147     if ($Config{'cc'} =~ /gcc/) {
 148         print "built by gcc\n";
 149     }
 150
 151     use Config qw(myconfig config_sh config_vars);
 152
 153     print myconfig();
 154
 155     print config_sh();
 156
 157     config_vars(qw(osname archname));
 158
 159
 160 =head1 DESCRIPTION
 161
 162 The Config module contains all the information that was available to
 163 the C<Configure> program at Perl build time (over 900 values).
 164
 165 Shell variables from the F<config.sh> file (written by Configure) are
 166 stored in the readonly-variable C<%Config>, indexed by their names.
 167
 168 Values stored in config.sh as 'undef' are returned as undefined
 169 values.  The perl C<exists> function can be used to check is a
 170 named variable exists.
 171
 172 =over 4
 173
 174 =item myconfig()
 175
 176 Returns a textual summary of the major perl configuration values.
 177 See also C<-V> in L<perlrun/Switches>.
 178
 179 =item config_sh()
 180
 181 Returns the entire perl configuration information in the form of the
 182 original config.sh shell variable assignment script.
 183
 184 =item config_vars(@names)
 185
 186 Prints to STDOUT the values of the named configuration variable. Each is
 187 printed on a separate line in the form:
 188
 189   name='value';
 190
 191 Names which are unknown are output as C<name='UNKNOWN';>.
 192 See also C<-V:name> in L<perlrun/Switches>.
 193
 194 =back
 195
 196 =head1 EXAMPLE
 197
 198 Here's a more sophisticated example of using %Config:
 199
 200     use Config;
 201
 202     defined $Config{sig_name} || die "No sigs?";
 203     foreach $name (split(' ', $Config{sig_name})) {
 204         $signo{$name} = $i;
 205         $signame[$i] = $name;
 206         $i++;
 207     }
 208
 209     print "signal #17 = $signame[17]\n";
 210     if ($signo{ALRM}) {
 211         print "SIGALRM is $signo{ALRM}\n";
 212     }
 213
 214 =head1 WARNING
 215
 216 Because this information is not stored within the perl executable
 217 itself it is possible (but unlikely) that the information does not
 218 relate to the actual perl binary which is being used to access it.
 219
 220 The Config module is installed into the architecture and version
 221 specific library directory ($Config{installarchlib}) and it checks the
 222 perl version number when loaded.
 223
 224 =head1 NOTE
 225
 226 This module contains a good example of how to use tie to implement a
 227 cache and an example of how to make a tied variable readonly to those
 228 outside of it.
 229
 230 =cut
 231
 232 ENDOFEND
 233
 234 close(CONFIG);
 235
 236 # Now do some simple tests on the Config.pm file we have created
 237 unshift(@INC,'lib');
 238 require $config_pm;
 239 import Config;
 240
 241 die "$0: $config_pm not valid"
 242         unless $Config{'CONFIG'} eq 'true';
 243
 244 die "$0: error processing $config_pm"
 245         if defined($Config{'an impossible name'})
 246         or $Config{'CONFIG'} ne 'true' # test cache
 247         ;
 248
 249 die "$0: error processing $config_pm"
 250         if eval '$Config{"cc"} = 1'
 251         or eval 'delete $Config{"cc"}'
 252         ;
 253
 254
 255 exit 0;