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 sig_num 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 = $];
  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
  29   or die "Perl lib version ($myver) doesn't match executable version (\$])";
  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 $in_v = 0;
  43
  44 while (<>) {
  45     next if m:^#!/bin/sh:;
  46     # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
  47     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
  48     unless ($in_v or m/^(\w+)='(.*\n)/){
  49         push(@non_v, "#$_"); # not a name='value' line
  50         next;
  51     }
  52     if ($in_v) { $val .= $_;             }
  53     else       { ($name,$val) = ($1,$2); }
  54     $in_v = $val !~ /'\n/;
  55     next if $in_v;
  56     if ($extensions{$name}) { s,/,::,g }
  57     if (!$fast{$name}){ push(@v_others, "$name='$val"); next; }
  58     push(@v_fast,"$name='$val");
  59 }
  60
  61 foreach(@non_v){ print CONFIG $_ }
  62
  63 print CONFIG "\n",
  64     "my \$config_sh = <<'!END!';\n",
  65     join("", @v_fast, sort @v_others),
  66     "!END!\n\n";
  67
  68 # copy config summary format from the myconfig script
  69
  70 print CONFIG "my \$summary = <<'!END!';\n";
  71
  72 open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
  73 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
  74 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
  75 close(MYCONFIG);
  76
  77 print CONFIG "\n!END!\n", <<'EOT';
  78 my $summary_expanded = 0;
  79
  80 sub myconfig {
  81         return $summary if $summary_expanded;
  82         $summary =~ s/\$(\w+)/$Config{$1}/ge;
  83         $summary_expanded = 1;
  84         $summary;
  85 }
  86 EOT
  87
  88 # ----
  89
  90 print CONFIG <<'ENDOFEND';
  91
  92 sub FETCH {
  93     # check for cached value (which may be undef so we use exists not defined)
  94     return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
  95
  96     # Search for it in the big string
  97     my($value, $start, $marker);
  98     $marker = "$_[1]='";
  99     # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
 100     $start = index($config_sh, "\n$marker");
 101     return undef if ( ($start == -1) &&  # in case it's first
 102         (substr($config_sh, 0, length($marker)) ne $marker) );
 103     if ($start == -1) { $start = length($marker) }
 104         else { $start += length($marker) + 1 }
 105     $value = substr($config_sh, $start,
 106         index($config_sh, qq('\n), $start) - $start);
 107
 108     $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
 109     $_[0]->{$_[1]} = $value; # cache it
 110     return $value;
 111 }
 112
 113 my $prevpos = 0;
 114
 115 sub FIRSTKEY {
 116     $prevpos = 0;
 117     # my($key) = $config_sh =~ m/^(.*?)=/;
 118     substr($config_sh, 0, index($config_sh, '=') );
 119     # $key;
 120 }
 121
 122 sub NEXTKEY {
 123     my $pos = index($config_sh, qq('\n), $prevpos) + 2;
 124     my $len = index($config_sh, "=", $pos) - $pos;
 125     $prevpos = $pos;
 126     $len > 0 ? substr($config_sh, $pos, $len) : undef;
 127 }
 128
 129 sub EXISTS {
 130     # exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
 131     exists($_[0]->{$_[1]}) or
 132     index($config_sh, "\n$_[1]='") != -1 or
 133     substr($config_sh, 0, length($_[1])+2) eq "$_[1]='";
 134 }
 135
 136 sub STORE  { die "\%Config::Config is read-only\n" }
 137 sub DELETE { &STORE }
 138 sub CLEAR  { &STORE }
 139
 140
 141 sub config_sh {
 142     $config_sh
 143 }
 144
 145 sub config_re {
 146     my $re = shift;
 147     my @matches = ($config_sh =~ /^$re=.*\n/mg);
 148     @matches ? (print @matches) : print "$re: not found\n";
 149 }
 150
 151 sub config_vars {
 152     foreach(@_){
 153         config_re($_), next if /\W/;
 154         my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
 155         $v='undef' unless defined $v;
 156         print "$_='$v';\n";
 157     }
 158 }
 159
 160 ENDOFEND
 161
 162 if ($^O eq 'os2') {
 163   print CONFIG <<'ENDOFSET';
 164 my %preconfig;
 165 if ($OS2::is_aout) {
 166     my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
 167     for (split ' ', $value) {
 168         ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
 169         $preconfig{$_} = $v eq 'undef' ? undef : $v;
 170     }
 171 }
 172 sub TIEHASH { bless {%preconfig} }
 173 ENDOFSET
 174 } else {
 175   print CONFIG <<'ENDOFSET';
 176 sub TIEHASH { bless {} }
 177 ENDOFSET
 178 }
 179
 180 print CONFIG <<'ENDOFTAIL';
 181
 182 tie %Config, 'Config';
 183
 184 1;
 185 __END__
 186
 187 =head1 NAME
 188
 189 Config - access Perl configuration information
 190
 191 =head1 SYNOPSIS
 192
 193     use Config;
 194     if ($Config{'cc'} =~ /gcc/) {
 195         print "built by gcc\n";
 196     }
 197
 198     use Config qw(myconfig config_sh config_vars);
 199
 200     print myconfig();
 201
 202     print config_sh();
 203
 204     config_vars(qw(osname archname));
 205
 206
 207 =head1 DESCRIPTION
 208
 209 The Config module contains all the information that was available to
 210 the C<Configure> program at Perl build time (over 900 values).
 211
 212 Shell variables from the F<config.sh> file (written by Configure) are
 213 stored in the readonly-variable C<%Config>, indexed by their names.
 214
 215 Values stored in config.sh as 'undef' are returned as undefined
 216 values.  The perl C<exists> function can be used to check if a
 217 named variable exists.
 218
 219 =over 4
 220
 221 =item myconfig()
 222
 223 Returns a textual summary of the major perl configuration values.
 224 See also C<-V> in L<perlrun/Switches>.
 225
 226 =item config_sh()
 227
 228 Returns the entire perl configuration information in the form of the
 229 original config.sh shell variable assignment script.
 230
 231 =item config_vars(@names)
 232
 233 Prints to STDOUT the values of the named configuration variable. Each is
 234 printed on a separate line in the form:
 235
 236   name='value';
 237
 238 Names which are unknown are output as C<name='UNKNOWN';>.
 239 See also C<-V:name> in L<perlrun/Switches>.
 240
 241 =back
 242
 243 =head1 EXAMPLE
 244
 245 Here's a more sophisticated example of using %Config:
 246
 247     use Config;
 248     use strict;
 249
 250     my %sig_num;
 251     my @sig_name;
 252     unless($Config{sig_name} && $Config{sig_num}) {
 253         die "No sigs?";
 254     } else {
 255         my @names = split ' ', $Config{sig_name};
 256         @sig_num{@names} = split ' ', $Config{sig_num};
 257         foreach (@names) {
 258             $sig_name[$sig_num{$_}] ||= $_;
 259         }
 260     }
 261
 262     print "signal #17 = $sig_name[17]\n";
 263     if ($sig_num{ALRM}) {
 264         print "SIGALRM is $sig_num{ALRM}\n";
 265     }
 266
 267 =head1 WARNING
 268
 269 Because this information is not stored within the perl executable
 270 itself it is possible (but unlikely) that the information does not
 271 relate to the actual perl binary which is being used to access it.
 272
 273 The Config module is installed into the architecture and version
 274 specific library directory ($Config{installarchlib}) and it checks the
 275 perl version number when loaded.
 276
 277 =head1 NOTE
 278
 279 This module contains a good example of how to use tie to implement a
 280 cache and an example of how to make a tied variable readonly to those
 281 outside of it.
 282
 283 =cut
 284
 285 ENDOFTAIL
 286
 287 close(CONFIG);
 288
 289 # Now do some simple tests on the Config.pm file we have created
 290 unshift(@INC,'lib');
 291 require $config_pm;
 292 import Config;
 293
 294 die "$0: $config_pm not valid"
 295         unless $Config{'CONFIG'} eq 'true';
 296
 297 die "$0: error processing $config_pm"
 298         if defined($Config{'an impossible name'})
 299         or $Config{'CONFIG'} ne 'true' # test cache
 300         ;
 301
 302 die "$0: error processing $config_pm"
 303         if eval '$Config{"cc"} = 1'
 304         or eval 'delete $Config{"cc"}'
 305         ;
 306
 307
 308 exit 0;