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