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