configpm

   1 #!./miniperl -w
   2
   3 my $config_pm = $ARGV[0] || 'lib/Config.pm';
   4 my $glossary = $ARGV[1] || 'Porting/Glossary';
   5 @ARGV = "./config.sh";
   6
   7 # list names to put first (and hence lookup fastest)
   8 @fast = qw(archname osname osvers prefix libs libpth
   9         dynamic_ext static_ext extensions dlsrc so
  10         sig_name sig_num cc ccflags cppflags
  11         privlibexp archlibexp installprivlib installarchlib
  12         sharpbang startsh shsharp
  13 );
  14
  15 # names of things which may need to have slashes changed to double-colons
  16 @extensions = qw(dynamic_ext static_ext extensions known_extensions);
  17
  18
  19 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
  20 $myver = $];
  21
  22 print CONFIG <<"ENDOFBEG";
  23 package Config;
  24 use Exporter ();
  25 \@ISA = (Exporter);
  26 \@EXPORT = qw(%Config);
  27 \@EXPORT_OK = qw(myconfig config_sh config_vars);
  28
  29 \$] == $myver
  30   or die "Perl lib version ($myver) doesn't match executable version (\$])";
  31
  32 # This file was created by configpm when Perl was built. Any changes
  33 # made to this file will be lost the next time perl is built.
  34
  35 ENDOFBEG
  36
  37
  38 @fast{@fast} = @fast;
  39 @extensions{@extensions} = @extensions;
  40 @non_v=();
  41 @v_fast=();
  42 @v_others=();
  43 $in_v = 0;
  44
  45 while (<>) {
  46     next if m:^#!/bin/sh:;
  47     # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
  48     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
  49     unless ($in_v or m/^(\w+)='(.*\n)/){
  50         push(@non_v, "#$_"); # not a name='value' line
  51         next;
  52     }
  53     if ($in_v) { $val .= $_;             }
  54     else       { ($name,$val) = ($1,$2); }
  55     $in_v = $val !~ /'\n/;
  56     next if $in_v;
  57     if ($extensions{$name}) { s,/,::,g }
  58     if (!$fast{$name}){ push(@v_others, "$name='$val"); next; }
  59     push(@v_fast,"$name='$val");
  60 }
  61
  62 foreach(@non_v){ print CONFIG $_ }
  63
  64 print CONFIG "\n",
  65     "my \$config_sh = <<'!END!';\n",
  66     join("", @v_fast, sort @v_others),
  67     "!END!\n\n";
  68
  69 # copy config summary format from the myconfig script
  70
  71 print CONFIG "my \$summary = <<'!END!';\n";
  72
  73 open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
  74 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
  75 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
  76 close(MYCONFIG);
  77
  78 print CONFIG "\n!END!\n", <<'EOT';
  79 my $summary_expanded = 0;
  80
  81 sub myconfig {
  82         return $summary if $summary_expanded;
  83         $summary =~ s{\$(\w+)}
  84                      { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
  85         $summary_expanded = 1;
  86         $summary;
  87 }
  88 EOT
  89
  90 # ----
  91
  92 print CONFIG <<'ENDOFEND';
  93
  94 sub FETCH {
  95     # check for cached value (which may be undef so we use exists not defined)
  96     return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
  97
  98     # Search for it in the big string
  99     my($value, $start, $marker);
 100     $marker = "$_[1]='";
 101     # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
 102     $start = index($config_sh, "\n$marker");
 103     return undef if ( ($start == -1) &&  # in case it's first
 104         (substr($config_sh, 0, length($marker)) ne $marker) );
 105     if ($start == -1) { $start = length($marker) }
 106         else { $start += length($marker) + 1 }
 107     $value = substr($config_sh, $start,
 108         index($config_sh, qq('\n), $start) - $start);
 109
 110     $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
 111     $_[0]->{$_[1]} = $value; # cache it
 112     return $value;
 113 }
 114
 115 my $prevpos = 0;
 116
 117 sub FIRSTKEY {
 118     $prevpos = 0;
 119     # my($key) = $config_sh =~ m/^(.*?)=/;
 120     substr($config_sh, 0, index($config_sh, '=') );
 121     # $key;
 122 }
 123
 124 sub NEXTKEY {
 125     my $pos = index($config_sh, qq('\n), $prevpos) + 2;
 126     my $len = index($config_sh, "=", $pos) - $pos;
 127     $prevpos = $pos;
 128     $len > 0 ? substr($config_sh, $pos, $len) : undef;
 129 }
 130
 131 sub EXISTS {
 132     # exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
 133     exists($_[0]->{$_[1]}) or
 134     index($config_sh, "\n$_[1]='") != -1 or
 135     substr($config_sh, 0, length($_[1])+2) eq "$_[1]='";
 136 }
 137
 138 sub STORE  { die "\%Config::Config is read-only\n" }
 139 sub DELETE { &STORE }
 140 sub CLEAR  { &STORE }
 141
 142
 143 sub config_sh {
 144     $config_sh
 145 }
 146
 147 sub config_re {
 148     my $re = shift;
 149     my @matches = ($config_sh =~ /^$re=.*\n/mg);
 150     @matches ? (print @matches) : print "$re: not found\n";
 151 }
 152
 153 sub config_vars {
 154     foreach(@_){
 155         config_re($_), next if /\W/;
 156         my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
 157         $v='undef' unless defined $v;
 158         print "$_='$v';\n";
 159     }
 160 }
 161
 162 ENDOFEND
 163
 164 if ($^O eq 'os2') {
 165   print CONFIG <<'ENDOFSET';
 166 my %preconfig;
 167 if ($OS2::is_aout) {
 168     my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
 169     for (split ' ', $value) {
 170         ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
 171         $preconfig{$_} = $v eq 'undef' ? undef : $v;
 172     }
 173 }
 174 sub TIEHASH { bless {%preconfig} }
 175 ENDOFSET
 176 } else {
 177   print CONFIG <<'ENDOFSET';
 178 sub TIEHASH { bless {} }
 179 ENDOFSET
 180 }
 181
 182 print CONFIG <<'ENDOFTAIL';
 183
 184 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
 185 sub DESTROY { }
 186
 187 tie %Config, 'Config';
 188
 189 1;
 190 __END__
 191
 192 =head1 NAME
 193
 194 Config - access Perl configuration information
 195
 196 =head1 SYNOPSIS
 197
 198     use Config;
 199     if ($Config{'cc'} =~ /gcc/) {
 200         print "built by gcc\n";
 201     }
 202
 203     use Config qw(myconfig config_sh config_vars);
 204
 205     print myconfig();
 206
 207     print config_sh();
 208
 209     config_vars(qw(osname archname));
 210
 211
 212 =head1 DESCRIPTION
 213
 214 The Config module contains all the information that was available to
 215 the C<Configure> program at Perl build time (over 900 values).
 216
 217 Shell variables from the F<config.sh> file (written by Configure) are
 218 stored in the readonly-variable C<%Config>, indexed by their names.
 219
 220 Values stored in config.sh as 'undef' are returned as undefined
 221 values.  The perl C<exists> function can be used to check if a
 222 named variable exists.
 223
 224 =over 4
 225
 226 =item myconfig()
 227
 228 Returns a textual summary of the major perl configuration values.
 229 See also C<-V> in L<perlrun/Switches>.
 230
 231 =item config_sh()
 232
 233 Returns the entire perl configuration information in the form of the
 234 original config.sh shell variable assignment script.
 235
 236 =item config_vars(@names)
 237
 238 Prints to STDOUT the values of the named configuration variable. Each is
 239 printed on a separate line in the form:
 240
 241   name='value';
 242
 243 Names which are unknown are output as C<name='UNKNOWN';>.
 244 See also C<-V:name> in L<perlrun/Switches>.
 245
 246 =back
 247
 248 =head1 EXAMPLE
 249
 250 Here's a more sophisticated example of using %Config:
 251
 252     use Config;
 253     use strict;
 254
 255     my %sig_num;
 256     my @sig_name;
 257     unless($Config{sig_name} && $Config{sig_num}) {
 258         die "No sigs?";
 259     } else {
 260         my @names = split ' ', $Config{sig_name};
 261         @sig_num{@names} = split ' ', $Config{sig_num};
 262         foreach (@names) {
 263             $sig_name[$sig_num{$_}] ||= $_;
 264         }
 265     }
 266
 267     print "signal #17 = $sig_name[17]\n";
 268     if ($sig_num{ALRM}) {
 269         print "SIGALRM is $sig_num{ALRM}\n";
 270     }
 271
 272 =head1 WARNING
 273
 274 Because this information is not stored within the perl executable
 275 itself it is possible (but unlikely) that the information does not
 276 relate to the actual perl binary which is being used to access it.
 277
 278 The Config module is installed into the architecture and version
 279 specific library directory ($Config{installarchlib}) and it checks the
 280 perl version number when loaded.
 281
 282 =head1 GLOSSARY
 283
 284 Most C<Config> variables are determined by the C<Configure> script
 285 on platforms supported by it (which is most UNIX platforms).  Some
 286 platforms have custom-made C<Config> variables, and may thus not have
 287 some of the variables described below, or may have extraneous variables
 288 specific to that particular port.  See the port specific documentation
 289 in such cases.
 290
 291 =over 4
 292
 293 ENDOFTAIL
 294
 295 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
 296
 297 my ($var,$unit,$indentpara);
 298 my $text = "";
 299 while (<GLOS>) {
 300     if (/^\s*(.*)\s*\(\s*(.+\.U)\s*\):\s*$/) {
 301         print CONFIG "\n=item $var\n\n$text\n" if $var and $text;
 302         ($var,$unit,$text) = ($1,$2,"");
 303     }
 304     else {
 305         # bite off exactly one tab-width
 306         s/^([ ]{8}|[ ]{0,7}\t)//;
 307
 308         # indented stuff starts a separate paragraph
 309         if (/^\s/) {
 310             $text .= "\n" unless $indentpara;
 311             $indentpara = 1;
 312         }
 313         else {
 314             $text .= "\n" if $indentpara;
 315             $indentpara = 0;
 316         }
 317         $text .= $_;
 318     }
 319 }
 320
 321 print CONFIG "\n=item $var\n\n$text\n" if $var and $text;
 322
 323 print CONFIG <<'ENDOFTAIL';
 324
 325 =back
 326
 327 =head1 NOTE
 328
 329 This module contains a good example of how to use tie to implement a
 330 cache and an example of how to make a tied variable readonly to those
 331 outside of it.
 332
 333 =cut
 334
 335 ENDOFTAIL
 336
 337 close(CONFIG);
 338 close(GLOS);
 339
 340 # Now do some simple tests on the Config.pm file we have created
 341 unshift(@INC,'lib');
 342 require $config_pm;
 343 import Config;
 344
 345 die "$0: $config_pm not valid"
 346         unless $Config{'CONFIG'} eq 'true';
 347
 348 die "$0: error processing $config_pm"
 349         if defined($Config{'an impossible name'})
 350         or $Config{'CONFIG'} ne 'true' # test cache
 351         ;
 352
 353 die "$0: error processing $config_pm"
 354         if eval '$Config{"cc"} = 1'
 355         or eval 'delete $Config{"cc"}'
 356         ;
 357
 358
 359 exit 0;