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 = sprintf "v%vd", $^V;
  21
  22 print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
  23 package Config;
  24 use Exporter ();
  25 @EXPORT = qw(%Config);
  26 @EXPORT_OK = qw(myconfig config_sh config_vars);
  27
  28 # Define our own import method to avoid pulling in the full Exporter:
  29 sub import {
  30   my $pkg = shift;
  31   @_ = @EXPORT unless @_;
  32   my @func = grep {$_ ne '%Config'} @_;
  33   local $Exporter::ExportLevel = 1;
  34   Exporter::import('Config', @func) if @func;
  35   return if @func == @_;
  36   my $callpkg = caller(0);
  37   *{"$callpkg\::Config"} = \%Config;
  38 }
  39
  40 ENDOFBEG_NOQ
  41 die "Perl lib version ($myver) doesn't match executable version (\$])"
  42     unless \$^V;
  43
  44 \$^V eq $myver
  45   or die "Perl lib version ($myver) doesn't match executable version (" .
  46     (sprintf "v%vd",\$^V) . ")";
  47
  48 # This file was created by configpm when Perl was built. Any changes
  49 # made to this file will be lost the next time perl is built.
  50
  51 ENDOFBEG
  52
  53
  54 @fast{@fast} = @fast;
  55 @extensions{@extensions} = @extensions;
  56 @non_v=();
  57 @v_fast=();
  58 @v_others=();
  59 $in_v = 0;
  60
  61 while (<>) {
  62     next if m:^#!/bin/sh:;
  63     # Catch CONFIGDOTSH=true and PERL_VERSION=n line from Configure.
  64     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
  65     my ($k,$v) = ($1,$2);
  66     # grandfather PATCHLEVEL and SUBVERSION and CONFIG
  67     if ($k) {
  68         if ($k eq 'PERL_VERSION') {
  69             push @v_others, "PATCHLEVEL='$v'\n";
  70         }
  71         elsif ($k eq 'PERL_SUBVERSION') {
  72             push @v_others, "SUBVERSION='$v'\n";
  73         }
  74         elsif ($k eq 'CONFIGDOTSH') {
  75             push @v_others, "CONFIG='$v'\n";
  76         }
  77     }
  78     # We can delimit things in config.sh with either ' or ".
  79     unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
  80         push(@non_v, "#$_"); # not a name='value' line
  81         next;
  82     }
  83     $quote = $2;
  84     if ($in_v) { $val .= $_;             }
  85     else       { ($name,$val) = ($1,$3); }
  86     $in_v = $val !~ /$quote\n/;
  87     next if $in_v;
  88     if ($extensions{$name}) { s,/,::,g }
  89     if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
  90     push(@v_fast,"$name=$quote$val");
  91 }
  92
  93 foreach(@non_v){ print CONFIG $_ }
  94
  95 print CONFIG "\n",
  96     "my \$config_sh = <<'!END!';\n",
  97     join("", @v_fast, sort @v_others),
  98     "!END!\n\n";
  99
 100 # copy config summary format from the myconfig.SH script
 101
 102 print CONFIG "my \$summary = <<'!END!';\n";
 103
 104 open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
 105 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
 106 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
 107 close(MYCONFIG);
 108
 109 print CONFIG "\n!END!\n", <<'EOT';
 110 my $summary_expanded = 0;
 111
 112 sub myconfig {
 113         return $summary if $summary_expanded;
 114         $summary =~ s{\$(\w+)}
 115                      { my $c = $Config{$1}; defined($c) ? $c : 'undef' }ge;
 116         $summary_expanded = 1;
 117         $summary;
 118 }
 119 EOT
 120
 121 # ----
 122
 123 print CONFIG <<'ENDOFEND';
 124
 125 sub FETCH {
 126     # check for cached value (which may be undef so we use exists not defined)
 127     return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
 128
 129     # Search for it in the big string
 130     my($value, $start, $marker, $quote_type);
 131     $marker = "$_[1]=";
 132     $quote_type = "'";
 133     # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
 134     # Check for the common case, ' delimeted
 135     $start = index($config_sh, "\n$marker$quote_type");
 136     # If that failed, check for " delimited
 137     if ($start == -1) {
 138       $quote_type = '"';
 139       $start = index($config_sh, "\n$marker$quote_type");
 140     }
 141     return undef if ( ($start == -1) &&  # in case it's first
 142         (substr($config_sh, 0, length($marker)) ne $marker) );
 143     if ($start == -1) {
 144       # It's the very first thing we found. Skip $start forward
 145       # and figure out the quote mark after the =.
 146       $start = length($marker) + 1;
 147       $quote_type = substr($config_sh, $start - 1, 1);
 148     }
 149     else {
 150       $start += length($marker) + 2;
 151     }
 152     $value = substr($config_sh, $start,
 153         index($config_sh, "$quote_type\n", $start) - $start);
 154
 155     # If we had a double-quote, we'd better eval it so escape
 156     # sequences and such can be interpolated. Since the incoming
 157     # value is supposed to follow shell rules and not perl rules,
 158     # we escape any perl variable markers
 159     if ($quote_type eq '"') {
 160       $value =~ s/\$/\\\$/g;
 161       $value =~ s/\@/\\\@/g;
 162       eval "\$value = \"$value\"";
 163     }
 164     #$value = sprintf($value) if $quote_type eq '"';
 165     $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
 166     $_[0]->{$_[1]} = $value; # cache it
 167     return $value;
 168 }
 169
 170 my $prevpos = 0;
 171
 172 sub FIRSTKEY {
 173     $prevpos = 0;
 174     # my($key) = $config_sh =~ m/^(.*?)=/;
 175     substr($config_sh, 0, index($config_sh, '=') );
 176     # $key;
 177 }
 178
 179 sub NEXTKEY {
 180     # Find out how the current key's quoted so we can skip to its end.
 181     my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
 182     my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
 183     my $len = index($config_sh, "=", $pos) - $pos;
 184     $prevpos = $pos;
 185     $len > 0 ? substr($config_sh, $pos, $len) : undef;
 186 }
 187
 188 sub EXISTS {
 189     # exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
 190     exists($_[0]->{$_[1]}) or
 191     index($config_sh, "\n$_[1]='") != -1 or
 192     substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
 193     index($config_sh, "\n$_[1]=\"") != -1 or
 194     substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"";
 195 }
 196
 197 sub STORE  { die "\%Config::Config is read-only\n" }
 198 sub DELETE { &STORE }
 199 sub CLEAR  { &STORE }
 200
 201
 202 sub config_sh {
 203     $config_sh
 204 }
 205
 206 sub config_re {
 207     my $re = shift;
 208     my @matches = ($config_sh =~ /^$re=.*\n/mg);
 209     @matches ? (print @matches) : print "$re: not found\n";
 210 }
 211
 212 sub config_vars {
 213     foreach(@_){
 214         config_re($_), next if /\W/;
 215         my $v=(exists $Config{$_}) ? $Config{$_} : 'UNKNOWN';
 216         $v='undef' unless defined $v;
 217         print "$_='$v';\n";
 218     }
 219 }
 220
 221 ENDOFEND
 222
 223 if ($^O eq 'os2') {
 224   print CONFIG <<'ENDOFSET';
 225 my %preconfig;
 226 if ($OS2::is_aout) {
 227     my ($value, $v) = $config_sh =~ m/^used_aout='(.*)'\s*$/m;
 228     for (split ' ', $value) {
 229         ($v) = $config_sh =~ m/^aout_$_='(.*)'\s*$/m;
 230         $preconfig{$_} = $v eq 'undef' ? undef : $v;
 231     }
 232 }
 233 sub TIEHASH { bless {%preconfig} }
 234 ENDOFSET
 235 } else {
 236   print CONFIG <<'ENDOFSET';
 237 sub TIEHASH { bless {} }
 238 ENDOFSET
 239 }
 240
 241 print CONFIG <<'ENDOFTAIL';
 242
 243 # avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
 244 sub DESTROY { }
 245
 246 tie %Config, 'Config';
 247
 248 1;
 249 __END__
 250
 251 =head1 NAME
 252
 253 Config - access Perl configuration information
 254
 255 =head1 SYNOPSIS
 256
 257     use Config;
 258     if ($Config{'cc'} =~ /gcc/) {
 259         print "built by gcc\n";
 260     }
 261
 262     use Config qw(myconfig config_sh config_vars);
 263
 264     print myconfig();
 265
 266     print config_sh();
 267
 268     config_vars(qw(osname archname));
 269
 270
 271 =head1 DESCRIPTION
 272
 273 The Config module contains all the information that was available to
 274 the C<Configure> program at Perl build time (over 900 values).
 275
 276 Shell variables from the F<config.sh> file (written by Configure) are
 277 stored in the readonly-variable C<%Config>, indexed by their names.
 278
 279 Values stored in config.sh as 'undef' are returned as undefined
 280 values.  The perl C<exists> function can be used to check if a
 281 named variable exists.
 282
 283 =over 4
 284
 285 =item myconfig()
 286
 287 Returns a textual summary of the major perl configuration values.
 288 See also C<-V> in L<perlrun/Switches>.
 289
 290 =item config_sh()
 291
 292 Returns the entire perl configuration information in the form of the
 293 original config.sh shell variable assignment script.
 294
 295 =item config_vars(@names)
 296
 297 Prints to STDOUT the values of the named configuration variable. Each is
 298 printed on a separate line in the form:
 299
 300   name='value';
 301
 302 Names which are unknown are output as C<name='UNKNOWN';>.
 303 See also C<-V:name> in L<perlrun/Switches>.
 304
 305 =back
 306
 307 =head1 EXAMPLE
 308
 309 Here's a more sophisticated example of using %Config:
 310
 311     use Config;
 312     use strict;
 313
 314     my %sig_num;
 315     my @sig_name;
 316     unless($Config{sig_name} && $Config{sig_num}) {
 317         die "No sigs?";
 318     } else {
 319         my @names = split ' ', $Config{sig_name};
 320         @sig_num{@names} = split ' ', $Config{sig_num};
 321         foreach (@names) {
 322             $sig_name[$sig_num{$_}] ||= $_;
 323         }
 324     }
 325
 326     print "signal #17 = $sig_name[17]\n";
 327     if ($sig_num{ALRM}) {
 328         print "SIGALRM is $sig_num{ALRM}\n";
 329     }
 330
 331 =head1 WARNING
 332
 333 Because this information is not stored within the perl executable
 334 itself it is possible (but unlikely) that the information does not
 335 relate to the actual perl binary which is being used to access it.
 336
 337 The Config module is installed into the architecture and version
 338 specific library directory ($Config{installarchlib}) and it checks the
 339 perl version number when loaded.
 340
 341 The values stored in config.sh may be either single-quoted or
 342 double-quoted. Double-quoted strings are handy for those cases where you
 343 need to include escape sequences in the strings. To avoid runtime variable
 344 interpolation, any C<$> and C<@> characters are replaced by C<\$> and
 345 C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
 346 or C<\@> in double-quoted strings unless you're willing to deal with the
 347 consequences. (The slashes will end up escaped and the C<$> or C<@> will
 348 trigger variable interpolation)
 349
 350 =head1 GLOSSARY
 351
 352 Most C<Config> variables are determined by the C<Configure> script
 353 on platforms supported by it (which is most UNIX platforms).  Some
 354 platforms have custom-made C<Config> variables, and may thus not have
 355 some of the variables described below, or may have extraneous variables
 356 specific to that particular port.  See the port specific documentation
 357 in such cases.
 358
 359 ENDOFTAIL
 360
 361 open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
 362 %seen = ();
 363 $text = 0;
 364 $/ = '';
 365
 366 sub process {
 367   s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
 368   my $c = substr $1, 0, 1;
 369   unless ($seen{$c}++) {
 370     print CONFIG <<EOF if $text;
 371 =back
 372
 373 EOF
 374     print CONFIG <<EOF;
 375 =head2 $c
 376
 377 =over
 378
 379 EOF
 380     $text = 1;
 381   }
 382   s/n't/n\00t/g;                # leave can't, won't etc untouched
 383   s/^\t\s+(.*)/\n\t$1\n/gm;     # Indented lines ===> paragraphs
 384   s/^(?<!\n\n)\t(.*)/$1/gm;     # Not indented lines ===> text
 385   s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
 386   s{([\'\"])([^\'\"\s]+)\1}(C<$2>)g; # "date" command
 387   s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
 388   s{
 389      (?<! [\w./<\'\"] )         # Only standalone file names
 390      (?! e \. g \. )            # Not e.g.
 391      (?! \. \. \. )             # Not ...
 392      (?! \d )                   # Not 5.004
 393      ( [\w./]* [./] [\w./]* )   # Require . or / inside
 394      (?<! \. (?= \s ) )         # Do not include trailing dot
 395      (?! [\w/] )                # Include all of it
 396    }
 397    (F<$1>)xg;                   # /usr/local
 398   s/((?<=\s)~\w*)/F<$1>/g;      # ~name
 399   s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g;    # UNISTD
 400   s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
 401   s/n[\0]t/n't/g;               # undo can't, won't damage
 402 }
 403
 404 <GLOS>;                         # Skip the preamble
 405 while (<GLOS>) {
 406   process;
 407   print CONFIG;
 408 }
 409
 410 print CONFIG <<'ENDOFTAIL';
 411
 412 =back
 413
 414 =head1 NOTE
 415
 416 This module contains a good example of how to use tie to implement a
 417 cache and an example of how to make a tied variable readonly to those
 418 outside of it.
 419
 420 =cut
 421
 422 ENDOFTAIL
 423
 424 close(CONFIG);
 425 close(GLOS);
 426
 427 # Now do some simple tests on the Config.pm file we have created
 428 unshift(@INC,'lib');
 429 require $config_pm;
 430 import Config;
 431
 432 die "$0: $config_pm not valid"
 433         unless $Config{'CONFIGDOTSH'} eq 'true';
 434
 435 die "$0: error processing $config_pm"
 436         if defined($Config{'an impossible name'})
 437         or $Config{'CONFIGDOTSH'} ne 'true' # test cache
 438         ;
 439
 440 die "$0: error processing $config_pm"
 441         if eval '$Config{"cc"} = 1'
 442         or eval 'delete $Config{"cc"}'
 443         ;
 444
 445
 446 exit 0;