configpm revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./miniperl -w
# commonly used names to put first (and hence lookup fastest)
);
# names of things which may need to have slashes changed to double-colons
# allowed opts as well as specifies default and initial values
my %Allowed_Opts = (
'cross' => '', # --cross=PALTFORM - crosscompiling for PLATFORM
'glossary' => 1, # --no-glossary - no glossary file inclusion,
# for compactness
);
sub opts {
# user specified options
my %given_opts = (
# --opt=smth
# --opt --no-opt --noopt
);
}
return %opts;
}
my $Config_PM;
# creating cross-platform config file
}
else {
}
# 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.
# Define our own import method to avoid pulling in the full Exporter:
sub import {
my $pkg = shift;
my $export_Config = @funcs < @_ ? 1 : 0;
}
return;
}
die "Perl lib version (%s) doesn't match executable version ($])"
unless $^V;
$^V eq %s
my @non_v = ();
my @v_fast = ();
my %v_fast = ();
my @v_others = ();
my $in_v = 0;
my %Data = ();
# This is somewhat grim, but I want the code for parsing config.sh here and
# now so that I can expand $Config{ivsize} and $Config{ivtype}
my $fetch_string = <<'EOT';
# Search for it in the big string
sub fetch_string {
# Check for the common case, ' delimited
# If that failed, check for " delimited
}
# It's the very first thing we found. Skip $start forward
# and figure out the quote mark after the =.
}
else {
}
my $value = substr($Config_SH, $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
$value =~ s/\$/\\\$/g;
$value =~ s/\@/\\\@/g;
}
# So we can say "if $Config{'foo'}".
}
eval $fetch_string;
die if $@;
while (<CONFIG_SH>) {
# Catch PERL_CONFIG_SH=true and PERL_VERSION=n line from Configure.
my($k, $v) = ($1, $2);
# grandfather PATCHLEVEL and SUBVERSION and CONFIG
if ($k) {
}
}
}
}
# We can delimit things in config.sh with either ' or ".
next;
}
$quote = $2;
if ($in_v) {
$val .= $_;
}
else {
($name,$val) = ($1,$3);
}
$in_v = $val !~ /$quote\n/;
next if $in_v;
s,/,::,g if $Extensions{$name};
$val =~ s/$quote\n?\z//;
my $line = "$name=$quote$val$quote\n";
if (!$Common{$name}){
push(@v_others, $line);
}
else {
push(@v_fast, $line);
}
}
close CONFIG_SH;
print CONFIG @non_v, "\n";
# copy config summary format from the myconfig.SH script
open(MYCONFIG,"<myconfig.SH") || die "open myconfig.SH failed: $!";
1 while defined($_ = <MYCONFIG>) && !/^Summary of/;
do { print CONFIG $_ } until !defined($_ = <MYCONFIG>) || /^\s*$/;
close(MYCONFIG);
# NB. as $summary is unique, we need to copy it in a lexical variable
# before expanding it, because may have been made readonly if a perl
# interpreter has been cloned.
my $summary_expanded;
sub myconfig {
return $summary_expanded if $summary_expanded;
($summary_expanded = $summary) =~ s{\$(\w+)}
$summary_expanded;
}
EOT
print CONFIG join("", @v_fast, sort @v_others);
print CONFIG "!END!\n", $fetch_string;
sub fetch_virtual {
my($self, $key) = @_;
my $value;
if ($key =~ /^((?: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 $new_key = "${1}_uselargefiles";
$value = $Config{$1};
my $withlargefiles = $Config{$new_key};
if ($new_key =~ /^(?:cc|ld)flags_/) {
$value =~ s/\Q$withlargefiles\E\b//;
} elsif ($new_key =~ /^libs/) {
my @lflibswanted = split(' ', $Config{libswanted_uselargefiles});
if (@lflibswanted) {
my %lflibswanted;
@lflibswanted{@lflibswanted} = ();
if ($new_key =~ /^libs_/) {
my @libs = grep { /^-l(.+)/ &&
not exists $lflibswanted{$1} }
split(' ', $Config{libs});
$Config{libs} = join(' ', @libs);
} elsif ($new_key =~ /^libswanted_/) {
my @libswanted = grep { not exists $lflibswanted{$_} }
split(' ', $Config{libswanted});
$Config{libswanted} = join(' ', @libswanted);
}
}
}
}
$self->{$key} = $value;
}
sub FETCH {
my($self, $key) = @_;
# check for cached value (which may be undef so we use exists not defined)
return $self->{$key} if exists $self->{$key};
$self->fetch_string($key);
return $self->{$key} if exists $self->{$key};
$self->fetch_virtual($key);
# Might not exist, in which undef is correct.
return $self->{$key};
}
my $prevpos = 0;
sub FIRSTKEY {
$prevpos = 0;
substr($Config_SH, 0, index($Config_SH, '=') );
}
sub NEXTKEY {
}
sub EXISTS {
);
}
sub config_sh {
}
sub config_re {
my $re = shift;
}
sub config_vars {
foreach (@_) {
if (/\W/) {
} else {
print "$_='$v';\n";
}
}
}
my %preconfig;
}
}
# Extract the name of the DLL from the makefile to avoid duplication
my $dll;
}
}
print CONFIG <<ENDOFSET if $dll;
\$preconfig{dll_name} = '$dll';
ENDOFSET
} else {
sub TIEHASH {
bless $_[1], $_[0];
}
}
# Calculation for the keys for byteorder
# This is somewhat grim, but I need to run fetch_string here.
# 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 $byteorder_code;
if ($s == 4 || $s == 8) {
my \$i = 0;
} else {
}
# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
sub DESTROY { }
%s
%s
};
1;
use Config;
print "built by gcc\n";
}
=over 4
names match the $regex.
=item config_vars(@names)
Prints to STDOUT the values of the named configuration variable. Each is
printed on a separate line in the form:
=back
=head1 EXAMPLE
use Config;
use strict;
my %sig_num;
my @sig_name;
} else {
}
}
}
interpolation, any C<$> and C<@> characters are replaced by C<\$> and
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
on platforms supported by it (which is most UNIX platforms). Some
platforms have custom-made C<Config> variables, and may thus not have
some of the variables described below, or may have extraneous variables
specific to that particular port. See the port specific documentation
in such cases.
ENDOFTAIL
if ($Opts{glossary}) {
}
%seen = ();
$text = 0;
$/ = '';
sub process {
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_POD <<EOF if $text;
=back
EOF
print CONFIG_POD <<EOF;
=head2 $c
=over 4
EOF
$text = 1;
}
}
elsif (!$text || !/\A\t/) {
}
s/n't/n\00t/g; # leave can't, won't etc untouched
s/^\t\s+(.*)/\n$1/gm; # Indented lines ===> new paragraph
s/^(?<!\n\n)\t(.*)/$1/gm; # Not indented lines ===> text
s{([\'\"])(?=[^\'\"\s]*[./][^\'\"\s]*\1)([^\'\"\s]+)\1}(F<$2>)g; # '.o'
s{\'([A-Za-z_\- *=/]+)\'}(C<$1>)g; # 'ln -s'
s{
(?<! [\w./<\'\"] ) # Only standalone file names
(?! e \. g \. ) # Not e.g.
(?! \. \. \. ) # Not ...
(?! \d ) # Not 5.004
(?! 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
}
s/((?<=\s)~\w*)/F<$1>/g; # ~name
s/(?<![.<\'\"])\b([A-Z_]{2,})\b(?![\'\"])/C<$1>/g; # UNISTD
s/(?<![.<\'\"])\b(?!the\b)(\w+)\s+macro\b/C<$1> macro/g; # FILE_cnt macro
s/n[\0]t/n't/g; # undo can't, won't damage
}
if ($Opts{glossary}) {
<GLOS>; # Skip the preamble
while (<GLOS>) {
process;
print CONFIG_POD;
}
}
print CONFIG_POD <<'ENDOFTAIL';
=back
=head1 NOTE
This module contains a good example of how to use tie to implement a
cache and an example of how to make a tied variable readonly to those
outside of it.
=cut
ENDOFTAIL
close(CONFIG);
close(GLOS);
close(CONFIG_POD);
# Now create Cross.pm if needed
if ($Opts{cross}) {
my $cross = <<'EOS';
# typical invocation:
# perl -MCross Makefile.PL
# perl -MCross=wince -V:cc
package Cross;
sub import {
unless (defined $platform) {
# if $platform is not specified, then use last one when
# 'configpm; was invoked with --cross option
$platform = '***replace-marker***';
}
$::Cross::platform = $platform;
}
1;
EOS
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;
unless $Config{'PERL_CONFIG_SH'} eq 'true';
if defined($Config{'an impossible name'})
or $Config{'PERL_CONFIG_SH'} ne 'true' # test cache
;
;
exit 0;