This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
README.ko update from Jungshik Shin.
[perl5.git] / configpm
index 971af7f..87df478 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -1,7 +1,36 @@
 #!./miniperl -w
 
-my $config_pm = $ARGV[0] || 'lib/Config.pm';
+# following options are recognized:
+# --no-glossary  - no glossary file inclusion, for compactness
+# --cross=PALTFORM - crosscompiling for PLATFORM
+my %opts = (
+  # %known_opts enumerates allowed opts as well as specifies default and initial values
+  my %known_opts = (
+     'cross' => '',
+     'glossary' => 1,
+  ),
+  # options itself
+  my %specified_opts = (
+    (map {/^--([\-_\w]+)=(.*)$/} @ARGV),                            # --opt=smth
+    (map {/^no-?(.*)$/i?($1=>0):($_=>1)} map {/^--([\-_\w]+)$/} @ARGV),  # --opt --no-opt --noopt
+  ),
+);
+die "option '$_' is not recognized" for grep {!exists $known_opts{$_}} keys %specified_opts;
+@ARGV = grep {!/^--/} @ARGV;
+
+my $config_pm;
 my $glossary = $ARGV[1] || 'Porting/Glossary';
+
+if ($opts{cross}) {
+  # creating cross-platform config file
+  mkdir "xlib";
+  mkdir "xlib/$opts{cross}";
+  $config_pm = $ARGV[0] || "xlib/$opts{cross}/Config.pm";
+}
+else {
+  $config_pm = $ARGV[0] || 'lib/Config.pm';
+}
+
 @ARGV = "./config.sh";
 
 # list names to put first (and hence lookup fastest)
@@ -17,17 +46,33 @@ my $glossary = $ARGV[1] || 'Porting/Glossary';
 
 
 open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n";
-$myver = $];
+$myver = sprintf "v%vd", $^V;
 
-print CONFIG <<"ENDOFBEG";
+print CONFIG <<'ENDOFBEG_NOQ', <<"ENDOFBEG";
 package Config;
 use Exporter ();
-\@ISA = (Exporter);
-\@EXPORT = qw(%Config);
-\@EXPORT_OK = qw(myconfig config_sh config_vars);
+@EXPORT = qw(%Config);
+@EXPORT_OK = qw(myconfig config_sh config_vars);
+
+# Define our own import method to avoid pulling in the full Exporter:
+sub import {
+  my $pkg = shift;
+  @_ = @EXPORT unless @_;
+  my @func = grep {$_ ne '%Config'} @_;
+  local $Exporter::ExportLevel = 1;
+  Exporter::import('Config', @func) if @func;
+  return if @func == @_;
+  my $callpkg = caller(0);
+  *{"$callpkg\::Config"} = \%Config;
+}
+
+ENDOFBEG_NOQ
+die "Perl lib version ($myver) doesn't match executable version (\$])"
+    unless \$^V;
 
-\$] == $myver
-  or die "Perl lib version ($myver) doesn't match executable version (\$])";
+\$^V eq $myver
+  or die "Perl lib version ($myver) doesn't match executable version (" .
+    (sprintf "v%vd",\$^V) . ")";
 
 # This file was created by configpm when Perl was built. Any changes
 # made to this file will be lost the next time perl is built.
@@ -44,19 +89,34 @@ $in_v = 0;
 
 while (<>) {
     next if m:^#!/bin/sh:;
-    # Catch CONFIG=true and PATCHLEVEL=n line from Configure.
+    # Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
     s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/;
-    unless ($in_v or m/^(\w+)='(.*\n)/){
+    my ($k,$v) = ($1,$2);
+    # grandfather PATCHLEVEL and SUBVERSION and CONFIG
+    if ($k) {
+       if ($k eq 'PERL_VERSION') {
+           push @v_others, "PATCHLEVEL='$v'\n";
+       }
+       elsif ($k eq 'PERL_SUBVERSION') {
+           push @v_others, "SUBVERSION='$v'\n";
+       }
+       elsif ($k eq 'PERL_CONFIG_SH') {
+           push @v_others, "CONFIG='$v'\n";
+       }
+    }
+    # We can delimit things in config.sh with either ' or ". 
+    unless ($in_v or m/^(\w+)=(['"])(.*\n)/){
        push(@non_v, "#$_"); # not a name='value' line
        next;
     }
+    $quote = $2;
     if ($in_v) { $val .= $_;             }
-    else       { ($name,$val) = ($1,$2); }
-    $in_v = $val !~ /'\n/;
+    else       { ($name,$val) = ($1,$3); }
+    $in_v = $val !~ /$quote\n/;
     next if $in_v;
     if ($extensions{$name}) { s,/,::,g }
-    if (!$fast{$name}){ push(@v_others, "$name='$val"); next; }
-    push(@v_fast,"$name='$val");
+    if (!$fast{$name}){ push(@v_others, "$name=$quote$val"); next; }
+    push(@v_fast,"$name=$quote$val");
 }
 
 foreach(@non_v){ print CONFIG $_ }
@@ -66,11 +126,11 @@ print CONFIG "\n",
     join("", @v_fast, sort @v_others),
     "!END!\n\n";
 
-# copy config summary format from the myconfig script
+# copy config summary format from the myconfig.SH script
 
 print CONFIG "my \$summary = <<'!END!';\n";
 
-open(MYCONFIG,"<myconfig") || die "open myconfig failed: $!";
+open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
 1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
 do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
 close(MYCONFIG);
@@ -96,18 +156,85 @@ sub FETCH {
     return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]});
 
     # Search for it in the big string 
-    my($value, $start, $marker);
-    $marker = "$_[1]='";
-    # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
-    $start = index($config_sh, "\n$marker");
-    return undef if ( ($start == -1) &&  # in case it's first 
-        (substr($config_sh, 0, length($marker)) ne $marker) );
-    if ($start == -1) { $start = length($marker) } 
-        else { $start += length($marker) + 1 }
-    $value = substr($config_sh, $start, 
-        index($config_sh, qq('\n), $start) - $start);
-    $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
+    my($value, $start, $marker, $quote_type);
+
+    $quote_type = "'";
+    # Virtual entries.
+    if ($_[1] eq 'byteorder') {
+       # byteorder does exist on its own but we overlay a virtual
+       # dynamically recomputed value. 
+        my $t = $Config{ivtype};
+        my $s = $Config{ivsize};
+        my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
+        if ($s == 4 || $s == 8) {
+           my $i = 0;
+           foreach my $c (reverse(2..$s)) { $i |= ord($c); $i <<= 8 }
+           $i |= ord(1);
+            $value = join('', unpack('a'x$s, pack($f, $i)));
+        } else {
+            $value = '?'x$s;
+        }
+    } elsif ($_[1] =~ /^((?:cc|ld)flags|libs(?:wanted)?)_nolargefiles/) {
+       # These are purely virtual, they do not exist, but need to
+       # be computed on demand for largefile-incapable extensions.
+       my $key = "${1}_uselargefiles";
+       $value = $Config{$1};
+       my $withlargefiles = $Config{$key};
+       if ($key =~ /^(?:cc|ld)flags_/) {
+           $value =~ s/\Q$withlargefiles\E\b//;
+       } elsif ($key =~ /^libs/) {
+           my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
+           if (@lflibswanted) {
+               my %lflibswanted;
+               @lflibswanted{@lflibswanted} = ();
+               if ($key =~ /^libs_/) {
+                   my @libs = grep { /^-l(.+)/ &&
+                                      not exists $lflibswanted{$1} }
+                                   split(' ', $Config{libs});
+                   $Config{libs} = join(' ', @libs);
+               } elsif ($key =~ /^libswanted_/) {
+                   my @libswanted = grep { not exists $lflibswanted{$_} }
+                                         split(' ', $Config{libswanted});
+                   $Config{libswanted} = join(' ', @libswanted);
+               }
+           }
+       }
+    } else {
+       $marker = "$_[1]=";
+       # return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m);
+       # Check for the common case, ' delimeted
+       $start = index($config_sh, "\n$marker$quote_type");
+       # If that failed, check for " delimited
+       if ($start == -1) {
+           $quote_type = '"';
+           $start = index($config_sh, "\n$marker$quote_type");
+       }
+       return undef if ( ($start == -1) &&  # in case it's first 
+                         (substr($config_sh, 0, length($marker)) ne $marker) );
+       if ($start == -1) { 
+           # It's the very first thing we found. Skip $start forward
+           # and figure out the quote mark after the =.
+           $start = length($marker) + 1;
+           $quote_type = substr($config_sh, $start - 1, 1);
+       } 
+       else { 
+           $start += length($marker) + 2;
+       }
+       $value = substr($config_sh, $start, 
+                       index($config_sh, "$quote_type\n", $start) - $start);
+    }
+    # If we had a double-quote, we'd better eval it so escape
+    # sequences and such can be interpolated. Since the incoming
+    # value is supposed to follow shell rules and not perl rules,
+    # we escape any perl variable markers
+    if ($quote_type eq '"') {
+       $value =~ s/\$/\\\$/g;
+       $value =~ s/\@/\\\@/g;
+       eval "\$value = \"$value\"";
+    }
+    #$value = sprintf($value) if $quote_type eq '"';
+    # So we can say "if $Config{'foo'}".
+    $value = undef if $value eq 'undef';
     $_[0]->{$_[1]} = $value; # cache it
     return $value;
 }
@@ -122,7 +249,9 @@ sub FIRSTKEY {
 }
 
 sub NEXTKEY {
-    my $pos = index($config_sh, qq('\n), $prevpos) + 2;
+    # Find out how the current key's quoted so we can skip to its end.
+    my $quote = substr($config_sh, index($config_sh, "=", $prevpos)+1, 1);
+    my $pos = index($config_sh, qq($quote\n), $prevpos) + 2;
     my $len = index($config_sh, "=", $pos) - $pos;
     $prevpos = $pos;
     $len > 0 ? substr($config_sh, $pos, $len) : undef;
@@ -132,7 +261,10 @@ sub EXISTS {
     # exists($_[0]->{$_[1]})  or  $config_sh =~ m/^$_[1]=/m;
     exists($_[0]->{$_[1]}) or
     index($config_sh, "\n$_[1]='") != -1 or
-    substr($config_sh, 0, length($_[1])+2) eq "$_[1]='";
+    substr($config_sh, 0, length($_[1])+2) eq "$_[1]='" or
+    index($config_sh, "\n$_[1]=\"") != -1 or
+    substr($config_sh, 0, length($_[1])+2) eq "$_[1]=\"" or
+    $_[1] =~ /^(?:(?:cc|ld)flags|libs(?:wanted)?)_nolargefiles$/;
 }
 
 sub STORE  { die "\%Config::Config is read-only\n" }
@@ -146,7 +278,7 @@ sub config_sh {
 
 sub config_re {
     my $re = shift;
-    my @matches = ($config_sh =~ /^$re=.*\n/mg);
+    my @matches = grep /^$re=/, split /^/, $config_sh;
     @matches ? (print @matches) : print "$re: not found\n";
 }
 
@@ -171,8 +303,20 @@ if ($OS2::is_aout) {
         $preconfig{$_} = $v eq 'undef' ? undef : $v;
     }
 }
+$preconfig{d_fork} = undef unless $OS2::can_fork; # Some funny cases can't
 sub TIEHASH { bless {%preconfig} }
 ENDOFSET
+  # Extract the name of the DLL from the makefile to avoid duplication
+  my ($f) = grep -r, qw(GNUMakefile Makefile);
+  my $dll;
+  if (open my $fh, '<', $f) {
+    while (<$fh>) {
+      $dll = $1, last if /^PERL_DLL_BASE\s*=\s*(\S*)\s*$/;
+    }
+  }
+  print CONFIG <<ENDOFSET if $dll;
+\$preconfig{dll_name} = '$dll';
+ENDOFSET
 } else {
   print CONFIG <<'ENDOFSET';
 sub TIEHASH { bless {} }
@@ -279,6 +423,15 @@ The Config module is installed into the architecture and version
 specific library directory ($Config{installarchlib}) and it checks the
 perl version number when loaded.
 
+The values stored in config.sh may be either single-quoted or
+double-quoted. Double-quoted strings are handy for those cases where you
+need to include escape sequences in the strings. To avoid runtime variable
+interpolation, any C<$> and C<@> characters are replaced by C<\$> and
+C<\@>, respectively. This isn't foolproof, of course, so don't embed C<\$>
+or C<\@> in double-quoted strings unless you're willing to deal with the
+consequences. (The slashes will end up escaped and the C<$> or C<@> will
+trigger variable interpolation)
+
 =head1 GLOSSARY
 
 Most C<Config> variables are determined by the C<Configure> script
@@ -290,26 +443,33 @@ in such cases.
 
 ENDOFTAIL
 
-open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
+if ($opts{glossary}) {
+  open(GLOS, "<$glossary") or die "Can't open $glossary: $!";
+}
 %seen = ();
 $text = 0;
 $/ = '';
 
 sub process {
-  s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m;
-  my $c = substr $1, 0, 1;
-  unless ($seen{$c}++) {
-    print CONFIG <<EOF if $text;
+  if (s/\A(\w*)\s+\(([\w.]+)\):\s*\n(\t?)/=item C<$1>\n\nFrom F<$2>:\n\n/m) {
+    my $c = substr $1, 0, 1;
+    unless ($seen{$c}++) {
+      print CONFIG <<EOF if $text;
 =back
 
 EOF
-    print CONFIG <<EOF;
+      print CONFIG <<EOF;
 =head2 $c
 
-=over
+=over 4
 
 EOF
-    $text = 1;
+     $text = 1;
+    }
+  }
+  elsif (!$text || !/\A\t/) {
+    warn "Expected a Configure variable header",
+      ($text ? " or another paragraph of description" : () );
   }
   s/n't/n\00t/g;               # leave can't, won't etc untouched
   s/^\t\s+(.*)/\n\t$1\n/gm;    # Indented lines ===> paragraphs
@@ -322,8 +482,14 @@ EOF
      (?! e \. g \. )           # Not e.g.
      (?! \. \. \. )            # Not ...
      (?! \d )                  # Not 5.004
-     ( [\w./]* [./] [\w./]* )  # Require . or / inside
-     (?<! \. (?= \s ) )                # Do not include trailing dot
+     (?! read/ )               # Not read/write
+     (?! etc\. )               # Not etc.
+     (?! I/O )                 # Not I/O
+     (
+       \$ ?                    # Allow leading $
+       [\w./]* [./] [\w./]*    # Require . or / inside
+     )
+     (?<! \. (?= [\s)] ) )     # Do not include trailing dot
      (?! [\w/] )               # Include all of it
    }
    (F<$1>)xg;                  # /usr/local
@@ -333,10 +499,12 @@ EOF
   s/n[\0]t/n't/g;              # undo can't, won't damage
 }
 
-<GLOS>;                                # Skip the preamble
-while (<GLOS>) {
-  process;
-  print CONFIG;
+if ($opts{glossary}) {
+  <GLOS>;                              # Skip the preamble
+  while (<GLOS>) {
+    process;
+    print CONFIG;
+  }
 }
 
 print CONFIG <<'ENDOFTAIL';
@@ -356,17 +524,44 @@ ENDOFTAIL
 close(CONFIG);
 close(GLOS);
 
+# Now create Cross.pm if needed
+if ($opts{cross}) {
+  open CROSS, ">lib/Cross.pm" or die "Can not open >lib/Cross.pm: $!";
+  my $cross = <<'EOS';
+# typical invocation:
+#   perl -MCross Makefile.PL
+#   perl -MCross=wince -V:cc
+package Cross;
+
+sub import {
+  my ($package,$platform) = @_;
+  unless (defined $platform) {
+    # if $platform is not specified, then use last one when
+    # 'configpm; was invoked with --cross option
+    $platform = '***replace-marker***';
+  }
+  @INC = map {/\blib\b/?(do{local $_=$_;s/\blib\b/xlib\/$platform/;$_},$_):($_)} @INC;
+}
+
+1;
+EOS
+  $cross =~ s/\*\*\*replace-marker\*\*\*/$opts{cross}/g;
+  print CROSS $cross;
+  close CROSS;
+}
+
+
 # Now do some simple tests on the Config.pm file we have created
 unshift(@INC,'lib');
 require $config_pm;
 import Config;
 
 die "$0: $config_pm not valid"
-       unless $Config{'CONFIG'} eq 'true';
+       unless $Config{'PERL_CONFIG_SH'} eq 'true';
 
 die "$0: error processing $config_pm"
        if defined($Config{'an impossible name'})
-       or $Config{'CONFIG'} ne 'true' # test cache
+       or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
        ;
 
 die "$0: error processing $config_pm"