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 tie %Config, 'Config';
 184
 185 1;
 186 __END__
 187
 188 =head1 NAME
 189
 190 Config - access Perl configuration information
 191
 192 =head1 SYNOPSIS
 193
 194     use Config;
 195     if ($Config{'cc'} =~ /gcc/) {
 196         print "built by gcc\n";
 197     }
 198
 199     use Config qw(myconfig config_sh config_vars);
 200
 201     print myconfig();
 202
 203     print config_sh();
 204
 205     config_vars(qw(osname archname));
 206
 207
 208 =head1 DESCRIPTION
 209
 210 The Config module contains all the information that was available to
 211 the C<Configure> program at Perl build time (over 900 values).
 212
 213 Shell variables from the F<config.sh> file (written by Configure) are
 214 stored in the readonly-variable C<%Config>, indexed by their names.
 215
 216 Values stored in config.sh as 'undef' are returned as undefined
 217 values.  The perl C<exists> function can be used to check if a
 218 named variable exists.
 219
 220 =over 4
 221
 222 =item myconfig()
 223
 224 Returns a textual summary of the major perl configuration values.
 225 See also C<-V> in L<perlrun/Switches>.
 226
 227 =item config_sh()
 228
 229 Returns the entire perl configuration information in the form of the
 230 original config.sh shell variable assignment script.
 231
 232 =item config_vars(@names)
 233
 234 Prints to STDOUT the values of the named configuration variable. Each is
 235 printed on a separate line in the form:
 236
 237   name='value';
 238
 239 Names which are unknown are output as C<name='UNKNOWN';>.
 240 See also C<-V:name> in L<perlrun/Switches>.
 241
 242 =back
 243
 244 =head1 EXAMPLE
 245
 246 Here's a more sophisticated example of using %Config:
 247
 248     use Config;
 249     use strict;
 250
 251     my %sig_num;
 252     my @sig_name;
 253     unless($Config{sig_name} && $Config{sig_num}) {
 254         die "No sigs?";
 255     } else {
 256         my @names = split ' ', $Config{sig_name};
 257         @sig_num{@names} = split ' ', $Config{sig_num};
 258         foreach (@names) {
 259             $sig_name[$sig_num{$_}] ||= $_;
 260         }
 261     }
 262
 263     print "signal #17 = $sig_name[17]\n";
 264     if ($sig_num{ALRM}) {
 265         print "SIGALRM is $sig_num{ALRM}\n";
 266     }
 267
 268 =head1 WARNING
 269
 270 Because this information is not stored within the perl executable
 271 itself it is possible (but unlikely) that the information does not
 272 relate to the actual perl binary which is being used to access it.
 273
 274 The Config module is installed into the architecture and version
 275 specific library directory ($Config{installarchlib}) and it checks the
 276 perl version number when loaded.
 277
 278 =head1 NOTE
 279
 280 This module contains a good example of how to use tie to implement a
 281 cache and an example of how to make a tied variable readonly to those
 282 outside of it.
 283
 284 =cut
 285
 286 ENDOFTAIL
 287
 288 close(CONFIG);
 289
 290 # Now do some simple tests on the Config.pm file we have created
 291 unshift(@INC,'lib');
 292 require $config_pm;
 293 import Config;
 294
 295 die "$0: $config_pm not valid"
 296         unless $Config{'CONFIG'} eq 'true';
 297
 298 die "$0: error processing $config_pm"
 299         if defined($Config{'an impossible name'})
 300         or $Config{'CONFIG'} ne 'true' # test cache
 301         ;
 302
 303 die "$0: error processing $config_pm"
 304         if eval '$Config{"cc"} = 1'
 305         or eval 'delete $Config{"cc"}'
 306         ;
 307
 308
 309 exit 0;