perl
view release on metacpan or search on metacpan
# # 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\"";
# }
#
# # So we can say "if $Config{'foo'}".
# $self->{$key} = $value eq 'undef' ? undef : $value; # cache it
# }
EOT
} else {
# We only have ' delimited.
$fetch_string .= uncomment <<'EOT';
# return undef unless $Config_SH_expanded =~ /\n$key=\'(.*?)\'\n/s;
# # So we can say "if $Config{'foo'}".
# $self->{$key} = $1 eq 'undef' ? undef : $1;
# }
EOT
}
eval $fetch_string;
die if $@;
# Calculation for the keys for byteorder
# This is somewhat grim, but I need to run fetch_string here.
$Config_SH_expanded = join "\n", '', @v_others;
my $t = fetch_string ({}, 'ivtype');
my $s = fetch_string ({}, 'ivsize');
# byteorder does exist on its own but we overlay a virtual
# dynamically recomputed value.
# However, ivtype and ivsize will not vary for sane fat binaries
my $f = $t eq 'long' ? 'L!' : $s == 8 ? 'Q': 'I';
my $byteorder_code;
if ($s == 4 || $s == 8) {
my $list = join ',', reverse(1..$s-1);
my $format = 'a'x$s;
$byteorder_code = <<"EOT";
my \$i = ord($s);
foreach my \$c ($list) { \$i <<= 8; \$i |= ord(\$c); }
our \$byteorder = join('', unpack('$format', pack('$f', \$i)));
EOT
} else {
$byteorder_code = "our \$byteorder = '?'x$s;\n";
}
my @need_relocation;
if (fetch_string({},'userelocatableinc')) {
foreach my $what (qw(prefixexp
archlibexp
html1direxp
html3direxp
man1direxp
man3direxp
privlibexp
scriptdirexp
sitearchexp
sitebinexp
sitehtml1direxp
sitehtml3direxp
sitelibexp
siteman1direxp
siteman3direxp
sitescriptexp
vendorarchexp
vendorbinexp
vendorhtml1direxp
vendorhtml3direxp
vendorlibexp
vendorman1direxp
vendorman3direxp
vendorscriptexp
siteprefixexp
sitelib_stem
vendorlib_stem
installarchlib
installhtml1dir
installhtml3dir
installman1dir
installman3dir
installprefix
installprefixexp
installprivlib
installscript
installsitearch
installsitebin
installsitehtml1dir
installsitehtml3dir
installsitelib
installsiteman1dir
installsiteman3dir
installsitescript
installvendorarch
installvendorbin
installvendorhtml1dir
installvendorhtml3dir
installvendorlib
installvendorman1dir
installvendorman3dir
installvendorscript
)) {
push @need_relocation, $what if fetch_string({}, $what) =~ m!^\.\.\./!;
}
}
my %need_relocation;
@need_relocation{@need_relocation} = @need_relocation;
# This can have .../ anywhere:
if (fetch_string({}, 'otherlibdirs') =~ m!\.\.\./!) {
$need_relocation{otherlibdirs} = 'otherlibdirs';
}
my $relocation_code = uncomment <<'EOT';
#
# sub relocate_inc {
# my $libdir = shift;
# return $libdir unless $libdir =~ s!^\.\.\./!!;
# my $prefix = $^X;
# if ($prefix =~ s!/[^/]*$!!) {
# while ($libdir =~ m!^\.\./!) {
# # Loop while $libdir starts "../" and $prefix still has a trailing
# # directory
# last unless $prefix =~ s!/([^/]+)$!!;
# # but bail out if the directory we picked off the end of $prefix is .
# # or ..
# if ($1 eq '.' or $1 eq '..') {
# # Undo! This should be rare, hence code it this way rather than a
# # check each time before the s!!! above.
# $prefix = "$prefix/$1";
# last;
# }
# # Remove that leading ../ and loop again
# substr ($libdir, 0, 3, '');
# }
# $libdir = "$prefix/$libdir";
# }
# $libdir;
# }
EOT
my $osname = fetch_string({}, 'osname');
my $from = $osname eq 'VMS' ? 'PERLSHR image' : 'binary (from libperl)';
my $env_cygwin = $osname eq 'cygwin'
? 'push @env, "CYGWIN=\"$ENV{CYGWIN}\"" if $ENV{CYGWIN};' . "\n" : "";
$heavy_txt .= sprintf uncomment <<'ENDOFBEG', $osname, $osname, $from, $osname, $env_cygwin;
# # 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.
#
# package Config;
# use strict;
# use warnings;
# our %%Config;
#
# sub bincompat_options {
# return split ' ', (Internals::V())[0];
# }
#
# sub non_bincompat_options {
# return split ' ', (Internals::V())[1];
# }
#
# sub compile_date {
# return (Internals::V())[2]
# }
#
# sub local_patches {
# my (undef, undef, undef, @patches) = Internals::V();
# return @patches;
# }
#
# sub _V {
# die "Perl lib was built for '%s' but is being run on '$^O'"
# unless "%s" eq $^O;
#
# my ($bincompat, $non_bincompat, $date, @patches) = Internals::V();
#
# my @opts = sort split ' ', "$bincompat $non_bincompat";
#
# print Config::myconfig();
# print "\nCharacteristics of this %s: \n";
#
# print " Compile-time options:\n";
# print " $_\n" for @opts;
#
# if (@patches) {
# print " Locally applied patches:\n";
# print " $_\n" foreach @patches;
# }
#
# print " Built under %s\n";
#
# print " $date\n" if defined $date;
#
# my @env = map { "$_=\"$ENV{$_}\"" } sort grep {/^PERL/} keys %%ENV;
# %s
# if (@env) {
# print " \%%ENV:\n";
# print " $_\n" foreach @env;
# }
# print " \@INC:\n";
# print " $_\n" foreach @INC;
# }
#
# sub header_files {
ENDOFBEG
$heavy_txt .= $header_files . "\n}\n\n";
if (%need_relocation) {
my $relocations_in_common;
# otherlibdirs only features in the hash
foreach (keys %need_relocation) {
$relocations_in_common++ if $Common{$_};
}
if ($relocations_in_common) {
$config_txt .= $relocation_code;
} else {
$heavy_txt .= $relocation_code;
}
}
$heavy_txt .= join('', @non_v) . "\n";
# copy config summary format from the myconfig.SH script
$heavy_txt .= "our \$summary = <<'!END!';\n";
open(MYCONFIG,'<','myconfig.SH') || die "open myconfig.SH failed: $!";
1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
do { $heavy_txt .= $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
close(MYCONFIG);
$heavy_txt .= "\n!END!\n" . uncomment <<'EOT';
# my $summary_expanded;
#
# sub myconfig {
# return $summary_expanded if $summary_expanded;
# ($summary_expanded = $summary) =~ s{\$(\w+)}
# {
# 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;
# }
#
# local *_ = \my $a;
# $_ = <<'!END!';
EOT
#proper lexicographical order of the keys
my %seen_var;
my @v_define = ( "taint_support=''\n",
"taint_disabled=''\n" );
$heavy_txt .= join('',
map { $_->[-1] }
sort {$a->[0] cmp $b->[0] }
grep { !$seen_var{ $_->[0] }++ }
map {
/^([^=]+)/ ? [ $1, $_ ]
: [ $_, $_ ] # shouldnt happen
} (@v_others, @v_forced, @v_define)
) . "!END!\n";
# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
# the precached keys
if ($Common{byteorder}) {
$config_txt .= $byteorder_code;
} else {
$heavy_txt .= $byteorder_code;
}
$heavy_txt .= uncomment <<'EOT';
# s/(byteorder=)(['"]).*?\2/$1$2$Config::byteorder$2/m;
#
EOT
$heavy_txt .= uncomment <<'EOF_TAINT_INIT';
# {
# # We have to set this up late as Win32 does not build miniperl
# # with the same defines and CC flags as it builds perl itself.
# my $defines = join " ", (Internals::V)[0,1];
# if (
# $defines =~ /\b(SILENT_NO_TAINT_SUPPORT)\b/ ||
# $defines =~ /\b(NO_TAINT_SUPPORT)\b/
# ){
# my $which = $1;
# my $taint_disabled = ($which eq "SILENT_NO_TAINT_SUPPORT")
# ? "silent" : "define";
# s/^(taint_disabled=['"])(["'])/$1$taint_disabled$2/m;
# }
# else {
# my $taint_support = 'define';
# s/^(taint_support=['"])(["'])/$1$taint_support$2/m;
# }
# }
EOF_TAINT_INIT
if (@need_relocation) {
$heavy_txt .= 'foreach my $what (qw(' . join (' ', @need_relocation) .
")) {\n" . uncomment <<'EOT';
# s/^($what=)(['"])(.*?)\2/$1 . $2 . relocate_inc($3) . $2/me;
# }
EOT
# Currently it only makes sense to do the ... relocation on Unix, so there's
# no need to emulate the "which separator for this platform" logic in perl.c -
# ':' will always be applicable
if ($need_relocation{otherlibdirs}) {
$heavy_txt .= uncomment << 'EOT';
# s{^(otherlibdirs=)(['"])(.*?)\2}
# {$1 . $2 . join ':', map {relocate_inc($_)} split ':', $3 . $2}me;
EOT
}
}
$heavy_txt .= uncomment <<'EOT';
# my $config_sh_len = length $_;
#
# our $Config_SH_expanded = "\n$_" . << 'EOVIRTUAL';
EOT
foreach my $prefix (qw(ccflags ldflags)) {
my $value = fetch_string ({}, $prefix);
my $withlargefiles = fetch_string ({}, $prefix . "_uselargefiles");
if (defined $withlargefiles) {
$value =~ s/\Q$withlargefiles\E\b//;
$heavy_txt .= "${prefix}_nolargefiles='$value'\n";
}
}
foreach my $prefix (qw(libs libswanted)) {
my $value = fetch_string ({}, $prefix);
my $withlf = fetch_string ({}, 'libswanted_uselargefiles');
next unless defined $withlf;
my @lflibswanted
= split(' ', fetch_string ({}, 'libswanted_uselargefiles'));
if (@lflibswanted) {
my %lflibswanted;
@lflibswanted{@lflibswanted} = ();
if ($prefix eq 'libs') {
my @libs = grep { /^-l(.+)/ &&
not exists $lflibswanted{$1} }
split(' ', fetch_string ({}, 'libs'));
$value = join(' ', @libs);
} else {
my @libswanted = grep { not exists $lflibswanted{$_} }
split(' ', fetch_string ({}, 'libswanted'));
$value = join(' ', @libswanted);
}
}
$heavy_txt .= "${prefix}_nolargefiles='$value'\n";
}
if (open(my $fh, '<', 'cflags')) {
my $ccwarnflags;
my $ccstdflags;
while (<$fh>) {
if (/^warn="(.+)"$/) {
$ccwarnflags = $1;
} elsif (/^stdflags="(.+)"$/) {
$ccstdflags = $1;
}
}
if (defined $ccwarnflags) {
$heavy_txt .= "ccwarnflags='$ccwarnflags'\n";
}
if (defined $ccstdflags) {
$heavy_txt .= "ccstdflags='$ccstdflags'\n";
}
}
# } else {
# my $v = (exists $Config::Config{$qry}) ? $Config::Config{$qry}
# : 'UNKNOWN';
# $v = 'undef' unless defined $v;
# print "${prfx}'${v}'$lnend";
# }
# }
# }
#
# # Called by the real AUTOLOAD
# sub launcher {
# undef &AUTOLOAD;
# goto \&$Config::AUTOLOAD;
# }
#
# 1;
ENDOFEND
if ($^O eq 'os2') {
$config_txt .= uncomment <<'ENDOFSET';
# my %preconfig;
# if ($OS2::is_aout) {
# my ($value, $v) = $Config_SH_expanded =~ m/^used_aout='(.*)'\s*$/m;
# for (split ' ', $value) {
# ($v) = $Config_SH_expanded =~ m/^aout_$_='(.*)'\s*$/m;
# $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*$/;
}
}
$config_txt .= uncomment <<ENDOFSET if $dll;
# \$preconfig{dll_name} = '$dll';
ENDOFSET
} else {
$config_txt .= uncomment <<'ENDOFSET';
# sub TIEHASH {
# bless $_[1], $_[0];
# }
ENDOFSET
}
foreach my $key (keys %Common) {
my $value = fetch_string ({}, $key);
# Is it safe on the LHS of => ?
my $qkey = $key =~ /^[A-Za-z_][A-Za-z0-9_]*$/ ? $key : "'$key'";
if (defined $value) {
# Quote things for a '' string
$value =~ s!\\!\\\\!g;
$value =~ s!'!\\'!g;
$value = "'$value'";
if ($key eq 'otherlibdirs') {
$value = "join (':', map {relocate_inc(\$_)} split (':', $value))";
} elsif ($need_relocation{$key}) {
$value = "relocate_inc($value)";
}
} else {
$value = "undef";
}
$Common{$key} = "$qkey => $value";
}
if ($Common{byteorder}) {
$Common{byteorder} = 'byteorder => $byteorder';
}
my $fast_config = join '', map { " $_,\n" } sort values %Common;
# Sanity check needed to stop an infinite loop if Config_heavy.pl fails to
# define &launcher for some reason (eg it got truncated)
$config_txt .= sprintf uncomment <<'ENDOFTIE', $fast_config;
#
# sub DESTROY { }
#
# sub AUTOLOAD {
# require 'Config_heavy.pl';
# goto \&launcher unless $Config::AUTOLOAD =~ /launcher$/;
# die "&Config::AUTOLOAD failed on $Config::AUTOLOAD";
# }
#
# # tie returns the object, so the value returned to require will be true.
# tie %%Config, 'Config', {
# %s};
ENDOFTIE
open(CONFIG_POD, '>:raw', $Config_POD) or die "Can't open $Config_POD: $!";
print CONFIG_POD uncomment <<'ENDOFTAIL';
# =head1 NAME
#
# =for comment Generated by configpm. Any changes made here will be lost!
#
# Config - access Perl configuration information
#
# =head1 SYNOPSIS
#
# use Config;
# if ($Config{usethreads}) {
# print "has thread support\n"
# }
#
# use Config qw(myconfig config_sh config_vars config_re);
#
# print myconfig();
#
# print config_sh();
#
# print config_re();
#
# config_vars(qw(osname archname));
#
#
# =head1 DESCRIPTION
#
# The Config module contains all the information that was available to
# the F<Configure> program at Perl build time (over 900 values).
( run in 0.597 second using v1.01-cache-2.11-cpan-5511b514fd6 )