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