charnames.pm: Clarify comments

[perl5.git] / configpm

diff --git a/configpm b/configpm
index cb6122c..0f35309 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -2,8 +2,8 @@
 #
 # configpm
 #
 #
 # configpm
 #

-# Copyright (C) 1994, 1995, 1996 1997, 1998, 1999, 2000, 2001,
-# 2002, 2003, 2004, 2005, 2006 Larry Wall and others.
+# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
+# 2002, 2003, 2004, 2005, 2006, 2007 Larry Wall and others.

 #
 #
 # Regenerate the files
 #
 #
 # Regenerate the files


@@ -13,6 +13,7 @@
 #    lib/Config.pod
 #    lib/Cross.pm (optionally)
 #
 #    lib/Config.pod
 #    lib/Cross.pm (optionally)
 #

+#

 # from the contents of the static files
 #
 #    Porting/Glossary
 # from the contents of the static files
 #
 #    Porting/Glossary


@@ -22,18 +23,18 @@
 #
 #    config.sh
 #
 #
 #    config.sh
 #

+# Note that output directory is xlib/[cross-name]/ for cross-compiling
+#

 # It will only update Config.pm and Config_heavy.pl if the contents of
 # either file would be different. Note that *both* files are updated in
 # this case, since for example an extension makefile that has a dependency
 # on Config.pm should trigger even if only Config_heavy.pl has changed.
 
 sub usage { die <<EOF }
 # It will only update Config.pm and Config_heavy.pl if the contents of
 # either file would be different. Note that *both* files are updated in
 # this case, since for example an extension makefile that has a dependency
 # on Config.pm should trigger even if only Config_heavy.pl has changed.
 
 sub usage { die <<EOF }

-usage: $0  [ options ] [ Config_file ] [ Glossary_file ]
+usage: $0  [ options ]

     --cross=PLATFORM    cross-compile for a different platform
     --no-glossary       don't include Porting/Glossary in lib/Config.pod
     --cross=PLATFORM    cross-compile for a different platform
     --no-glossary       don't include Porting/Glossary in lib/Config.pod

-    --heavy=FILE        alternative name for lib/Config_heavy.pl
-    Config_file         alternative name for lib/Config.pm
-    Glossary_file       alternative name for Porting/Glossary
+    --chdir=dir         change directory before writing files

 EOF
 
 use strict;
 EOF
 
 use strict;


@@ -60,7 +61,7 @@ my %Allowed_Opts = (
     'cross'    => '', # --cross=PLATFORM - crosscompiling for PLATFORM
     'glossary' => 1,  # --no-glossary  - no glossary file inclusion,
                       #                  for compactness
     'cross'    => '', # --cross=PLATFORM - crosscompiling for PLATFORM
     'glossary' => 1,  # --no-glossary  - no glossary file inclusion,
                       #                  for compactness

-    'heavy' => '',   # pathname of the Config_heavy.pl file
+    'chdir'    => '', # --chdir=dir    - change directory before writing files

 );
 
 sub opts {
 );
 
 sub opts {


@@ -86,26 +87,29 @@ sub opts {
 
 my %Opts = opts();
 
 
 my %Opts = opts();
 

-my ($Config_PM, $Config_heavy);
-my $Glossary = $ARGV[1] || 'Porting/Glossary';
+if ($Opts{chdir}) {
+    chdir $Opts{chdir} or die "$0: could not chdir $Opts{chdir}: $!"
+}
+
+my ($Config_SH, $Config_PM, $Config_heavy, $Config_POD);
+my $Glossary = 'Porting/Glossary';

 
 if ($Opts{cross}) {
   # creating cross-platform config file
   mkdir "xlib";
   mkdir "xlib/$Opts{cross}";
 
 if ($Opts{cross}) {
   # creating cross-platform config file
   mkdir "xlib";
   mkdir "xlib/$Opts{cross}";

-  $Config_PM = $ARGV[0] || "xlib/$Opts{cross}/Config.pm";
+  $Config_PM = "xlib/$Opts{cross}/Config.pm";
+  $Config_POD = "xlib/$Opts{cross}/Config.pod";
+  $Config_SH = "Cross/config-$Opts{cross}.sh";

 }
 else {
 }
 else {

-  $Config_PM = $ARGV[0] || 'lib/Config.pm';
-}
-if ($Opts{heavy}) {
-  $Config_heavy = $Opts{heavy};
-}
-else {
-  ($Config_heavy = $Config_PM) =~ s!\.pm$!_heavy.pl!;
-  die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
-    if $Config_heavy eq $Config_PM;
+  $Config_PM = "lib/Config.pm";
+  $Config_POD = "lib/Config.pod";
+  $Config_SH = "config.sh";

 }
 }

+($Config_heavy = $Config_PM) =~ s/\.pm$/_heavy.pl/;
+die "Can't automatically determine name for Config_heavy.pl from '$Config_PM'"
+  if $Config_heavy eq $Config_PM;

 
 my $config_txt;
 my $heavy_txt;
 
 my $config_txt;
 my $heavy_txt;


@@ -118,6 +122,45 @@ package Config;
 use strict;
 # use warnings; Pulls in Carp
 # use vars pulls in Carp
 use strict;
 # use warnings; Pulls in Carp
 # use vars pulls in Carp

+
+sub _V {
+    my ($bincompat, $non_bincompat, $date, @patches) = Internals::V();
+
+    my $opts = join ' ', sort split ' ', "$bincompat $non_bincompat";
+
+    # wrap at 76 columns.
+
+    $opts =~ s/(?=.{53})(.{1,53}) /$1\n                        /mg;
+
+    print Config::myconfig();
+    if ($^O eq 'VMS') {
+        print "\nCharacteristics of this PERLSHR image: \n";
+    } else {
+        print "\nCharacteristics of this binary (from libperl): \n";
+    }
+
+    print "  Compile-time options: $opts\n";
+
+    if (@patches) {
+        print "  Locally applied patches:\n";
+        print "\t$_\n" foreach @patches;
+    }
+
+    print "  Built under $^O\n";
+
+    print "  $date\n" if defined $date;
+
+    my @env = map { "$_=\"$ENV{$_}\"" } sort grep {/^PERL/} keys %ENV;
+    push @env, "CYGWIN=\"$ENV{CYGWIN}\"" if $^O eq 'cygwin';
+
+    if (@env) {
+        print "  \%ENV:\n";
+        print "    $_\n" foreach @env;
+    }
+    print "  \@INC:\n";
+    print "    $_\n" foreach @INC;
+}
+

 ENDOFBEG
 
 my $myver = sprintf "%vd", $^V;
 ENDOFBEG
 
 my $myver = sprintf "%vd", $^V;


@@ -126,6 +169,10 @@ $config_txt .= sprintf <<'ENDOFBEG', ($myver) x 3;
 # 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.
 
 # 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.
 

+# for a description of the variables, please have a look at the
+# Glossary file, as written in the Porting folder, or use the url:
+# http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
+

 package Config;
 use strict;
 # use warnings; Pulls in Carp
 package Config;
 use strict;
 # use warnings; Pulls in Carp


@@ -141,13 +188,16 @@ sub config_sh;
 sub config_vars;
 sub config_re;
 
 sub config_vars;
 sub config_re;
 

-my %%Export_Cache = map {($_ => 1)} (@Config::EXPORT, @Config::EXPORT_OK);
+# Skip @Config::EXPORT because it only contains %%Config, which we special
+# case below as it's not a function. @Config::EXPORT won't change in the
+# lifetime of Perl 5.
+my %%Export_Cache = map {($_ => 1)} @Config::EXPORT_OK;

 
 our %%Config;
 
 # Define our own import method to avoid pulling in the full Exporter:
 sub import {
 
 our %%Config;
 
 # Define our own import method to avoid pulling in the full Exporter:
 sub import {

-    my $pkg = shift;
+    shift;

     @_ = @Config::EXPORT unless @_;
 
     my @funcs = grep $_ ne '%%Config', @_;
     @_ = @Config::EXPORT unless @_;
 
     my @funcs = grep $_ ne '%%Config', @_;


@@ -156,8 +206,8 @@ sub import {
     no strict 'refs';
     my $callpkg = caller(0);
     foreach my $func (@funcs) {
     no strict 'refs';
     my $callpkg = caller(0);
     foreach my $func (@funcs) {

-       die sprintf qq{"%%s" is not exported by the %%s module\n},
-           $func, __PACKAGE__ unless $Export_Cache{$func};
+       die qq{"$func" is not exported by the Config module\n}
+           unless $Export_Cache{$func};

        *{$callpkg.'::'.$func} = \&{$func};
     }
 
        *{$callpkg.'::'.$func} = \&{$func};
     }
 


@@ -165,11 +215,11 @@ sub import {
     return;
 }
 
     return;
 }
 

-die "Perl lib version (%s) doesn't match executable version ($])"
+die "Perl lib version (%s) doesn't match executable '$0' version ($])"

     unless $^V;
 
 $^V eq %s
     unless $^V;
 
 $^V eq %s

-    or die "Perl lib version (%s) doesn't match executable version (" .
+    or die "Perl lib version (%s) doesn't match executable '$0' version (" .

        sprintf("v%%vd",$^V) . ")";
 
 ENDOFBEG
        sprintf("v%%vd",$^V) . ")";
 
 ENDOFBEG


@@ -184,7 +234,7 @@ my %Data     = ();
 my %seen_quotes;
 {
   my ($name, $val);
 my %seen_quotes;
 {
   my ($name, $val);

-  open(CONFIG_SH, 'config.sh') || die "Can't open config.sh: $!";
+  open(CONFIG_SH, $Config_SH) || die "Can't open $Config_SH: $!";

   while (<CONFIG_SH>) {
     next if m:^#!/bin/sh:;
 
   while (<CONFIG_SH>) {
     next if m:^#!/bin/sh:;
 


@@ -244,63 +294,41 @@ EOT
 
 if ($seen_quotes{'"'}) {
     # We need the full ' and " code
 
 if ($seen_quotes{'"'}) {
     # We need the full ' and " code

-    $fetch_string .= <<'EOT';
-    my $quote_type = "'";
-    my $marker = "$key=";
-
-    # Check for the common case, ' delimited
-    my $start = index($Config_SH_expanded, "\n$marker$quote_type");
-    # If that failed, check for " delimited
-    if ($start == -1) {
-        $quote_type = '"';
-        $start = index($Config_SH_expanded, "\n$marker$quote_type");
-    }
-EOT
-} else {
-    $fetch_string .= <<'EOT';
-    # We only have ' delimted.
-    my $start = index($Config_SH_expanded, "\n$key=\'");
-EOT
-}
-$fetch_string .= <<'EOT';
-    # Start can never be -1 now, as we've rigged the long string we're
-    # searching with an initial dummy newline.
-    return undef if $start == -1;

 
 

-    $start += length($key) + 3;
-
-EOT
-if (!$seen_quotes{'"'}) {
-    # Don't need the full ' and " code, or the eval expansion.
-    $fetch_string .= <<'EOT';
-    my $value = substr($Config_SH_expanded, $start,
-                       index($Config_SH_expanded, "'\n", $start)
-                      - $start);
-EOT
-} else {
-    $fetch_string .= <<'EOT';
-    my $value = substr($Config_SH_expanded, $start,
-                       index($Config_SH_expanded, "$quote_type\n", $start)
-                      - $start);
+$fetch_string .= <<'EOT';
+    return undef unless my ($quote_type, $value) = $Config_SH_expanded =~ /\n$key=(['"])(.*?)\1\n/s;

 
     # 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 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

+
+    # Historically, since " 'support' was added in change 1409, the
+    # interpolation was done before the undef. Stick to this arguably buggy
+    # behaviour as we're refactoring.

     if ($quote_type eq '"') {
        $value =~ s/\$/\\\$/g;
        $value =~ s/\@/\\\@/g;
        eval "\$value = \"$value\"";
     }
     if ($quote_type eq '"') {
        $value =~ s/\$/\\\$/g;
        $value =~ s/\@/\\\@/g;
        eval "\$value = \"$value\"";
     }

-EOT
+
+    # So we can say "if $Config{'foo'}".
+    $self->{$key} = $value eq 'undef' ? undef : $value; # cache it

 }
 }

+EOT
+
+} else {
+    # We only have ' delimted.
+

 $fetch_string .= <<'EOT';
 $fetch_string .= <<'EOT';

+    return undef unless $Config_SH_expanded =~ /\n$key=\'(.*?)\'\n/s;

     # So we can say "if $Config{'foo'}".
     # So we can say "if $Config{'foo'}".

-    $value = undef if $value eq 'undef';
-    $self->{$key} = $value; # cache it
+    $self->{$key} = $1 eq 'undef' ? undef : $1;

 }
 EOT
 
 }
 EOT
 

+}
+

 eval $fetch_string;
 die if $@;
 
 eval $fetch_string;
 die if $@;
 


@@ -460,7 +488,19 @@ my $summary_expanded;
 sub myconfig {
     return $summary_expanded if $summary_expanded;
     ($summary_expanded = $summary) =~ s{\$(\w+)}
 sub myconfig {
     return $summary_expanded if $summary_expanded;
     ($summary_expanded = $summary) =~ s{\$(\w+)}

-                { my $c = $Config::Config{$1}; defined($c) ? $c : 'undef' }ge;
+                { 
+                       my $c;
+                       if ($1 eq 'git_ancestor_line') {
+                               if ($Config::Config{git_ancestor}) {
+                                       $c= "\n  Ancestor: $Config::Config{git_ancestor}";
+                               } else {
+                                       $c= "";
+                               }
+                       } else {
+                               $c = $Config::Config{$1}; 
+                       }
+                       defined($c) ? $c : 'undef' 
+               }ge;

     $summary_expanded;
 }
 
     $summary_expanded;
 }
 


@@ -537,6 +577,15 @@ foreach my $prefix (qw(libs libswanted)) {
 
 $heavy_txt .= "EOVIRTUAL\n";
 
 
 $heavy_txt .= "EOVIRTUAL\n";
 

+$heavy_txt .= <<'ENDOFGIT';
+eval {
+       # do not have hairy conniptions if this isnt available
+       require 'Config_git.pl';
+       $Config_SH_expanded .= $Config::Git_Data;
+       1;
+} or warn "Warning: failed to load Config_git.pl, something strange about this perl...\n";
+ENDOFGIT
+

 $heavy_txt .= $fetch_string;
 
 $config_txt .= <<'ENDOFEND';
 $heavy_txt .= $fetch_string;
 
 $config_txt .= <<'ENDOFEND';


@@ -717,7 +766,7 @@ tie %%Config, 'Config', {
 ENDOFTIE
 
 
 ENDOFTIE
 
 

-open(CONFIG_POD, ">lib/Config.pod") or die "Can't open lib/Config.pod: $!";
+open(CONFIG_POD, ">$Config_POD") or die "Can't open $Config_POD: $!";

 print CONFIG_POD <<'ENDOFTAIL';
 =head1 NAME
 
 print CONFIG_POD <<'ENDOFTAIL';
 =head1 NAME
 


@@ -753,6 +802,10 @@ Values stored in config.sh as 'undef' are returned as undefined
 values.  The perl C<exists> function can be used to check if a
 named variable exists.
 
 values.  The perl C<exists> function can be used to check if a
 named variable exists.
 

+For a description of the variables, please have a look at the
+Glossary file, as written in the Porting folder, or use the url:
+http://perl5.git.perl.org/perl.git/blob/HEAD:/Porting/Glossary
+

 =over 4
 
 =item myconfig()
 =over 4
 
 =item myconfig()


@@ -834,6 +887,8 @@ some of the variables described below, or may have extraneous variables
 specific to that particular port.  See the port specific documentation
 in such cases.
 
 specific to that particular port.  See the port specific documentation
 in such cases.
 

+=cut
+

 ENDOFTAIL
 
 if ($Opts{glossary}) {
 ENDOFTAIL
 
 if ($Opts{glossary}) {


@@ -850,12 +905,16 @@ sub process {
       print CONFIG_POD <<EOF if $text;
 =back
 
       print CONFIG_POD <<EOF if $text;
 =back
 

+=cut
+

 EOF
       print CONFIG_POD <<EOF;
 =head2 $c
 
 =over 4
 
 EOF
       print CONFIG_POD <<EOF;
 =head2 $c
 
 =over 4
 

+=cut
+

 EOF
      $text = 1;
     }
 EOF
      $text = 1;
     }


@@ -905,6 +964,21 @@ print CONFIG_POD <<'ENDOFTAIL';
 
 =back
 
 
 =back
 

+=head1 GIT DATA
+
+Information on the git commit from which the current perl binary was compiled
+can be found in the variable C<$Config::Git_Data>.  The variable is a
+structured string that looks something like this:
+
+  git_commit_id='ea0c2dbd5f5ac6845ecc7ec6696415bf8e27bd52'
+  git_describe='GitLive-blead-1076-gea0c2db'
+  git_branch='smartmatch'
+  git_uncommitted_changes=''
+  git_commit_id_title='Commit id:'
+  git_commit_date='2009-05-09 17:47:31 +0200'
+
+Its format is not guaranteed not to change over time.
+

 =head1 NOTE
 
 This module contains a good example of how to use tie to implement a
 =head1 NOTE
 
 This module contains a good example of how to use tie to implement a


@@ -917,7 +991,7 @@ ENDOFTAIL
 
 close(GLOS) if $Opts{glossary};
 close(CONFIG_POD);
 
 close(GLOS) if $Opts{glossary};
 close(CONFIG_POD);

-print "written lib/Config.pod\n";
+print "written $Config_POD\n";

 
 my $orig_config_txt = "";
 my $orig_heavy_txt = "";
 
 my $orig_config_txt = "";
 my $orig_heavy_txt = "";