Resolve conflicts.
This commit is contained in:
Mark Murray
parent
56fe559c91
commit
2d278eb6c2
Notes:
svn2git
2020-12-20 02:59:44 +00:00
svn path=/head/; revision=92449
@ -129,41 +129,84 @@ sub FETCH {
|
||||
|
||||
# Search for it in the big string
|
||||
my($value, $start, $marker, $quote_type);
|
||||
$marker = "$_[1]=";
|
||||
|
||||
$quote_type = "'";
|
||||
# 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");
|
||||
# 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);
|
||||
}
|
||||
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 =~ s/\$/\\\$/g;
|
||||
$value =~ s/\@/\\\@/g;
|
||||
eval "\$value = \"$value\"";
|
||||
}
|
||||
#$value = sprintf($value) if $quote_type eq '"';
|
||||
$value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}".
|
||||
# So we can say "if $Config{'foo'}".
|
||||
$value = undef if $value eq 'undef';
|
||||
$_[0]->{$_[1]} = $value; # cache it
|
||||
return $value;
|
||||
}
|
||||
@ -192,7 +235,8 @@ sub EXISTS {
|
||||
index($config_sh, "\n$_[1]='") != -1 or
|
||||
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]=\"";
|
||||
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" }
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
# This -*- perl -*- script makes the Makefile
|
||||
# $Id: Makefile.PL,v 1.1.1.2 1999/05/02 14:20:37 markm Exp $
|
||||
# $FreeBSD$
|
||||
|
||||
require 5.002;
|
||||
use ExtUtils::MakeMaker;
|
||||
@ -31,7 +31,7 @@ WriteMakefile(
|
||||
|
||||
'clean' => {FILES => join(" ",
|
||||
map { "$_ */$_ */*/$_" }
|
||||
qw(*% *.html *.b[ac]k *.old *.orig))
|
||||
qw(*% *.html *.b[ac]k *.old))
|
||||
},
|
||||
'macro' => { INSTALLDIRS => 'perl' },
|
||||
);
|
||||
|
||||
@ -3,12 +3,7 @@ use ExtUtils::MakeMaker;
|
||||
use Config;
|
||||
my @libs;
|
||||
if ($^O ne 'MSWin32') {
|
||||
if ($Config{archname} =~ /RM\d\d\d-svr4/) {
|
||||
@libs = ('LIBS' => ["-lm -lc -lposix -lcposix"]);
|
||||
}
|
||||
else {
|
||||
@libs = ('LIBS' => ["-lm -lposix -lcposix"]);
|
||||
}
|
||||
@libs = ('LIBS' => ["-lm -lposix -lcposix"]);
|
||||
}
|
||||
WriteMakefile(
|
||||
NAME => 'POSIX',
|
||||
|
||||
@ -56,6 +56,9 @@
|
||||
#ifdef I_UNISTD
|
||||
#include <unistd.h>
|
||||
#endif
|
||||
#ifdef MACOS_TRADITIONAL
|
||||
#undef fdopen
|
||||
#endif
|
||||
#include <fcntl.h>
|
||||
|
||||
#if defined(__VMS) && !defined(__POSIX_SOURCE)
|
||||
@ -81,7 +84,7 @@
|
||||
|
||||
/* The non-POSIX CRTL times() has void return type, so we just get the
|
||||
current time directly */
|
||||
clock_t vms_times(struct tms *PL_bufptr) {
|
||||
clock_t vms_times(struct tms *bufptr) {
|
||||
dTHX;
|
||||
clock_t retval;
|
||||
/* Get wall time and convert to 10 ms intervals to
|
||||
@ -102,7 +105,7 @@
|
||||
_ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
|
||||
# endif
|
||||
/* Fill in the struct tms using the CRTL routine . . .*/
|
||||
times((tbuffer_t *)PL_bufptr);
|
||||
times((tbuffer_t *)bufptr);
|
||||
return (clock_t) retval;
|
||||
}
|
||||
# define times(t) vms_times(t)
|
||||
@ -140,10 +143,12 @@
|
||||
# define sigdelset(a,b) not_here("sigdelset")
|
||||
# define sigfillset(a) not_here("sigfillset")
|
||||
# define sigismember(a,b) not_here("sigismember")
|
||||
# define setuid(a) not_here("setuid")
|
||||
# define setgid(a) not_here("setgid")
|
||||
#else
|
||||
|
||||
# ifndef HAS_MKFIFO
|
||||
# ifdef OS2
|
||||
# if defined(OS2) || defined(MACOS_TRADITIONAL)
|
||||
# define mkfifo(a,b) not_here("mkfifo")
|
||||
# else /* !( defined OS2 ) */
|
||||
# ifndef mkfifo
|
||||
@ -152,12 +157,17 @@
|
||||
# endif
|
||||
# endif /* !HAS_MKFIFO */
|
||||
|
||||
# include <grp.h>
|
||||
# include <sys/times.h>
|
||||
# ifdef HAS_UNAME
|
||||
# include <sys/utsname.h>
|
||||
# ifdef MACOS_TRADITIONAL
|
||||
# define ttyname(a) (char*)not_here("ttyname")
|
||||
# define tzset() not_here("tzset")
|
||||
# else
|
||||
# include <grp.h>
|
||||
# include <sys/times.h>
|
||||
# ifdef HAS_UNAME
|
||||
# include <sys/utsname.h>
|
||||
# endif
|
||||
# include <sys/wait.h>
|
||||
# endif
|
||||
# include <sys/wait.h>
|
||||
# ifdef I_UTIME
|
||||
# include <utime.h>
|
||||
# endif
|
||||
@ -530,12 +540,12 @@ mini_mktime(struct tm *ptm)
|
||||
}
|
||||
|
||||
#ifdef HAS_LONG_DOUBLE
|
||||
# if LONG_DOUBLESIZE > DOUBLESIZE
|
||||
# if LONG_DOUBLESIZE > NVSIZE
|
||||
# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef HAS_LONG_DOUBLE
|
||||
#ifndef HAS_LONG_DOUBLE
|
||||
#ifdef LDBL_MAX
|
||||
#undef LDBL_MAX
|
||||
#endif
|
||||
@ -555,11 +565,7 @@ not_here(char *s)
|
||||
}
|
||||
|
||||
static
|
||||
#if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
|
||||
long double
|
||||
#else
|
||||
double
|
||||
#endif
|
||||
NV
|
||||
constant(char *name, int arg)
|
||||
{
|
||||
errno = 0;
|
||||
@ -1518,6 +1524,11 @@ constant(char *name, int arg)
|
||||
break;
|
||||
case 'H':
|
||||
if (strEQ(name, "HUGE_VAL"))
|
||||
#if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
|
||||
/* HUGE_VALL is admittedly non-POSIX but if we are using long doubles
|
||||
* we might as well use long doubles. --jhi */
|
||||
return HUGE_VALL;
|
||||
#endif
|
||||
#ifdef HUGE_VAL
|
||||
return HUGE_VAL;
|
||||
#else
|
||||
@ -2292,9 +2303,9 @@ constant(char *name, int arg)
|
||||
#else
|
||||
goto not_there;
|
||||
#endif
|
||||
if (strEQ(name, "STRERR_FILENO"))
|
||||
#ifdef STRERR_FILENO
|
||||
return STRERR_FILENO;
|
||||
if (strEQ(name, "STDERR_FILENO"))
|
||||
#ifdef STDERR_FILENO
|
||||
return STDERR_FILENO;
|
||||
#else
|
||||
goto not_there;
|
||||
#endif
|
||||
@ -3006,7 +3017,7 @@ setcc(termios_ref, ccix, cc)
|
||||
|
||||
MODULE = POSIX PACKAGE = POSIX
|
||||
|
||||
double
|
||||
NV
|
||||
constant(name,arg)
|
||||
char * name
|
||||
int arg
|
||||
@ -3162,7 +3173,7 @@ localeconv()
|
||||
#ifdef HAS_LOCALECONV
|
||||
struct lconv *lcbuf;
|
||||
RETVAL = newHV();
|
||||
if (lcbuf = localeconv()) {
|
||||
if ((lcbuf = localeconv())) {
|
||||
/* the strings */
|
||||
if (lcbuf->decimal_point && *lcbuf->decimal_point)
|
||||
hv_store(RETVAL, "decimal_point", 13,
|
||||
@ -3295,73 +3306,73 @@ setlocale(category, locale = 0)
|
||||
RETVAL
|
||||
|
||||
|
||||
double
|
||||
NV
|
||||
acos(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
asin(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
atan(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
ceil(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
cosh(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
floor(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
fmod(x,y)
|
||||
double x
|
||||
double y
|
||||
NV x
|
||||
NV y
|
||||
|
||||
void
|
||||
frexp(x)
|
||||
double x
|
||||
NV x
|
||||
PPCODE:
|
||||
int expvar;
|
||||
/* (We already know stack is long enough.) */
|
||||
PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
|
||||
PUSHs(sv_2mortal(newSViv(expvar)));
|
||||
|
||||
double
|
||||
NV
|
||||
ldexp(x,exp)
|
||||
double x
|
||||
NV x
|
||||
int exp
|
||||
|
||||
double
|
||||
NV
|
||||
log10(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
void
|
||||
modf(x)
|
||||
double x
|
||||
NV x
|
||||
PPCODE:
|
||||
double intvar;
|
||||
NV intvar;
|
||||
/* (We already know stack is long enough.) */
|
||||
PUSHs(sv_2mortal(newSVnv(modf(x,&intvar))));
|
||||
PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
|
||||
PUSHs(sv_2mortal(newSVnv(intvar)));
|
||||
|
||||
double
|
||||
NV
|
||||
sinh(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
tan(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
double
|
||||
NV
|
||||
tanh(x)
|
||||
double x
|
||||
NV x
|
||||
|
||||
SysRet
|
||||
sigaction(sig, action, oldaction = 0)
|
||||
@ -3407,9 +3418,8 @@ sigaction(sig, action, oldaction = 0)
|
||||
/* Set up any desired mask. */
|
||||
svp = hv_fetch(action, "MASK", 4, FALSE);
|
||||
if (svp && sv_isa(*svp, "POSIX::SigSet")) {
|
||||
unsigned long tmp;
|
||||
tmp = (unsigned long)SvNV((SV*)SvRV(*svp));
|
||||
sigset = (sigset_t*) tmp;
|
||||
IV tmp = SvIV((SV*)SvRV(*svp));
|
||||
sigset = INT2PTR(sigset_t*, tmp);
|
||||
act.sa_mask = *sigset;
|
||||
}
|
||||
else
|
||||
@ -3434,9 +3444,8 @@ sigaction(sig, action, oldaction = 0)
|
||||
/* Get back the mask. */
|
||||
svp = hv_fetch(oldaction, "MASK", 4, TRUE);
|
||||
if (sv_isa(*svp, "POSIX::SigSet")) {
|
||||
unsigned long tmp;
|
||||
tmp = (unsigned long)SvNV((SV*)SvRV(*svp));
|
||||
sigset = (sigset_t*) tmp;
|
||||
IV tmp = SvIV((SV*)SvRV(*svp));
|
||||
sigset = INT2PTR(sigset_t*, tmp);
|
||||
}
|
||||
else {
|
||||
New(0, sigset, 1, sigset_t);
|
||||
@ -3507,7 +3516,7 @@ SysRet
|
||||
nice(incr)
|
||||
int incr
|
||||
|
||||
int
|
||||
void
|
||||
pipe()
|
||||
PPCODE:
|
||||
int fds[2];
|
||||
@ -3550,7 +3559,7 @@ tcsetpgrp(fd, pgrp_id)
|
||||
int fd
|
||||
pid_t pgrp_id
|
||||
|
||||
int
|
||||
void
|
||||
uname()
|
||||
PPCODE:
|
||||
#ifdef HAS_UNAME
|
||||
@ -3684,7 +3693,7 @@ strtoul(str, base = 0)
|
||||
PUSHs(&PL_sv_undef);
|
||||
}
|
||||
|
||||
SV *
|
||||
void
|
||||
strxfrm(src)
|
||||
SV * src
|
||||
CODE:
|
||||
@ -3819,7 +3828,10 @@ mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
|
||||
OUTPUT:
|
||||
RETVAL
|
||||
|
||||
char *
|
||||
#XXX: if $xsubpp::WantOptimize is always the default
|
||||
# sv_setpv(TARG, ...) could be used rather than
|
||||
# ST(0) = sv_2mortal(newSVpv(...))
|
||||
void
|
||||
strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
|
||||
char * fmt
|
||||
int sec
|
||||
|
||||
@ -87,8 +87,6 @@ case "$osvers" in
|
||||
d_setegid='undef'
|
||||
d_seteuid='undef'
|
||||
;;
|
||||
#
|
||||
# Guesses at what will be needed after 2.2
|
||||
*) usevfork='true'
|
||||
usemymalloc='n'
|
||||
libswanted=`echo $libswanted | sed 's/ malloc / /'`
|
||||
@ -180,7 +178,7 @@ $define|true|[yY]*)
|
||||
0*|1*|2.0*|2.1*) cat <<EOM >&4
|
||||
I did not know that FreeBSD $osvers supports POSIX threads.
|
||||
|
||||
Feel free to tell perlbug@perl.com otherwise.
|
||||
Feel free to tell perlbug@perl.org otherwise.
|
||||
EOM
|
||||
exit 1
|
||||
;;
|
||||
@ -190,7 +188,8 @@ EOM
|
||||
POSIX threads are not supported well by FreeBSD $osvers.
|
||||
|
||||
Please consider upgrading to at least FreeBSD 2.2.8,
|
||||
or preferably to 3.something.
|
||||
or preferably to the most recent -RELEASE or -STABLE
|
||||
version (see http://www.freebsd.org/releases/).
|
||||
|
||||
(While 2.2.7 does have pthreads, it has some problems
|
||||
with the combination of threads and pipes and therefore
|
||||
|
||||
@ -4,7 +4,7 @@ require 5.000;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
getcwd - get pathname of current working directory
|
||||
Cwd - get pathname of current working directory
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
@ -14,6 +14,9 @@ getcwd - get pathname of current working directory
|
||||
use Cwd;
|
||||
$dir = getcwd;
|
||||
|
||||
use Cwd;
|
||||
$dir = fastcwd;
|
||||
|
||||
use Cwd;
|
||||
$dir = fastgetcwd;
|
||||
|
||||
@ -29,16 +32,21 @@ getcwd - get pathname of current working directory
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides functions for determining the pathname of the
|
||||
current working directory. By default, it exports the functions
|
||||
cwd(), getcwd(), fastcwd(), and fastgetcwd() into the caller's
|
||||
namespace. Each of these functions are called without arguments and
|
||||
return the absolute path of the current working directory. It is
|
||||
recommended that cwd (or another *cwd() function) be used in I<all>
|
||||
code to ensure portability.
|
||||
|
||||
The cwd() is the most natural and safe form for the current
|
||||
architecture. For most systems it is identical to `pwd` (but without
|
||||
the trailing line terminator).
|
||||
|
||||
The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
|
||||
in Perl.
|
||||
|
||||
The abs_path() function takes a single argument and returns the
|
||||
absolute pathname for that argument. It uses the same algorithm
|
||||
as getcwd(). (Actually, getcwd() is abs_path(".")) Symbolic links
|
||||
and relative-path components ("." and "..") are resolved to return
|
||||
the canonical pathname, just like realpath(3). Also callable as
|
||||
realpath().
|
||||
|
||||
The fastcwd() function looks the same as getcwd(), but runs faster.
|
||||
It's also more dangerous because it might conceivably chdir() you out
|
||||
of a directory that it can't chdir() you back into. If fastcwd
|
||||
@ -49,16 +57,17 @@ that it leaves you in the same directory that it started in. If it has
|
||||
changed it will C<die> with the message "Unstable directory path,
|
||||
current directory changed unexpectedly". That should never happen.
|
||||
|
||||
The fast_abs_path() function looks the same as abs_path(), but runs faster.
|
||||
And like fastcwd() is more dangerous.
|
||||
The fastgetcwd() function is provided as a synonym for cwd().
|
||||
|
||||
The cwd() function looks the same as getcwd and fastgetcwd but is
|
||||
implemented using the most natural and safe form for the current
|
||||
architecture. For most systems it is identical to `pwd` (but without
|
||||
the trailing line terminator).
|
||||
The abs_path() function takes a single argument and returns the
|
||||
absolute pathname for that argument. It uses the same algorithm as
|
||||
getcwd(). (Actually, getcwd() is abs_path(".")) Symbolic links and
|
||||
relative-path components ("." and "..") are resolved to return the
|
||||
canonical pathname, just like realpath(3). This function is also
|
||||
callable as realpath().
|
||||
|
||||
It is recommended that cwd (or another *cwd() function) is used in
|
||||
I<all> code to ensure portability.
|
||||
The fast_abs_path() function looks the same as abs_path() but runs
|
||||
faster and, like fastcwd(), is more dangerous.
|
||||
|
||||
If you ask to override your chdir() built-in function, then your PWD
|
||||
environment variable will be kept up to date. (See
|
||||
@ -67,31 +76,42 @@ kept up to date if all packages which use chdir import it from Cwd.
|
||||
|
||||
=cut
|
||||
|
||||
## use strict;
|
||||
use strict;
|
||||
|
||||
use Carp;
|
||||
|
||||
$VERSION = '2.02';
|
||||
our $VERSION = '2.04';
|
||||
|
||||
require Exporter;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
|
||||
@EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
|
||||
use base qw/ Exporter /;
|
||||
our @EXPORT = qw(cwd getcwd fastcwd fastgetcwd);
|
||||
our @EXPORT_OK = qw(chdir abs_path fast_abs_path realpath fast_realpath);
|
||||
|
||||
|
||||
# The 'natural and safe form' for UNIX (pwd may be setuid root)
|
||||
|
||||
sub _backtick_pwd {
|
||||
my $cwd;
|
||||
chop($cwd = `/bin/pwd`);
|
||||
my $cwd = `/bin/pwd`;
|
||||
# `pwd` may fail e.g. if the disk is full
|
||||
chomp($cwd) if defined $cwd;
|
||||
$cwd;
|
||||
}
|
||||
|
||||
# Since some ports may predefine cwd internally (e.g., NT)
|
||||
# we take care not to override an existing definition for cwd().
|
||||
|
||||
*cwd = \&_backtick_pwd unless defined &cwd;
|
||||
unless(defined &cwd) {
|
||||
# The pwd command is not available in some chroot(2)'ed environments
|
||||
if($^O eq 'MacOS' || grep { -x "$_/pwd" } split(':', $ENV{PATH})) {
|
||||
*cwd = \&_backtick_pwd;
|
||||
}
|
||||
else {
|
||||
*cwd = \&getcwd;
|
||||
}
|
||||
}
|
||||
|
||||
# set a reasonable (and very safe) default for fastgetcwd, in case it
|
||||
# isn't redefined later (20001212 rspier)
|
||||
*fastgetcwd = \&cwd;
|
||||
|
||||
# By Brandon S. Allbery
|
||||
#
|
||||
@ -157,7 +177,7 @@ sub fastcwd {
|
||||
my $chdir_init = 0;
|
||||
|
||||
sub chdir_init {
|
||||
if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos') {
|
||||
if ($ENV{'PWD'} and $^O ne 'os2' and $^O ne 'dos' and $^O ne 'MSWin32') {
|
||||
my($dd,$di) = stat('.');
|
||||
my($pd,$pi) = stat($ENV{'PWD'});
|
||||
if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) {
|
||||
@ -165,10 +185,12 @@ sub chdir_init {
|
||||
}
|
||||
}
|
||||
else {
|
||||
$ENV{'PWD'} = cwd();
|
||||
my $wd = cwd();
|
||||
$wd = Win32::GetFullPathName($wd) if $^O eq 'MSWin32';
|
||||
$ENV{'PWD'} = $wd;
|
||||
}
|
||||
# Strip an automounter prefix (where /tmp_mnt/foo/bar == /foo/bar)
|
||||
if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
|
||||
if ($^O ne 'MSWin32' and $ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|s) {
|
||||
my($pd,$pi) = stat($2);
|
||||
my($dd,$di) = stat($1);
|
||||
if (defined $pd and defined $dd and $di == $pi and $dd == $pd) {
|
||||
@ -179,11 +201,27 @@ sub chdir_init {
|
||||
}
|
||||
|
||||
sub chdir {
|
||||
my $newdir = shift || ''; # allow for no arg (chdir to HOME dir)
|
||||
$newdir =~ s|///*|/|g;
|
||||
my $newdir = @_ ? shift : ''; # allow for no arg (chdir to HOME dir)
|
||||
$newdir =~ s|///*|/|g unless $^O eq 'MSWin32';
|
||||
chdir_init() unless $chdir_init;
|
||||
my $newpwd;
|
||||
if ($^O eq 'MSWin32') {
|
||||
# get the full path name *before* the chdir()
|
||||
$newpwd = Win32::GetFullPathName($newdir);
|
||||
}
|
||||
|
||||
return 0 unless CORE::chdir $newdir;
|
||||
if ($^O eq 'VMS') { return $ENV{'PWD'} = $ENV{'DEFAULT'} }
|
||||
|
||||
if ($^O eq 'VMS') {
|
||||
return $ENV{'PWD'} = $ENV{'DEFAULT'}
|
||||
}
|
||||
elsif ($^O eq 'MacOS') {
|
||||
return $ENV{'PWD'} = cwd();
|
||||
}
|
||||
elsif ($^O eq 'MSWin32') {
|
||||
$ENV{'PWD'} = $newpwd;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if ($newdir =~ m#^/#s) {
|
||||
$ENV{'PWD'} = $newdir;
|
||||
@ -264,7 +302,7 @@ sub abs_path
|
||||
|
||||
sub fast_abs_path {
|
||||
my $cwd = getcwd();
|
||||
my $path = shift || '.';
|
||||
my $path = @_ ? shift : '.';
|
||||
CORE::chdir($path) || croak "Cannot chdir to $path:$!";
|
||||
my $realpath = getcwd();
|
||||
CORE::chdir($cwd) || croak "Cannot chdir back to $cwd:$!";
|
||||
@ -333,12 +371,17 @@ sub _qnx_cwd {
|
||||
}
|
||||
|
||||
sub _qnx_abs_path {
|
||||
my $path = shift || '.';
|
||||
my $path = @_ ? shift : '.';
|
||||
my $realpath=`/usr/bin/fullpath -t $path`;
|
||||
chop $realpath;
|
||||
return $realpath;
|
||||
}
|
||||
|
||||
sub _epoc_cwd {
|
||||
$ENV{'PWD'} = EPOC::getcwd();
|
||||
return $ENV{'PWD'};
|
||||
}
|
||||
|
||||
{
|
||||
no warnings; # assignments trigger 'subroutine redefined' warning
|
||||
|
||||
@ -387,6 +430,19 @@ sub _qnx_abs_path {
|
||||
*fastcwd = \&cwd;
|
||||
*abs_path = \&fast_abs_path;
|
||||
}
|
||||
elsif ($^O eq 'epoc') {
|
||||
*cwd = \&_epoc_cwd;
|
||||
*getcwd = \&_epoc_cwd;
|
||||
*fastgetcwd = \&_epoc_cwd;
|
||||
*fastcwd = \&_epoc_cwd;
|
||||
*abs_path = \&fast_abs_path;
|
||||
}
|
||||
elsif ($^O eq 'MacOS') {
|
||||
*getcwd = \&cwd;
|
||||
*fastgetcwd = \&cwd;
|
||||
*fastcwd = \&cwd;
|
||||
*abs_path = \&fast_abs_path;
|
||||
}
|
||||
}
|
||||
|
||||
# package main; eval join('',<DATA>) || die $@; # quick test
|
||||
|
||||
@ -18,6 +18,28 @@ my $splitchar = $^O eq 'VMS' ? '|' : ($^O eq 'os2' || $^O eq 'dos') ? ';' : ':';
|
||||
my @PERL_ENV_LIB = split $splitchar, defined $ENV{'PERL5LIB'} ? $ENV{'PERL5LIB'} : $ENV{'PERLLIB'} || '';
|
||||
my $Inc_uninstall_warn_handler;
|
||||
|
||||
# install relative to here
|
||||
|
||||
my $INSTALL_ROOT = $ENV{PERL_INSTALL_ROOT};
|
||||
|
||||
use File::Spec;
|
||||
|
||||
sub install_rooted_file {
|
||||
if (defined $INSTALL_ROOT) {
|
||||
MY->catfile($INSTALL_ROOT, $_[0]);
|
||||
} else {
|
||||
$_[0];
|
||||
}
|
||||
}
|
||||
|
||||
sub install_rooted_dir {
|
||||
if (defined $INSTALL_ROOT) {
|
||||
MY->catdir($INSTALL_ROOT, $_[0]);
|
||||
} else {
|
||||
$_[0];
|
||||
}
|
||||
}
|
||||
|
||||
#our(@EXPORT, @ISA, $Is_VMS);
|
||||
#use strict;
|
||||
|
||||
@ -57,8 +79,9 @@ sub install {
|
||||
opendir DIR, $source_dir_or_file or next;
|
||||
for (readdir DIR) {
|
||||
next if $_ eq "." || $_ eq ".." || $_ eq ".exists";
|
||||
if (-w $hash{$source_dir_or_file} ||
|
||||
mkpath($hash{$source_dir_or_file})) {
|
||||
my $targetdir = install_rooted_dir($hash{$source_dir_or_file});
|
||||
if (-w $targetdir ||
|
||||
mkpath($targetdir)) {
|
||||
last;
|
||||
} else {
|
||||
warn "Warning: You do not have permissions to " .
|
||||
@ -68,7 +91,8 @@ sub install {
|
||||
}
|
||||
closedir DIR;
|
||||
}
|
||||
$packlist->read($pack{"read"}) if (-f $pack{"read"});
|
||||
my $tmpfile = install_rooted_file($pack{"read"});
|
||||
$packlist->read($tmpfile) if (-f $tmpfile);
|
||||
my $cwd = cwd();
|
||||
|
||||
my($source);
|
||||
@ -85,11 +109,13 @@ sub install {
|
||||
#October 1997: we want to install .pm files into archlib if
|
||||
#there are any files in arch. So we depend on having ./blib/arch
|
||||
#hardcoded here.
|
||||
my $targetroot = $hash{$source};
|
||||
|
||||
my $targetroot = install_rooted_dir($hash{$source});
|
||||
|
||||
if ($source eq "blib/lib" and
|
||||
exists $hash{"blib/arch"} and
|
||||
directory_not_empty("blib/arch")) {
|
||||
$targetroot = $hash{"blib/arch"};
|
||||
$targetroot = install_rooted_dir($hash{"blib/arch"});
|
||||
print "Files found in blib/arch: installing files in blib/lib into architecture dependent library tree\n";
|
||||
}
|
||||
chdir($source) or next;
|
||||
@ -98,8 +124,9 @@ sub install {
|
||||
$atime,$mtime,$ctime,$blksize,$blocks) = stat;
|
||||
return unless -f _;
|
||||
return if $_ eq ".exists";
|
||||
my $targetdir = MY->catdir($targetroot,$File::Find::dir);
|
||||
my $targetfile = MY->catfile($targetdir,$_);
|
||||
my $targetdir = MY->catdir($targetroot, $File::Find::dir);
|
||||
my $origfile = $_;
|
||||
my $targetfile = MY->catfile($targetdir, $_);
|
||||
|
||||
my $diff = 0;
|
||||
if ( -f $targetfile && -s _ == $size) {
|
||||
@ -136,16 +163,16 @@ sub install {
|
||||
} else {
|
||||
inc_uninstall($_,$File::Find::dir,$verbose,0); # nonono set to 0
|
||||
}
|
||||
$packlist->{$targetfile}++;
|
||||
$packlist->{$origfile}++;
|
||||
|
||||
}, ".");
|
||||
chdir($cwd) or Carp::croak("Couldn't chdir to $cwd: $!");
|
||||
}
|
||||
if ($pack{'write'}) {
|
||||
$dir = dirname($pack{'write'});
|
||||
$dir = install_rooted_dir(dirname($pack{'write'}));
|
||||
mkpath($dir,0,0755);
|
||||
print "Writing $pack{'write'}\n";
|
||||
$packlist->write($pack{'write'});
|
||||
$packlist->write(install_rooted_file($pack{'write'}));
|
||||
}
|
||||
}
|
||||
|
||||
@ -242,8 +269,22 @@ sub inc_uninstall {
|
||||
}
|
||||
}
|
||||
|
||||
sub run_filter {
|
||||
my ($cmd, $src, $dest) = @_;
|
||||
local *SRC, *CMD;
|
||||
open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
|
||||
open(SRC, $src) || die "Cannot open $src: $!";
|
||||
my $buf;
|
||||
my $sz = 1024;
|
||||
while (my $len = sysread(SRC, $buf, $sz)) {
|
||||
syswrite(CMD, $buf, $len);
|
||||
}
|
||||
close SRC;
|
||||
close CMD or die "Filter command '$cmd' failed for $src";
|
||||
}
|
||||
|
||||
sub pm_to_blib {
|
||||
my($fromto,$autodir) = @_;
|
||||
my($fromto,$autodir,$pm_filter) = @_;
|
||||
|
||||
use File::Basename qw(dirname);
|
||||
use File::Copy qw(copy);
|
||||
@ -266,23 +307,37 @@ sub pm_to_blib {
|
||||
|
||||
mkpath($autodir,0,0755);
|
||||
foreach (keys %$fromto) {
|
||||
next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
|
||||
unless (compare($_,$fromto->{$_})){
|
||||
print "Skip $fromto->{$_} (unchanged)\n";
|
||||
my $dest = $fromto->{$_};
|
||||
next if -f $dest && -M $dest < -M $_;
|
||||
|
||||
# When a pm_filter is defined, we need to pre-process the source first
|
||||
# to determine whether it has changed or not. Therefore, only perform
|
||||
# the comparison check when there's no filter to be ran.
|
||||
# -- RAM, 03/01/2001
|
||||
|
||||
my $need_filtering = defined $pm_filter && length $pm_filter && /\.pm$/;
|
||||
|
||||
if (!$need_filtering && 0 == compare($_,$dest)) {
|
||||
print "Skip $dest (unchanged)\n";
|
||||
next;
|
||||
}
|
||||
if (-f $fromto->{$_}){
|
||||
forceunlink($fromto->{$_});
|
||||
if (-f $dest){
|
||||
forceunlink($dest);
|
||||
} else {
|
||||
mkpath(dirname($fromto->{$_}),0,0755);
|
||||
mkpath(dirname($dest),0,0755);
|
||||
}
|
||||
if ($need_filtering) {
|
||||
run_filter($pm_filter, $_, $dest);
|
||||
print "$pm_filter <$_ >$dest\n";
|
||||
} else {
|
||||
copy($_,$dest);
|
||||
print "cp $_ $dest\n";
|
||||
}
|
||||
copy($_,$fromto->{$_});
|
||||
my($mode,$atime,$mtime) = (stat)[2,8,9];
|
||||
utime($atime,$mtime+$Is_VMS,$fromto->{$_});
|
||||
chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$fromto->{$_});
|
||||
print "cp $_ $fromto->{$_}\n";
|
||||
next unless /\.pm\z/;
|
||||
autosplit($fromto->{$_},$autodir);
|
||||
utime($atime,$mtime+$Is_VMS,$dest);
|
||||
chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$dest);
|
||||
next unless /\.pm$/;
|
||||
autosplit($dest,$autodir);
|
||||
}
|
||||
}
|
||||
|
||||
@ -296,18 +351,20 @@ sub add {
|
||||
}
|
||||
|
||||
sub DESTROY {
|
||||
my $self = shift;
|
||||
my($file,$i,$plural);
|
||||
foreach $file (sort keys %$self) {
|
||||
$plural = @{$self->{$file}} > 1 ? "s" : "";
|
||||
print "## Differing version$plural of $file found. You might like to\n";
|
||||
for (0..$#{$self->{$file}}) {
|
||||
print "rm ", $self->{$file}[$_], "\n";
|
||||
$i++;
|
||||
unless(defined $INSTALL_ROOT) {
|
||||
my $self = shift;
|
||||
my($file,$i,$plural);
|
||||
foreach $file (sort keys %$self) {
|
||||
$plural = @{$self->{$file}} > 1 ? "s" : "";
|
||||
print "## Differing version$plural of $file found. You might like to\n";
|
||||
for (0..$#{$self->{$file}}) {
|
||||
print "rm ", $self->{$file}[$_], "\n";
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
$plural = $i>1 ? "all those files" : "this file";
|
||||
print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
|
||||
}
|
||||
}
|
||||
$plural = $i>1 ? "all those files" : "this file";
|
||||
print "## Running 'make install UNINST=1' will unlink $plural for you.\n";
|
||||
}
|
||||
|
||||
1;
|
||||
@ -370,6 +427,11 @@ no-don't-really-do-it-now switch.
|
||||
pm_to_blib() takes a hashref as the first argument and copies all keys
|
||||
of the hash to the corresponding values efficiently. Filenames with
|
||||
the extension pm are autosplit. Second argument is the autosplit
|
||||
directory.
|
||||
directory. If third argument is not empty, it is taken as a filter command
|
||||
to be ran on each .pm file, the output of the command being what is finally
|
||||
copied, and the source for auto-splitting.
|
||||
|
||||
You can have an environment variable PERL_INSTALL_ROOT set which will
|
||||
be prepended as a directory to each installed file (and directory).
|
||||
|
||||
=cut
|
||||
|
||||
@ -1,10 +1,31 @@
|
||||
# $FreeBSD$
|
||||
package ExtUtils::Liblist;
|
||||
|
||||
@ISA = qw(ExtUtils::Liblist::Kid File::Spec);
|
||||
|
||||
sub lsdir {
|
||||
shift;
|
||||
my $rex = qr/$_[1]/;
|
||||
opendir my $dir, $_[0];
|
||||
grep /$rex/, readdir $dir;
|
||||
}
|
||||
|
||||
sub file_name_is_absolute {
|
||||
require File::Spec;
|
||||
shift;
|
||||
'File::Spec'->file_name_is_absolute(@_);
|
||||
}
|
||||
|
||||
|
||||
package ExtUtils::Liblist::Kid;
|
||||
|
||||
# This kid package is to be used by MakeMaker. It will not work if
|
||||
# $self is not a Makemaker.
|
||||
|
||||
use 5.005_64;
|
||||
# Broken out of MakeMaker from version 4.11
|
||||
|
||||
our $VERSION = substr q$Revision: 1.25 $, 10;
|
||||
our $VERSION = substr q$Revision: 1.26 $, 10;
|
||||
|
||||
use Config;
|
||||
use Cwd 'cwd';
|
||||
@ -17,19 +38,19 @@ sub ext {
|
||||
}
|
||||
|
||||
sub _unix_os2_ext {
|
||||
my($self,$potential_libs, $verbose) = @_;
|
||||
if ($^O =~ 'os2' and $Config{libs}) {
|
||||
my($self,$potential_libs, $verbose, $give_libs) = @_;
|
||||
if ($^O =~ 'os2' and $Config{perllibs}) {
|
||||
# Dynamic libraries are not transitive, so we may need including
|
||||
# the libraries linked against perl.dll again.
|
||||
|
||||
$potential_libs .= " " if $potential_libs;
|
||||
$potential_libs .= $Config{libs};
|
||||
$potential_libs .= $Config{perllibs};
|
||||
}
|
||||
return ("", "", "", "") unless $potential_libs;
|
||||
return ("", "", "", "", ($give_libs ? [] : ())) unless $potential_libs;
|
||||
warn "Potential libraries are '$potential_libs':\n" if $verbose;
|
||||
|
||||
my($so) = $Config{'so'};
|
||||
my($libs) = $Config{'libs'};
|
||||
my($libs) = $Config{'perllibs'};
|
||||
my $Config_libext = $Config{lib_ext} || ".a";
|
||||
|
||||
|
||||
@ -40,6 +61,7 @@ sub _unix_os2_ext {
|
||||
my(@searchpath); # from "-L/path" entries in $potential_libs
|
||||
my(@libpath) = split " ", $Config{'libpth'};
|
||||
my(@ldloadlibs, @bsloadlibs, @extralibs, @ld_run_path, %ld_run_path_seen);
|
||||
my(@libs, %libs_seen);
|
||||
my($fullname, $thislib, $thispth, @fullname);
|
||||
my($pwd) = cwd(); # from Cwd.pm
|
||||
my($found) = 0;
|
||||
@ -133,6 +155,7 @@ sub _unix_os2_ext {
|
||||
warn "'-l$thislib' found at $fullname\n" if $verbose;
|
||||
my($fullnamedir) = dirname($fullname);
|
||||
push @ld_run_path, $fullnamedir unless $ld_run_path_seen{$fullnamedir}++;
|
||||
push @libs, $fullname unless $libs_seen{$fullname}++;
|
||||
$found++;
|
||||
$found_lib++;
|
||||
|
||||
@ -180,28 +203,29 @@ sub _unix_os2_ext {
|
||||
."No library found for -l$thislib\n"
|
||||
unless $found_lib>0;
|
||||
}
|
||||
return ('','','','') unless $found;
|
||||
("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path));
|
||||
return ('','','','', ($give_libs ? \@libs : ())) unless $found;
|
||||
("@extralibs", "@bsloadlibs", "@ldloadlibs",join(":",@ld_run_path), ($give_libs ? \@libs : ()));
|
||||
}
|
||||
|
||||
sub _win32_ext {
|
||||
|
||||
require Text::ParseWords;
|
||||
|
||||
my($self, $potential_libs, $verbose) = @_;
|
||||
my($self, $potential_libs, $verbose, $give_libs) = @_;
|
||||
|
||||
# If user did not supply a list, we punt.
|
||||
# (caller should probably use the list in $Config{libs})
|
||||
return ("", "", "", "") unless $potential_libs;
|
||||
return ("", "", "", "", ($give_libs ? [] : ())) unless $potential_libs;
|
||||
|
||||
my $cc = $Config{cc};
|
||||
my $VC = 1 if $cc =~ /^cl/i;
|
||||
my $BC = 1 if $cc =~ /^bcc/i;
|
||||
my $GC = 1 if $cc =~ /^gcc/i;
|
||||
my $so = $Config{'so'};
|
||||
my $libs = $Config{'libs'};
|
||||
my $libs = $Config{'perllibs'};
|
||||
my $libpth = $Config{'libpth'};
|
||||
my $libext = $Config{'lib_ext'} || ".lib";
|
||||
my(@libs, %libs_seen);
|
||||
|
||||
if ($libs and $potential_libs !~ /:nodefault/i) {
|
||||
# If Config.pm defines a set of default libs, we always
|
||||
@ -231,6 +255,10 @@ sub _win32_ext {
|
||||
# add "$Config{installarchlib}/CORE" to default search path
|
||||
push @libpath, "$Config{installarchlib}/CORE";
|
||||
|
||||
if ($VC and exists $ENV{LIB} and $ENV{LIB}) {
|
||||
push @libpath, split /;/, $ENV{LIB};
|
||||
}
|
||||
|
||||
foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){
|
||||
|
||||
$thislib = $_;
|
||||
@ -295,6 +323,7 @@ sub _win32_ext {
|
||||
$found++;
|
||||
$found_lib++;
|
||||
push(@extralibs, $fullname);
|
||||
push @libs, $fullname unless $libs_seen{$fullname}++;
|
||||
last;
|
||||
}
|
||||
|
||||
@ -316,10 +345,11 @@ sub _win32_ext {
|
||||
|
||||
}
|
||||
|
||||
return ('','','','') unless $found;
|
||||
return ('','','','', ($give_libs ? \@libs : ())) unless $found;
|
||||
|
||||
# make sure paths with spaces are properly quoted
|
||||
@extralibs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @extralibs;
|
||||
@libs = map { (/\s/ && !/^".*"$/) ? qq["$_"] : $_ } @libs;
|
||||
$lib = join(' ',@extralibs);
|
||||
|
||||
# normalize back to backward slashes (to help braindead tools)
|
||||
@ -328,18 +358,18 @@ sub _win32_ext {
|
||||
$lib =~ s,/,\\,g;
|
||||
|
||||
warn "Result: $lib\n" if $verbose;
|
||||
wantarray ? ($lib, '', $lib, '') : $lib;
|
||||
wantarray ? ($lib, '', $lib, '', ($give_libs ? \@libs : ())) : $lib;
|
||||
}
|
||||
|
||||
|
||||
sub _vms_ext {
|
||||
my($self, $potential_libs,$verbose) = @_;
|
||||
my($self, $potential_libs,$verbose,$give_libs) = @_;
|
||||
my(@crtls,$crtlstr);
|
||||
my($dbgqual) = $self->{OPTIMIZE} || $Config{'optimize'} ||
|
||||
$self->{CCFLAS} || $Config{'ccflags'};
|
||||
@crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '')
|
||||
. 'PerlShr/Share' );
|
||||
push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'});
|
||||
push(@crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'});
|
||||
push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'});
|
||||
# In general, we pass through the basic libraries from %Config unchanged.
|
||||
# The one exception is that if we're building in the Perl source tree, and
|
||||
@ -362,7 +392,7 @@ sub _vms_ext {
|
||||
|
||||
unless ($potential_libs) {
|
||||
warn "Result:\n\tEXTRALIBS: \n\tLDLOADLIBS: $crtlstr\n" if $verbose;
|
||||
return ('', '', $crtlstr, '');
|
||||
return ('', '', $crtlstr, '', ($give_libs ? [] : ()));
|
||||
}
|
||||
|
||||
my(@dirs,@libs,$dir,$lib,%found,@fndlibs,$ldlib);
|
||||
@ -371,6 +401,7 @@ sub _vms_ext {
|
||||
# List of common Unix library names and there VMS equivalents
|
||||
# (VMS equivalent of '' indicates that the library is automatially
|
||||
# searched by the linker, and should be skipped here.)
|
||||
my(@flibs, %libs_seen);
|
||||
my %libmap = ( 'm' => '', 'f77' => '', 'F77' => '', 'V77' => '', 'c' => '',
|
||||
'malloc' => '', 'crypt' => '', 'resolv' => '', 'c_s' => '',
|
||||
'socket' => '', 'X11' => 'DECW$XLIBSHR',
|
||||
@ -475,6 +506,7 @@ sub _vms_ext {
|
||||
if ($cand eq 'VAXCCURSE') { unshift @{$found{$ctype}}, $cand; }
|
||||
else { push @{$found{$ctype}}, $cand; }
|
||||
warn "\tFound as $cand (really $test), type $ctype\n" if $verbose > 1;
|
||||
push @flibs, $name unless $libs_seen{$fullname}++;
|
||||
next LIB;
|
||||
}
|
||||
}
|
||||
@ -489,7 +521,7 @@ sub _vms_ext {
|
||||
|
||||
$ldlib = $crtlstr ? "$lib $crtlstr" : $lib;
|
||||
warn "Result:\n\tEXTRALIBS: $lib\n\tLDLOADLIBS: $ldlib\n" if $verbose;
|
||||
wantarray ? ($lib, '', $ldlib, '') : $lib;
|
||||
wantarray ? ($lib, '', $ldlib, '', ($give_libs ? \@flibs : ())) : $lib;
|
||||
}
|
||||
|
||||
1;
|
||||
@ -504,20 +536,22 @@ ExtUtils::Liblist - determine libraries to use and how to use them
|
||||
|
||||
C<require ExtUtils::Liblist;>
|
||||
|
||||
C<ExtUtils::Liblist::ext($self, $potential_libs, $verbose);>
|
||||
C<ExtUtils::Liblist::ext($self, $potential_libs, $verbose, $need_names);>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This utility takes a list of libraries in the form C<-llib1 -llib2
|
||||
-llib3> and prints out lines suitable for inclusion in an extension
|
||||
-llib3> and returns lines suitable for inclusion in an extension
|
||||
Makefile. Extra library paths may be included with the form
|
||||
C<-L/another/path> this will affect the searches for all subsequent
|
||||
libraries.
|
||||
|
||||
It returns an array of four scalar values: EXTRALIBS, BSLOADLIBS,
|
||||
LDLOADLIBS, and LD_RUN_PATH. Some of these don't mean anything
|
||||
on VMS and Win32. See the details about those platform specifics
|
||||
below.
|
||||
It returns an array of four or five scalar values: EXTRALIBS,
|
||||
BSLOADLIBS, LDLOADLIBS, LD_RUN_PATH, and, optionally, a reference to
|
||||
the array of the filenames of actual libraries. Some of these don't
|
||||
mean anything unless on Unix. See the details about those platform
|
||||
specifics below. The list of the filenames is returned only if
|
||||
$need_names argument is true.
|
||||
|
||||
Dependent libraries can be linked in one of three ways:
|
||||
|
||||
@ -625,7 +659,7 @@ Unix-OS/2 version in several respects:
|
||||
=item *
|
||||
|
||||
If C<$potential_libs> is empty, the return value will be empty.
|
||||
Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm)
|
||||
Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm)
|
||||
will be appended to the list of C<$potential_libs>. The libraries
|
||||
will be searched for in the directories specified in C<$potential_libs>,
|
||||
C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>.
|
||||
@ -669,7 +703,7 @@ Entries in C<$potential_libs> beginning with a colon and followed by
|
||||
alphanumeric characters are treated as flags. Unknown flags will be ignored.
|
||||
|
||||
An entry that matches C</:nodefault/i> disables the appending of default
|
||||
libraries found in C<$Config{libs}> (this should be only needed very rarely).
|
||||
libraries found in C<$Config{perllibs}> (this should be only needed very rarely).
|
||||
|
||||
An entry that matches C</:nosearch/i> disables all searching for
|
||||
the libraries specified after it. Translation of C<-Lfoo> and
|
||||
@ -679,7 +713,7 @@ valid files or directories.
|
||||
|
||||
An entry that matches C</:search/i> reenables searching for
|
||||
the libraries specified after it. You can put it at the end to
|
||||
enable searching for default libraries specified by C<$Config{libs}>.
|
||||
enable searching for default libraries specified by C<$Config{perllibs}>.
|
||||
|
||||
=item *
|
||||
|
||||
|
||||
@ -209,6 +209,7 @@ sub ExtUtils::MM_Unix::parse_version ;
|
||||
sub ExtUtils::MM_Unix::pasthru ;
|
||||
sub ExtUtils::MM_Unix::path ;
|
||||
sub ExtUtils::MM_Unix::perl_archive;
|
||||
sub ExtUtils::MM_Unix::perl_archive_after;
|
||||
sub ExtUtils::MM_Unix::perl_script ;
|
||||
sub ExtUtils::MM_Unix::perldepend ;
|
||||
sub ExtUtils::MM_Unix::pm_to_blib ;
|
||||
@ -306,8 +307,8 @@ sub cflags {
|
||||
$libperl ||= $self->{LIBPERL_A} || "libperl$self->{LIB_EXT}" ;
|
||||
$libperl =~ s/\.\$\(A\)$/$self->{LIB_EXT}/;
|
||||
|
||||
@cflags{qw(cc ccflags optimize large split shellflags)}
|
||||
= @Config{qw(cc ccflags optimize large split shellflags)};
|
||||
@cflags{qw(cc ccflags optimize shellflags)}
|
||||
= @Config{qw(cc ccflags optimize shellflags)};
|
||||
my($optdebug) = "";
|
||||
|
||||
$cflags{shellflags} ||= '';
|
||||
@ -342,16 +343,12 @@ sub cflags {
|
||||
optimize=\"$cflags{optimize}\"
|
||||
perltype=\"$cflags{perltype}\"
|
||||
optdebug=\"$cflags{optdebug}\"
|
||||
large=\"$cflags{large}\"
|
||||
split=\"$cflags{'split'}\"
|
||||
eval '$prog'
|
||||
echo cc=\$cc
|
||||
echo ccflags=\$ccflags
|
||||
echo optimize=\$optimize
|
||||
echo perltype=\$perltype
|
||||
echo optdebug=\$optdebug
|
||||
echo large=\$large
|
||||
echo split=\$split
|
||||
`;
|
||||
my($line);
|
||||
foreach $line (@o){
|
||||
@ -369,7 +366,7 @@ sub cflags {
|
||||
$cflags{optimize} = $optdebug;
|
||||
}
|
||||
|
||||
for (qw(ccflags optimize perltype large split)) {
|
||||
for (qw(ccflags optimize perltype)) {
|
||||
$cflags{$_} =~ s/^\s+//;
|
||||
$cflags{$_} =~ s/\s+/ /g;
|
||||
$cflags{$_} =~ s/\s+$//;
|
||||
@ -412,8 +409,6 @@ sub cflags {
|
||||
CCFLAGS = $self->{CCFLAGS}
|
||||
OPTIMIZE = $self->{OPTIMIZE}
|
||||
PERLTYPE = $self->{PERLTYPE}
|
||||
LARGE = $self->{LARGE}
|
||||
SPLIT = $self->{SPLIT}
|
||||
MPOLLUTE = $pollute
|
||||
};
|
||||
|
||||
@ -458,7 +453,7 @@ EOT
|
||||
push(@otherfiles, qw[./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all
|
||||
perlmain.c mon.out core core.*perl.*.?
|
||||
*perl.core so_locations pm_to_blib
|
||||
*~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe
|
||||
*$(OBJ_EXT) *$(LIB_EXT) perl.exe
|
||||
$(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def
|
||||
$(BASEEXT).exp
|
||||
]);
|
||||
@ -484,7 +479,7 @@ sub const_cccmd {
|
||||
return '' unless $self->needs_linking();
|
||||
return $self->{CONST_CCCMD} =
|
||||
q{CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \\
|
||||
$(PERLTYPE) $(LARGE) $(SPLIT) $(MPOLLUTE) $(DEFINE_VERSION) \\
|
||||
$(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \\
|
||||
$(XS_DEFINE_VERSION)};
|
||||
}
|
||||
|
||||
@ -587,7 +582,7 @@ MM_VERSION = $ExtUtils::MakeMaker::VERSION
|
||||
|
||||
for $tmp (qw/
|
||||
FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
|
||||
LDFROM LINKTYPE
|
||||
LDFROM LINKTYPE PM_FILTER
|
||||
/ ) {
|
||||
next unless defined $self->{$tmp};
|
||||
push @m, "$tmp = $self->{$tmp}\n";
|
||||
@ -680,6 +675,10 @@ EXPORT_LIST = $tmp
|
||||
$tmp = $self->perl_archive;
|
||||
push @m, "
|
||||
PERL_ARCHIVE = $tmp
|
||||
";
|
||||
$tmp = $self->perl_archive_after;
|
||||
push @m, "
|
||||
PERL_ARCHIVE_AFTER = $tmp
|
||||
";
|
||||
|
||||
# push @m, q{
|
||||
@ -813,7 +812,7 @@ DIST_DEFAULT = $dist_default
|
||||
|
||||
=item dist_basics (o)
|
||||
|
||||
Defines the targets distclean, distcheck, skipcheck, manifest.
|
||||
Defines the targets distclean, distcheck, skipcheck, manifest, veryclean.
|
||||
|
||||
=cut
|
||||
|
||||
@ -841,6 +840,11 @@ manifest :
|
||||
$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \\
|
||||
-e mkmanifest
|
||||
};
|
||||
|
||||
push @m, q{
|
||||
veryclean : realclean
|
||||
$(RM_F) *~ *.orig */*~ */*.orig
|
||||
};
|
||||
join "", @m;
|
||||
}
|
||||
|
||||
@ -1063,7 +1067,7 @@ ARMAYBE = '.$armaybe.'
|
||||
OTHERLDFLAGS = '.$otherldflags.'
|
||||
INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
|
||||
|
||||
$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
|
||||
$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
|
||||
');
|
||||
if ($armaybe ne ':'){
|
||||
$ldfrom = 'tmp$(LIB_EXT)';
|
||||
@ -1072,18 +1076,20 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
|
||||
}
|
||||
$ldfrom = "-all $ldfrom -none" if ($^O eq 'dec_osf');
|
||||
|
||||
# Brain dead solaris linker does not use LD_RUN_PATH?
|
||||
# This fixes dynamic extensions which need shared libs
|
||||
my $ldrun = '';
|
||||
$ldrun = join ' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}
|
||||
if ($^O eq 'solaris');
|
||||
|
||||
# The IRIX linker also doesn't use LD_RUN_PATH
|
||||
$ldrun = qq{-rpath "$self->{LD_RUN_PATH}"}
|
||||
# The IRIX linker doesn't use LD_RUN_PATH
|
||||
my $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"}
|
||||
if ($^O eq 'irix' && $self->{LD_RUN_PATH});
|
||||
|
||||
push(@m,' $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
|
||||
' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)');
|
||||
# For example in AIX the shared objects/libraries from previous builds
|
||||
# linger quite a while in the shared dynalinker cache even when nobody
|
||||
# is using them. This is painful if one for instance tries to restart
|
||||
# a failed build because the link command will fail unnecessarily 'cos
|
||||
# the shared object/library is 'busy'.
|
||||
push(@m,' $(RM_F) $@
|
||||
');
|
||||
|
||||
push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) '.$ldrun.' $(LDDLFLAGS) '.$ldfrom.
|
||||
' $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST)');
|
||||
push @m, '
|
||||
$(CHMOD) $(PERM_RWX) $@
|
||||
';
|
||||
@ -1148,9 +1154,9 @@ in these dirs:
|
||||
@$dirs
|
||||
";
|
||||
}
|
||||
foreach $dir (@$dirs){
|
||||
next unless defined $dir; # $self->{PERL_SRC} may be undefined
|
||||
foreach $name (@$names){
|
||||
foreach $name (@$names){
|
||||
foreach $dir (@$dirs){
|
||||
next unless defined $dir; # $self->{PERL_SRC} may be undefined
|
||||
my ($abs, $val);
|
||||
if ($self->file_name_is_absolute($name)) { # /foo/bar
|
||||
$abs = $name;
|
||||
@ -1250,11 +1256,6 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
|
||||
next;
|
||||
}
|
||||
my($dev,$ino,$mode) = stat FIXIN;
|
||||
# If they override perm_rwx, we won't notice it during fixin,
|
||||
# because fixin is run through a new instance of MakeMaker.
|
||||
# That is why we must run another CHMOD later.
|
||||
$mode = oct($self->perm_rwx) unless $dev;
|
||||
chmod $mode, $file;
|
||||
|
||||
# Print out the new #! line (or equivalent).
|
||||
local $\;
|
||||
@ -1262,7 +1263,15 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
|
||||
print FIXOUT $shb, <FIXIN>;
|
||||
close FIXIN;
|
||||
close FIXOUT;
|
||||
# can't rename open files on some DOSISH platforms
|
||||
|
||||
# can't rename/chmod open files on some DOSISH platforms
|
||||
|
||||
# If they override perm_rwx, we won't notice it during fixin,
|
||||
# because fixin is run through a new instance of MakeMaker.
|
||||
# That is why we must run another CHMOD later.
|
||||
$mode = oct($self->perm_rwx) unless $dev;
|
||||
chmod $mode, $file;
|
||||
|
||||
unless ( rename($file, "$file.bak") ) {
|
||||
warn "Can't rename $file to $file.bak: $!";
|
||||
next;
|
||||
@ -1277,6 +1286,7 @@ eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
|
||||
}
|
||||
unlink "$file.bak";
|
||||
} continue {
|
||||
close(FIXIN) if fileno(FIXIN);
|
||||
chmod oct($self->perm_rwx), $file or
|
||||
die "Can't reset permissions for $file: $!\n";
|
||||
system("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';;
|
||||
@ -1654,7 +1664,7 @@ sub init_main {
|
||||
|
||||
unless ($self->{PERL_SRC}){
|
||||
my($dir);
|
||||
foreach $dir ($self->updir(),$self->catdir($self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir())){
|
||||
foreach $dir ($self->updir(),$self->catdir($self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir()),$self->catdir($self->updir(),$self->updir(),$self->updir(),$self->updir())){
|
||||
if (
|
||||
-f $self->catfile($dir,"config.sh")
|
||||
&&
|
||||
@ -2369,7 +2379,7 @@ $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
|
||||
|
||||
# The front matter of the linkcommand...
|
||||
$linkcmd = join ' ', "\$(CC)",
|
||||
grep($_, @Config{qw(large split ldflags ccdlflags)});
|
||||
grep($_, @Config{qw(ldflags ccdlflags)});
|
||||
$linkcmd =~ s/\s+/ /g;
|
||||
$linkcmd =~ s,(perl\.exp),\$(PERL_INC)/$1,;
|
||||
|
||||
@ -2452,7 +2462,7 @@ MAP_PERLINC = @{$perlinc || []}
|
||||
MAP_STATIC = ",
|
||||
join(" \\\n\t", reverse sort keys %static), "
|
||||
|
||||
MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib}
|
||||
MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib}
|
||||
";
|
||||
|
||||
if (defined $libperl) {
|
||||
@ -2460,6 +2470,7 @@ MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib}
|
||||
}
|
||||
unless ($libperl && -f $lperl) { # Ilya's code...
|
||||
my $dir = $self->{PERL_SRC} || "$self->{PERL_ARCHLIB}/CORE";
|
||||
$dir = "$self->{PERL_ARCHLIB}/.." if $self->{UNINSTALLED_PERL};
|
||||
$libperl ||= "libperl$self->{LIB_EXT}";
|
||||
$libperl = "$dir/$libperl";
|
||||
$lperl ||= "libperl$self->{LIB_EXT}";
|
||||
@ -2497,14 +2508,9 @@ MAP_LIBPERL = $libperl
|
||||
# SUNOS ld does not take the full path to a shared library
|
||||
my $llibperl = ($libperl)?'$(MAP_LIBPERL)':'-lperl';
|
||||
|
||||
# Brain dead solaris linker does not use LD_RUN_PATH?
|
||||
# This fixes dynamic extensions which need shared libs
|
||||
my $ldfrom = ($^O eq 'solaris')?
|
||||
join(' ', map "-R$_", split /:/, $self->{LD_RUN_PATH}):'';
|
||||
|
||||
push @m, "
|
||||
\$(MAP_TARGET) :: $tmp/perlmain\$(OBJ_EXT) \$(MAP_LIBPERL) \$(MAP_STATIC) \$(INST_ARCHAUTODIR)/extralibs.all
|
||||
\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) $ldfrom \$(MAP_STATIC) $llibperl `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
|
||||
\$(MAP_LINKCMD) -o \$\@ \$(OPTIMIZE) $tmp/perlmain\$(OBJ_EXT) \$(LDFROM) \$(MAP_STATIC) $llibperl `cat \$(INST_ARCHAUTODIR)/extralibs.all` \$(MAP_PRELIBS)
|
||||
$self->{NOECHO}echo 'To install the new \"\$(MAP_TARGET)\" binary, call'
|
||||
$self->{NOECHO}echo ' make -f $makefilename inst_perl MAP_TARGET=\$(MAP_TARGET)'
|
||||
$self->{NOECHO}echo 'To remove the intermediate files say'
|
||||
@ -3040,7 +3046,7 @@ sub pm_to_blib {
|
||||
pm_to_blib: $(TO_INST_PM)
|
||||
}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
|
||||
"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
|
||||
-e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{')"
|
||||
-e "pm_to_blib({qw{$(PM_TO_BLIB)}},'}.$autodir.q{','$(PM_FILTER)')"
|
||||
}.$self->{NOECHO}.q{$(TOUCH) $@
|
||||
};
|
||||
}
|
||||
@ -3112,6 +3118,7 @@ sub processPL {
|
||||
my $list = ref($self->{PL_FILES}->{$plfile})
|
||||
? $self->{PL_FILES}->{$plfile}
|
||||
: [$self->{PL_FILES}->{$plfile}];
|
||||
my $target;
|
||||
foreach $target (@$list) {
|
||||
push @m, "
|
||||
all :: $target
|
||||
@ -3151,8 +3158,22 @@ realclean purge :: clean
|
||||
push(@m, " $self->{RM_F} \$(INST_DYNAMIC) \$(INST_BOOT)\n");
|
||||
push(@m, " $self->{RM_F} \$(INST_STATIC)\n");
|
||||
}
|
||||
push(@m, " $self->{RM_F} " . join(" ", values %{$self->{PM}}) . "\n")
|
||||
if keys %{$self->{PM}};
|
||||
# Issue a several little RM_F commands rather than risk creating a
|
||||
# very long command line (useful for extensions such as Encode
|
||||
# that have many files).
|
||||
if (keys %{$self->{PM}}) {
|
||||
my $line = "";
|
||||
foreach (values %{$self->{PM}}) {
|
||||
if (length($line) + length($_) > 80) {
|
||||
push @m, "\t$self->{RM_F} $line\n";
|
||||
$line = $_;
|
||||
}
|
||||
else {
|
||||
$line .= " $_";
|
||||
}
|
||||
}
|
||||
push @m, "\t$self->{RM_F} $line\n" if $line;
|
||||
}
|
||||
my(@otherfiles) = ($self->{MAKEFILE},
|
||||
"$self->{MAKEFILE}.old"); # Makefiles last
|
||||
push(@otherfiles, $attribs{FILES}) if $attribs{FILES};
|
||||
@ -3171,9 +3192,11 @@ form Foo/Bar and replaces the slash with C<::>. Returns the replacement.
|
||||
sub replace_manpage_separator {
|
||||
my($self,$man) = @_;
|
||||
if ($^O eq 'uwin') {
|
||||
$man =~ s,/+,.,g;
|
||||
$man =~ s,/+,.,g;
|
||||
} elsif ($Is_Dos) {
|
||||
$man =~ s,/+,__,g;
|
||||
} else {
|
||||
$man =~ s,/+,::,g;
|
||||
$man =~ s,/+,::,g;
|
||||
}
|
||||
$man;
|
||||
}
|
||||
@ -3492,13 +3515,13 @@ WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \\
|
||||
-e 'print "Please make sure the two installations are not conflicting\n";'
|
||||
|
||||
UNINST=0
|
||||
VERBINST=1
|
||||
VERBINST=0
|
||||
|
||||
MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
|
||||
-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
|
||||
|
||||
DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \
|
||||
-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \
|
||||
-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", $$arg=shift, "|", $$arg, ">";' \
|
||||
-e 'print "=over 4";' \
|
||||
-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
|
||||
-e 'print "=back";'
|
||||
@ -3793,6 +3816,21 @@ sub perl_archive
|
||||
return "";
|
||||
}
|
||||
|
||||
=item perl_archive_after
|
||||
|
||||
This is an internal method that returns path to a library which
|
||||
should be put on the linker command line I<after> the external libraries
|
||||
to be linked to dynamic extensions. This may be needed if the linker
|
||||
is one-pass, and Perl includes some overrides for C RTL functions,
|
||||
such as malloc().
|
||||
|
||||
=cut
|
||||
|
||||
sub perl_archive_after
|
||||
{
|
||||
return "";
|
||||
}
|
||||
|
||||
=item export_list
|
||||
|
||||
This is internal method that returns name of a file that is
|
||||
|
||||
@ -46,7 +46,7 @@ use vars qw(
|
||||
# default routine without having to know under what OS
|
||||
# it's running.
|
||||
#
|
||||
@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::Liblist ExtUtils::MakeMaker];
|
||||
@MM::ISA = qw[ExtUtils::MM_Unix ExtUtils::Liblist::Kid ExtUtils::MakeMaker];
|
||||
|
||||
#
|
||||
# Setup dummy package:
|
||||
@ -62,7 +62,7 @@ use vars qw(
|
||||
|
||||
# "predeclare the package: we only load it via AUTOLOAD
|
||||
# but we have already mentioned it in @ISA
|
||||
package ExtUtils::Liblist;
|
||||
package ExtUtils::Liblist::Kid;
|
||||
|
||||
package ExtUtils::MakeMaker;
|
||||
#
|
||||
@ -84,7 +84,7 @@ if ($Is_OS2) {
|
||||
require ExtUtils::MM_OS2;
|
||||
}
|
||||
if ($Is_Mac) {
|
||||
require ExtUtils::MM_Mac;
|
||||
require ExtUtils::MM_MacOS;
|
||||
}
|
||||
if ($Is_Win32) {
|
||||
require ExtUtils::MM_Win32;
|
||||
@ -191,7 +191,7 @@ sub full_setup {
|
||||
AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION
|
||||
C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS
|
||||
EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE FULLPERL FUNCLIST H
|
||||
HTMLLIBPODS HTMLSCRIPTPOD IMPORTS
|
||||
HTMLLIBPODS HTMLSCRIPTPODS IMPORTS
|
||||
INC INCLUDE_EXT INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLHTMLPRIVLIBDIR
|
||||
INSTALLHTMLSCRIPTDIR INSTALLHTMLSITELIBDIR INSTALLMAN1DIR
|
||||
INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH
|
||||
@ -202,10 +202,14 @@ sub full_setup {
|
||||
PERL_MALLOC_OK
|
||||
NAME NEEDS_LINKING NOECHO NORECURS NO_VC OBJECT OPTIMIZE PERL PERLMAINCC
|
||||
PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX
|
||||
PL_FILES PM PMLIBDIRS POLLUTE PPM_INSTALL_EXEC PPM_INSTALL_SCRIPT PREFIX
|
||||
PL_FILES PM PM_FILTER PMLIBDIRS POLLUTE PPM_INSTALL_EXEC
|
||||
PPM_INSTALL_SCRIPT PREFIX
|
||||
PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
||||
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
|
||||
tool_autosplit
|
||||
|
||||
MACPERL_SRC MACPERL_LIB MACLIBS_68K MACLIBS_PPC MACLIBS_SC MACLIBS_MRC
|
||||
MACLIBS_ALL_68K MACLIBS_ALL_PPC MACLIBS_SHARED
|
||||
/;
|
||||
|
||||
# IMPORTS is used under OS/2 and Win32
|
||||
@ -241,7 +245,6 @@ sub full_setup {
|
||||
|
||||
dir_target libscan makeaperl needs_linking perm_rw perm_rwx
|
||||
subdir_x test_via_harness test_via_script
|
||||
|
||||
];
|
||||
|
||||
push @MM_Sections, qw[
|
||||
@ -984,23 +987,39 @@ be
|
||||
perl Makefile.PL LIB=~/lib
|
||||
|
||||
This will install the module's architecture-independent files into
|
||||
~/lib, the architecture-dependent files into ~/lib/$archname/auto.
|
||||
~/lib, the architecture-dependent files into ~/lib/$archname.
|
||||
|
||||
Another way to specify many INSTALL directories with a single
|
||||
parameter is PREFIX.
|
||||
|
||||
perl Makefile.PL PREFIX=~
|
||||
|
||||
This will replace the string specified by $Config{prefix} in all
|
||||
$Config{install*} values.
|
||||
This will replace the string specified by C<$Config{prefix}> in all
|
||||
C<$Config{install*}> values.
|
||||
|
||||
Note, that in both cases the tilde expansion is done by MakeMaker, not
|
||||
by perl by default, nor by make. Conflicts between parameters LIB,
|
||||
PREFIX and the various INSTALL* arguments are resolved so that
|
||||
XXX
|
||||
by perl by default, nor by make.
|
||||
|
||||
Conflicts between parameters LIB,
|
||||
PREFIX and the various INSTALL* arguments are resolved so that:
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
setting LIB overrides any setting of INSTALLPRIVLIB, INSTALLARCHLIB,
|
||||
INSTALLSITELIB, INSTALLSITEARCH (and they are not affected by PREFIX);
|
||||
|
||||
=item *
|
||||
|
||||
without LIB, setting PREFIX replaces the initial C<$Config{prefix}>
|
||||
part of those INSTALL* arguments, even if the latter are explicitly
|
||||
set (but are set to still start with C<$Config{prefix}>).
|
||||
|
||||
=back
|
||||
|
||||
If the user has superuser privileges, and is not working on AFS
|
||||
(Andrew File System) or relatives, then the defaults for
|
||||
or relatives, then the defaults for
|
||||
INSTALLPRIVLIB, INSTALLARCHLIB, INSTALLSCRIPT, etc. will be appropriate,
|
||||
and this incantation will be the best:
|
||||
|
||||
@ -1147,11 +1166,6 @@ or as NAME=VALUE pairs on the command line:
|
||||
|
||||
=over 2
|
||||
|
||||
=item AUTHOR
|
||||
|
||||
String containing name (and email address) of package author(s). Is used
|
||||
in PPD (Perl Package Description) files for PPM (Perl Package Manager).
|
||||
|
||||
=item ABSTRACT
|
||||
|
||||
One line description of the module. Will be included in PPD file.
|
||||
@ -1162,6 +1176,11 @@ Name of the file that contains the package description. MakeMaker looks
|
||||
for a line in the POD matching /^($package\s-\s)(.*)/. This is typically
|
||||
the first line in the "=head1 NAME" section. $2 becomes the abstract.
|
||||
|
||||
=item AUTHOR
|
||||
|
||||
String containing name (and email address) of package author(s). Is used
|
||||
in PPD (Perl Package Description) files for PPM (Perl Package Manager).
|
||||
|
||||
=item BINARY_LOCATION
|
||||
|
||||
Used when creating PPD files for binary packages. It can be set to a
|
||||
@ -1411,11 +1430,6 @@ to INSTALLBIN during 'make install'
|
||||
Old name for INST_SCRIPT. Deprecated. Please use INST_SCRIPT if you
|
||||
need to use it.
|
||||
|
||||
=item INST_LIB
|
||||
|
||||
Directory where we put library files of this extension while building
|
||||
it.
|
||||
|
||||
=item INST_HTMLLIBDIR
|
||||
|
||||
Directory to hold the man pages in HTML format at 'make' time
|
||||
@ -1424,6 +1438,11 @@ Directory to hold the man pages in HTML format at 'make' time
|
||||
|
||||
Directory to hold the man pages in HTML format at 'make' time
|
||||
|
||||
=item INST_LIB
|
||||
|
||||
Directory where we put library files of this extension while building
|
||||
it.
|
||||
|
||||
=item INST_MAN1DIR
|
||||
|
||||
Directory to hold the man pages at 'make' time
|
||||
@ -1439,34 +1458,6 @@ Directory, where executable files should be installed during
|
||||
testing. make install will copy the files in INST_SCRIPT to
|
||||
INSTALLSCRIPT.
|
||||
|
||||
=item PERL_MALLOC_OK
|
||||
|
||||
defaults to 0. Should be set to TRUE if the extension can work with
|
||||
the memory allocation routines substituted by the Perl malloc() subsystem.
|
||||
This should be applicable to most extensions with exceptions of those
|
||||
|
||||
=over
|
||||
|
||||
=item *
|
||||
|
||||
with bugs in memory allocations which are caught by Perl's malloc();
|
||||
|
||||
=item *
|
||||
|
||||
which interact with the memory allocator in other ways than via
|
||||
malloc(), realloc(), free(), calloc(), sbrk() and brk();
|
||||
|
||||
=item *
|
||||
|
||||
which rely on special alignment which is not provided by Perl's malloc().
|
||||
|
||||
=back
|
||||
|
||||
B<NOTE.> Negligence to set this flag in I<any one> of loaded extension
|
||||
nullifies many advantages of Perl's malloc(), such as better usage of
|
||||
system resources, error detection, memory usage reporting, catchable failure
|
||||
of memory allocations, etc.
|
||||
|
||||
=item LDFROM
|
||||
|
||||
defaults to "$(OBJECT)" and is used in the ld command to specify
|
||||
@ -1475,8 +1466,12 @@ specify ld flags)
|
||||
|
||||
=item LIB
|
||||
|
||||
LIB can only be set at C<perl Makefile.PL> time. It has the effect of
|
||||
LIB should only be set at C<perl Makefile.PL> time but is allowed as a
|
||||
MakeMaker argument. It has the effect of
|
||||
setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any
|
||||
explicit setting of those arguments (or of PREFIX).
|
||||
INSTALLARCHLIB and INSTALLSITEARCH are set to the corresponding
|
||||
architecture subdirectory.
|
||||
|
||||
=item LIBPERL_A
|
||||
|
||||
@ -1580,6 +1575,8 @@ List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long
|
||||
string containing all object files, e.g. "tkpBind.o
|
||||
tkpButton.o tkpCanvas.o"
|
||||
|
||||
(Where BASEEXT is the last component of NAME, and OBJ_EXT is $Config{obj_ext}.)
|
||||
|
||||
=item OPTIMIZE
|
||||
|
||||
Defaults to C<-O>. Set it to C<-g> to turn debugging on. The flag is
|
||||
@ -1596,12 +1593,40 @@ to $(CC).
|
||||
|
||||
=item PERL_ARCHLIB
|
||||
|
||||
Same as above for architecture dependent files.
|
||||
Same as below, but for architecture dependent files.
|
||||
|
||||
=item PERL_LIB
|
||||
|
||||
Directory containing the Perl library to use.
|
||||
|
||||
=item PERL_MALLOC_OK
|
||||
|
||||
defaults to 0. Should be set to TRUE if the extension can work with
|
||||
the memory allocation routines substituted by the Perl malloc() subsystem.
|
||||
This should be applicable to most extensions with exceptions of those
|
||||
|
||||
=over 4
|
||||
|
||||
=item *
|
||||
|
||||
with bugs in memory allocations which are caught by Perl's malloc();
|
||||
|
||||
=item *
|
||||
|
||||
which interact with the memory allocator in other ways than via
|
||||
malloc(), realloc(), free(), calloc(), sbrk() and brk();
|
||||
|
||||
=item *
|
||||
|
||||
which rely on special alignment which is not provided by Perl's malloc().
|
||||
|
||||
=back
|
||||
|
||||
B<NOTE.> Negligence to set this flag in I<any one> of loaded extension
|
||||
nullifies many advantages of Perl's malloc(), such as better usage of
|
||||
system resources, error detection, memory usage reporting, catchable failure
|
||||
of memory allocations, etc.
|
||||
|
||||
=item PERL_SRC
|
||||
|
||||
Directory containing the Perl source code (use of this should be
|
||||
@ -1650,6 +1675,31 @@ they contain will be installed in the corresponding location in the
|
||||
library. A libscan() method can be used to alter the behaviour.
|
||||
Defining PM in the Makefile.PL will override PMLIBDIRS.
|
||||
|
||||
(Where BASEEXT is the last component of NAME.)
|
||||
|
||||
=item PM_FILTER
|
||||
|
||||
A filter program, in the traditional Unix sense (input from stdin, output
|
||||
to stdout) that is passed on each .pm file during the build (in the
|
||||
pm_to_blib() phase). It is empty by default, meaning no filtering is done.
|
||||
|
||||
Great care is necessary when defining the command if quoting needs to be
|
||||
done. For instance, you would need to say:
|
||||
|
||||
{'PM_FILTER' => 'grep -v \\"^\\#\\"'}
|
||||
|
||||
to remove all the leading coments on the fly during the build. The
|
||||
extra \\ are necessary, unfortunately, because this variable is interpolated
|
||||
within the context of a Perl program built on the command line, and double
|
||||
quotes are what is used with the -e switch to build that command line. The
|
||||
# is escaped for the Makefile, since what is going to be generated will then
|
||||
be:
|
||||
|
||||
PM_FILTER = grep -v \"^\#\"
|
||||
|
||||
Without the \\ before the #, we'd have the start of a Makefile comment,
|
||||
and the macro would be incorrectly defined.
|
||||
|
||||
=item POLLUTE
|
||||
|
||||
Release 5.005 grandfathered old global symbol names by providing preprocessor
|
||||
@ -1727,6 +1777,7 @@ MakeMaker object. The following lines will be parsed o.k.:
|
||||
( $VERSION ) = '$Revision: 1.222 $ ' =~ /\$Revision:\s+([^\s]+)/;
|
||||
$FOO::VERSION = '1.10';
|
||||
*FOO::VERSION = \'1.11';
|
||||
our $VERSION = 1.2.3; # new for perl5.6.0
|
||||
|
||||
but these will fail:
|
||||
|
||||
@ -1734,6 +1785,8 @@ but these will fail:
|
||||
local $VERSION = '1.02';
|
||||
local $FOO::VERSION = '1.30';
|
||||
|
||||
(Putting C<my> or C<local> on the preceding line will work o.k.)
|
||||
|
||||
The file named in VERSION_FROM is not added as a dependency to
|
||||
Makefile. This is not really correct, but it would be a major pain
|
||||
during development to have to rewrite the Makefile for any smallish
|
||||
@ -1788,6 +1841,8 @@ part of the Makefile.
|
||||
|
||||
{ANY_TARGET => ANY_DEPENDECY, ...}
|
||||
|
||||
(ANY_TARGET must not be given a double-colon rule by MakeMaker.)
|
||||
|
||||
=item dist
|
||||
|
||||
{TARFLAGS => 'cvfF', COMPRESS => 'gzip', SUFFIX => '.gz',
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
|
||||
#define PERL_REVISION 5 /* age */
|
||||
#define PERL_VERSION 6 /* epoch */
|
||||
#define PERL_SUBVERSION 0 /* generation */
|
||||
#define PERL_SUBVERSION 1 /* generation */
|
||||
|
||||
/* The following numbers describe the earliest compatible version of
|
||||
Perl ("compatibility" here being defined as sufficient binary/API
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,6 +1,6 @@
|
||||
/* perl.h
|
||||
*
|
||||
* Copyright (c) 1987-2000, Larry Wall
|
||||
* Copyright (c) 1987-2001, Larry Wall
|
||||
*
|
||||
* You may distribute under the terms of either the GNU General Public
|
||||
* License or the Artistic License, as specified in the README file.
|
||||
@ -165,8 +165,8 @@ class CPerlObj;
|
||||
#define aTHXo_ this,
|
||||
#define PERL_OBJECT_THIS aTHXo
|
||||
#define PERL_OBJECT_THIS_ aTHXo_
|
||||
#define dTHXoa(a) pTHXo = a
|
||||
#define dTHXo dTHXoa(PERL_GET_THX)
|
||||
#define dTHXoa(a) pTHXo = (CPerlObj*)a
|
||||
#define dTHXo pTHXo = PERL_GET_THX
|
||||
|
||||
#define pTHXx void
|
||||
#define pTHXx_
|
||||
@ -180,16 +180,17 @@ class CPerlObj;
|
||||
struct perl_thread;
|
||||
# define pTHX register struct perl_thread *thr
|
||||
# define aTHX thr
|
||||
# define dTHR dNOOP
|
||||
# define dTHR dNOOP /* only backward compatibility */
|
||||
# define dTHXa(a) pTHX = (struct perl_thread*)a
|
||||
# else
|
||||
# ifndef MULTIPLICITY
|
||||
# define MULTIPLICITY
|
||||
# endif
|
||||
# define pTHX register PerlInterpreter *my_perl
|
||||
# define aTHX my_perl
|
||||
# define dTHXa(a) pTHX = (PerlInterpreter*)a
|
||||
# endif
|
||||
# define dTHXa(a) pTHX = a
|
||||
# define dTHX dTHXa(PERL_GET_THX)
|
||||
# define dTHX pTHX = PERL_GET_THX
|
||||
# define pTHX_ pTHX,
|
||||
# define aTHX_ aTHX,
|
||||
# define pTHX_1 2
|
||||
@ -243,6 +244,7 @@ struct perl_thread;
|
||||
# define aTHXo aTHX
|
||||
# define aTHXo_ aTHX_
|
||||
# define dTHXo dTHX
|
||||
# define dTHXoa(x) dTHXa(x)
|
||||
#endif
|
||||
|
||||
#ifndef pTHXx
|
||||
@ -298,7 +300,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
|
||||
#endif
|
||||
|
||||
#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
|
||||
#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
|
||||
#define WITH_THR(s) WITH_THX(s)
|
||||
|
||||
/*
|
||||
* SOFT_CAST can be used for args to prototyped functions to retain some
|
||||
@ -487,21 +489,16 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
|
||||
# include <sys/param.h>
|
||||
#endif
|
||||
|
||||
/* needed for IAMSUID case for 4.4BSD systems
|
||||
* XXX there should probably be a Configure variable
|
||||
*/
|
||||
|
||||
#ifdef I_SYS_PARAM
|
||||
#if (defined (BSD) && (BSD >= 199306))
|
||||
# include <sys/mount.h>
|
||||
#endif /* !BSD */
|
||||
#endif /* !I_SYS_PARAM */
|
||||
|
||||
/* Use all the "standard" definitions? */
|
||||
#if defined(STANDARD_C) && defined(I_STDLIB)
|
||||
# include <stdlib.h>
|
||||
#endif
|
||||
|
||||
/* If this causes problems, set i_unistd=undef in the hint file. */
|
||||
#ifdef I_UNISTD
|
||||
# include <unistd.h>
|
||||
#endif
|
||||
|
||||
#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
|
||||
# define MYSWAP
|
||||
#endif
|
||||
@ -548,17 +545,6 @@ Free_t Perl_mfree (Malloc_t where);
|
||||
|
||||
typedef struct perl_mstats perl_mstats_t;
|
||||
|
||||
struct perl_mstats {
|
||||
unsigned long *nfree;
|
||||
unsigned long *ntotal;
|
||||
long topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
|
||||
long total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
|
||||
long minbucket;
|
||||
/* Level 1 info */
|
||||
unsigned long *bucket_mem_size;
|
||||
unsigned long *bucket_available_size;
|
||||
};
|
||||
|
||||
# define safemalloc Perl_malloc
|
||||
# define safecalloc Perl_calloc
|
||||
# define saferealloc Perl_realloc
|
||||
@ -719,10 +705,50 @@ struct perl_mstats {
|
||||
#endif
|
||||
|
||||
#include <errno.h>
|
||||
#ifdef HAS_SOCKET
|
||||
# ifdef I_NET_ERRNO
|
||||
# include <net/errno.h>
|
||||
|
||||
#if defined(WIN32) && (defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI))
|
||||
# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */
|
||||
#endif
|
||||
|
||||
#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
|
||||
# include <sys/socket.h>
|
||||
# if defined(USE_SOCKS) && defined(I_SOCKS)
|
||||
# if !defined(INCLUDE_PROTOTYPES)
|
||||
# define INCLUDE_PROTOTYPES /* for <socks.h> */
|
||||
# define PERL_SOCKS_NEED_PROTOTYPES
|
||||
# endif
|
||||
# ifdef USE_THREADS
|
||||
# define PERL_USE_THREADS /* store our value */
|
||||
# undef USE_THREADS
|
||||
# endif
|
||||
# include <socks.h>
|
||||
# ifdef USE_THREADS
|
||||
# undef USE_THREADS /* socks.h does this on its own */
|
||||
# endif
|
||||
# ifdef PERL_USE_THREADS
|
||||
# define USE_THREADS /* restore our value */
|
||||
# undef PERL_USE_THREADS
|
||||
# endif
|
||||
# ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */
|
||||
# undef INCLUDE_PROTOTYPES
|
||||
# undef PERL_SOCKS_NEED_PROTOTYPES
|
||||
# endif
|
||||
# ifdef USE_64_BIT_ALL
|
||||
# define SOCKS_64BIT_BUG /* until proven otherwise */
|
||||
# endif
|
||||
# endif
|
||||
# ifdef I_NETDB
|
||||
# include <netdb.h>
|
||||
# endif
|
||||
# ifndef ENOTSOCK
|
||||
# ifdef I_NET_ERRNO
|
||||
# include <net/errno.h>
|
||||
# endif
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifdef SETERRNO
|
||||
# undef SETERRNO /* SOCKS might have defined this */
|
||||
#endif
|
||||
|
||||
#ifdef VMS
|
||||
@ -1072,8 +1098,16 @@ typedef UVTYPE UV;
|
||||
#define PTR2IV(p) INT2PTR(IV,p)
|
||||
#define PTR2UV(p) INT2PTR(UV,p)
|
||||
#define PTR2NV(p) NUM2PTR(NV,p)
|
||||
#if PTRSIZE == LONGSIZE
|
||||
# define PTR2ul(p) (unsigned long)(p)
|
||||
#else
|
||||
# define PTR2ul(p) INT2PTR(unsigned long,p)
|
||||
#endif
|
||||
|
||||
#ifdef USE_LONG_DOUBLE
|
||||
# if defined(HAS_LONG_DOUBLE) && LONG_DOUBLESIZE == DOUBLESIZE
|
||||
# define LONG_DOUBLE_EQUALS_DOUBLE
|
||||
# endif
|
||||
# if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
|
||||
# undef USE_LONG_DOUBLE /* Ouch! */
|
||||
# endif
|
||||
@ -1154,16 +1188,22 @@ typedef NVTYPE NV;
|
||||
# include <sunmath.h>
|
||||
# endif
|
||||
# define NV_DIG LDBL_DIG
|
||||
# ifdef HAS_SQRTL
|
||||
/* libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
|
||||
/* XXX Configure probe for modfl and frexpl needed XXX */
|
||||
# if defined(__sun) && defined(__svr4)
|
||||
# define Perl_modf(x,y) ((long double)modf((double)(x),(double*)(y)))
|
||||
# define Perl_frexp(x) ((long double)frexp((double)(x)))
|
||||
# ifdef LDBL_MANT_DIG
|
||||
# define NV_MANT_DIG LDBL_MANT_DIG
|
||||
# endif
|
||||
# ifdef LDBL_MAX
|
||||
# define NV_MAX LDBL_MAX
|
||||
# define NV_MIN LDBL_MIN
|
||||
# else
|
||||
# ifdef HUGE_VALL
|
||||
# define NV_MAX HUGE_VALL
|
||||
# else
|
||||
# define Perl_modf modfl
|
||||
# define Perl_frexp frexpl
|
||||
# ifdef HUGE_VAL
|
||||
# define NV_MAX ((NV)HUGE_VAL)
|
||||
# endif
|
||||
# endif
|
||||
# endif
|
||||
# ifdef HAS_SQRTL
|
||||
# define Perl_cos cosl
|
||||
# define Perl_sin sinl
|
||||
# define Perl_sqrt sqrtl
|
||||
@ -1174,10 +1214,39 @@ typedef NVTYPE NV;
|
||||
# define Perl_floor floorl
|
||||
# define Perl_fmod fmodl
|
||||
# endif
|
||||
/* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
|
||||
# ifdef HAS_MODFL
|
||||
# define Perl_modf(x,y) modfl(x,y)
|
||||
# else
|
||||
# define Perl_modf(x,y) ((long double)modf((double)(x),(double*)(y)))
|
||||
# endif
|
||||
# ifdef HAS_FREXPL
|
||||
# define Perl_frexp(x,y) frexpl(x,y)
|
||||
# else
|
||||
# define Perl_frexp(x,y) ((long double)frexp((double)(x),y))
|
||||
# endif
|
||||
# ifdef HAS_ISNANL
|
||||
# define Perl_isnan(x) isnanl(x)
|
||||
# else
|
||||
# ifdef HAS_ISNAN
|
||||
# define Perl_isnan(x) isnan((double)(x))
|
||||
# else
|
||||
# define Perl_isnan(x) ((x)!=(x))
|
||||
# endif
|
||||
# endif
|
||||
#else
|
||||
# define NV_DIG DBL_DIG
|
||||
# define Perl_modf modf
|
||||
# define Perl_frexp frexp
|
||||
# ifdef DBL_MANT_DIG
|
||||
# define NV_MANT_DIG DBL_MANT_DIG
|
||||
# endif
|
||||
# ifdef DBL_MAX
|
||||
# define NV_MAX DBL_MAX
|
||||
# define NV_MIN DBL_MIN
|
||||
# else
|
||||
# ifdef HUGE_VAL
|
||||
# define NV_MAX HUGE_VAL
|
||||
# endif
|
||||
# endif
|
||||
# define Perl_cos cos
|
||||
# define Perl_sin sin
|
||||
# define Perl_sqrt sqrt
|
||||
@ -1187,19 +1256,33 @@ typedef NVTYPE NV;
|
||||
# define Perl_pow pow
|
||||
# define Perl_floor floor
|
||||
# define Perl_fmod fmod
|
||||
# define Perl_modf(x,y) modf(x,y)
|
||||
# define Perl_frexp(x,y) frexp(x,y)
|
||||
# ifdef HAS_ISNAN
|
||||
# define Perl_isnan(x) isnan(x)
|
||||
# else
|
||||
# define Perl_isnan(x) ((x)!=(x))
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
|
||||
# if !defined(Perl_atof) && defined(HAS_STRTOLD)
|
||||
# define Perl_atof(s) strtold(s, (char**)NULL)
|
||||
# define Perl_atof(s) (NV)strtold(s, (char**)NULL)
|
||||
# endif
|
||||
# if !defined(Perl_atof) && defined(HAS_ATOLF)
|
||||
# define Perl_atof atolf
|
||||
# define Perl_atof (NV)atolf
|
||||
# endif
|
||||
# if !defined(Perl_atof) && defined(PERL_SCNfldbl)
|
||||
# define Perl_atof PERL_SCNfldbl
|
||||
# define Perl_atof2(s,f) sscanf((s), "%"PERL_SCNfldbl, &(f))
|
||||
# endif
|
||||
#endif
|
||||
#if !defined(Perl_atof)
|
||||
# define Perl_atof atof /* we assume atof being available anywhere */
|
||||
#endif
|
||||
#if !defined(Perl_atof2)
|
||||
# define Perl_atof2(s,f) ((f) = (NV)Perl_atof(s))
|
||||
#endif
|
||||
|
||||
/* Previously these definitions used hardcoded figures.
|
||||
* It is hoped these formula are more portable, although
|
||||
@ -1372,28 +1455,25 @@ typedef NVTYPE NV;
|
||||
|
||||
#ifdef UV_IS_QUAD
|
||||
|
||||
# ifdef UQUAD_MAX
|
||||
# define PERL_UQUAD_MAX ((UV)UQUAD_MAX)
|
||||
# else
|
||||
# define PERL_UQUAD_MAX (~(UV)0)
|
||||
# endif
|
||||
|
||||
# define PERL_UQUAD_MIN ((UV)0)
|
||||
|
||||
# ifdef QUAD_MAX
|
||||
# define PERL_QUAD_MAX ((IV)QUAD_MAX)
|
||||
# else
|
||||
# define PERL_UQUAD_MIN ((UV)0)
|
||||
# define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1))
|
||||
# endif
|
||||
|
||||
# ifdef QUAD_MIN
|
||||
# define PERL_QUAD_MIN ((IV)QUAD_MIN)
|
||||
# else
|
||||
# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
|
||||
# endif
|
||||
|
||||
#endif
|
||||
|
||||
struct perl_mstats {
|
||||
UV *nfree;
|
||||
UV *ntotal;
|
||||
IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
|
||||
IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
|
||||
IV minbucket;
|
||||
/* Level 1 info */
|
||||
UV *bucket_mem_size;
|
||||
UV *bucket_available_size;
|
||||
UV nbuckets;
|
||||
};
|
||||
|
||||
typedef MEM_SIZE STRLEN;
|
||||
|
||||
typedef struct op OP;
|
||||
@ -1409,7 +1489,12 @@ typedef struct pvop PVOP;
|
||||
typedef struct loop LOOP;
|
||||
|
||||
typedef struct interpreter PerlInterpreter;
|
||||
typedef struct sv SV;
|
||||
#ifdef UTS
|
||||
# define STRUCT_SV perl_sv /* Amdahl's <ksync.h> has struct sv */
|
||||
#else
|
||||
# define STRUCT_SV sv
|
||||
#endif
|
||||
typedef struct STRUCT_SV SV;
|
||||
typedef struct av AV;
|
||||
typedef struct hv HV;
|
||||
typedef struct cv CV;
|
||||
@ -1574,6 +1659,9 @@ typedef struct ptr_tbl PTR_TBL_t;
|
||||
# else
|
||||
# if defined(MACOS_TRADITIONAL)
|
||||
# include "macos/macish.h"
|
||||
# ifndef NO_ENVIRON_ARRAY
|
||||
# define NO_ENVIRON_ARRAY
|
||||
# endif
|
||||
# else
|
||||
# include "unixish.h"
|
||||
# endif
|
||||
@ -1582,7 +1670,18 @@ typedef struct ptr_tbl PTR_TBL_t;
|
||||
# endif
|
||||
# endif
|
||||
# endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifndef NO_ENVIRON_ARRAY
|
||||
# define USE_ENVIRON_ARRAY
|
||||
#endif
|
||||
|
||||
#ifdef JPL
|
||||
/* E.g. JPL needs to operate on a copy of the real environment.
|
||||
* JDK 1.2 and 1.3 seem to get upset if the original environment
|
||||
* is diddled with. */
|
||||
# define NEED_ENVIRON_DUP_FOR_MODIFY
|
||||
#endif
|
||||
|
||||
#ifndef PERL_SYS_INIT3
|
||||
# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
|
||||
@ -1772,9 +1871,25 @@ typedef pthread_key_t perl_key;
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef UVf
|
||||
# ifdef CHECK_FORMAT
|
||||
# define UVf UVuf
|
||||
# else
|
||||
# define UVf "Vu"
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef VDf
|
||||
# ifdef CHECK_FORMAT
|
||||
# define VDf "p"
|
||||
# else
|
||||
# define VDf "vd"
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/* Some unistd.h's give a prototype for pause() even though
|
||||
HAS_PAUSE ends up undefined. This causes the #define
|
||||
below to be rejected by the compmiler. Sigh.
|
||||
below to be rejected by the compiler. Sigh.
|
||||
*/
|
||||
#ifdef HAS_PAUSE
|
||||
#define Pause pause
|
||||
@ -1994,6 +2109,7 @@ Gid_t getegid (void);
|
||||
|
||||
#ifndef Perl_error_log
|
||||
# define Perl_error_log (PL_stderrgv \
|
||||
&& GvIOp(PL_stderrgv) \
|
||||
&& IoOFP(GvIOp(PL_stderrgv)) \
|
||||
? IoOFP(GvIOp(PL_stderrgv)) \
|
||||
: PerlIO_stderr())
|
||||
@ -2014,9 +2130,11 @@ Gid_t getegid (void);
|
||||
# if defined(PERL_OBJECT)
|
||||
# define DEBUG_m(a) if (PL_debug & 128) a
|
||||
# else
|
||||
/* Temporarily turn off memory debugging in case the a
|
||||
* does memory allocation, either directly or indirectly. */
|
||||
# define DEBUG_m(a) \
|
||||
STMT_START { \
|
||||
if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } } \
|
||||
if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) {PL_debug&=~128; a; PL_debug|=128;} } \
|
||||
} STMT_END
|
||||
# endif
|
||||
#define DEBUG_f(a) if (PL_debug & 256) a
|
||||
@ -2032,6 +2150,7 @@ Gid_t getegid (void);
|
||||
# else
|
||||
# define DEBUG_S(a)
|
||||
# endif
|
||||
#define DEBUG_T(a) if (PL_debug & (1<<17)) a
|
||||
#else
|
||||
#define DEB(a)
|
||||
#define DEBUG(a)
|
||||
@ -2052,6 +2171,7 @@ Gid_t getegid (void);
|
||||
#define DEBUG_X(a)
|
||||
#define DEBUG_D(a)
|
||||
#define DEBUG_S(a)
|
||||
#define DEBUG_T(a)
|
||||
#endif
|
||||
#define YYMAXDEPTH 300
|
||||
|
||||
@ -2122,8 +2242,12 @@ char *crypt (const char*, const char*);
|
||||
# ifndef getenv
|
||||
char *getenv (const char*);
|
||||
# endif /* !getenv */
|
||||
# if !defined(EPOC) && !(defined(__hpux) && defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS == 64) && !defined(HAS_LSEEK_PROTO)
|
||||
# if !defined(HAS_LSEEK_PROTO) && !defined(EPOC) && !defined(__hpux)
|
||||
# ifdef _FILE_OFFSET_BITS
|
||||
# if _FILE_OFFSET_BITS == 64
|
||||
Off_t lseek (int,Off_t,int);
|
||||
# endif
|
||||
# endif
|
||||
# endif
|
||||
# endif /* !DONT_DECLARE_STD */
|
||||
char *getlogin (void);
|
||||
@ -2209,18 +2333,18 @@ typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
|
||||
# define environ (*environ_pointer)
|
||||
EXT char *** environ_pointer;
|
||||
# else
|
||||
# if defined(__APPLE__)
|
||||
# if defined(__APPLE__) && defined(PERL_CORE)
|
||||
# include <crt_externs.h> /* for the env array */
|
||||
# define environ (*_NSGetEnviron())
|
||||
# endif
|
||||
# endif
|
||||
#else
|
||||
/* VMS and some other platforms don't use the environ array */
|
||||
# if !defined(VMS)
|
||||
# ifdef USE_ENVIRON_ARRAY
|
||||
# if !defined(DONT_DECLARE_STD) || \
|
||||
(defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
|
||||
defined(__sgi) || \
|
||||
defined(__DGUX) || defined(EPOC)
|
||||
defined(__DGUX)
|
||||
extern char ** environ; /* environment variables supplied via exec */
|
||||
# endif
|
||||
# endif
|
||||
@ -2585,10 +2709,6 @@ typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv,
|
||||
typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog);
|
||||
typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r);
|
||||
|
||||
#ifdef USE_PURE_BISON
|
||||
int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
|
||||
#endif
|
||||
|
||||
typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
|
||||
typedef void (*DESTRUCTORFUNC_t) (pTHXo_ void*);
|
||||
typedef void (*SVFUNC_t) (pTHXo_ SV*);
|
||||
@ -2834,7 +2954,8 @@ EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FP
|
||||
|
||||
EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
|
||||
EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0};
|
||||
EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), 0, 0, 0, 0};
|
||||
EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get),
|
||||
MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0};
|
||||
|
||||
#ifdef USE_LOCALE_COLLATE
|
||||
EXT MGVTBL PL_vtbl_collxfrm = {0,
|
||||
@ -3062,23 +3183,29 @@ typedef struct am_table_short AMTS;
|
||||
#ifdef USE_LOCALE_NUMERIC
|
||||
|
||||
#define SET_NUMERIC_STANDARD() \
|
||||
STMT_START { \
|
||||
if (! PL_numeric_standard) \
|
||||
set_numeric_standard(); \
|
||||
} STMT_END
|
||||
set_numeric_standard();
|
||||
|
||||
#define SET_NUMERIC_LOCAL() \
|
||||
STMT_START { \
|
||||
if (! PL_numeric_local) \
|
||||
set_numeric_local(); \
|
||||
} STMT_END
|
||||
set_numeric_local();
|
||||
|
||||
#define IS_NUMERIC_RADIX(c) \
|
||||
#define IS_NUMERIC_RADIX(s) \
|
||||
((PL_hints & HINT_LOCALE) && \
|
||||
PL_numeric_radix && (c) == PL_numeric_radix)
|
||||
PL_numeric_radix_sv && memEQ(s, SvPVX(PL_numeric_radix_sv), SvCUR(PL_numeric_radix_sv)))
|
||||
|
||||
#define STORE_NUMERIC_LOCAL_SET_STANDARD() \
|
||||
bool was_local = (PL_hints & HINT_LOCALE) && PL_numeric_local; \
|
||||
if (was_local) SET_NUMERIC_STANDARD();
|
||||
|
||||
#define STORE_NUMERIC_STANDARD_SET_LOCAL() \
|
||||
bool was_standard = (PL_hints & HINT_LOCALE) && PL_numeric_standard; \
|
||||
if (was_standard) SET_NUMERIC_LOCAL();
|
||||
|
||||
#define RESTORE_NUMERIC_LOCAL() \
|
||||
if (was_local) SET_NUMERIC_LOCAL();
|
||||
|
||||
#define RESTORE_NUMERIC_STANDARD() \
|
||||
if (was_standard) SET_NUMERIC_STANDARD();
|
||||
|
||||
#define RESTORE_NUMERIC_LOCAL() if ((PL_hints & HINT_LOCALE) && PL_numeric_standard) SET_NUMERIC_LOCAL()
|
||||
#define RESTORE_NUMERIC_STANDARD() if ((PL_hints & HINT_LOCALE) && PL_numeric_local) SET_NUMERIC_STANDARD()
|
||||
#define Atof my_atof
|
||||
|
||||
#else /* !USE_LOCALE_NUMERIC */
|
||||
@ -3086,6 +3213,8 @@ typedef struct am_table_short AMTS;
|
||||
#define SET_NUMERIC_STANDARD() /**/
|
||||
#define SET_NUMERIC_LOCAL() /**/
|
||||
#define IS_NUMERIC_RADIX(c) (0)
|
||||
#define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/
|
||||
#define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/
|
||||
#define RESTORE_NUMERIC_LOCAL() /**/
|
||||
#define RESTORE_NUMERIC_STANDARD() /**/
|
||||
#define Atof Perl_atof
|
||||
@ -3310,6 +3439,10 @@ typedef struct am_table_short AMTS;
|
||||
# include <libutil.h> /* setproctitle() in some FreeBSDs */
|
||||
#endif
|
||||
|
||||
#ifndef EXEC_ARGV_CAST
|
||||
#define EXEC_ARGV_CAST(x) x
|
||||
#endif
|
||||
|
||||
/* and finally... */
|
||||
#define PERL_PATCHLEVEL_H_IMPLICIT
|
||||
#include "patchlevel.h"
|
||||
@ -3336,6 +3469,10 @@ typedef struct am_table_short AMTS;
|
||||
I_SYSMMAN
|
||||
Mmap_t
|
||||
|
||||
NVef
|
||||
NVff
|
||||
NVgf
|
||||
|
||||
so that Configure picks them up. */
|
||||
|
||||
#endif /* Include guard */
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -37,13 +37,16 @@ $Config{startperl}
|
||||
|
||||
print OUT <<'!NO!SUBS!';
|
||||
|
||||
use strict;
|
||||
|
||||
use Config;
|
||||
use File::Path qw(mkpath);
|
||||
use Getopt::Std;
|
||||
|
||||
getopts('Dd:rlhaQ');
|
||||
use vars qw($opt_D $opt_d $opt_r $opt_l $opt_h $opt_a $opt_Q);
|
||||
die "-r and -a options are mutually exclusive\n" if ($opt_r and $opt_a);
|
||||
@inc_dirs = inc_dirs() if $opt_a;
|
||||
my @inc_dirs = inc_dirs() if $opt_a;
|
||||
|
||||
my $Exit = 0;
|
||||
|
||||
@ -51,7 +54,7 @@ my $Dest_dir = $opt_d || $Config{installarchlib};
|
||||
die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
|
||||
unless -d $Dest_dir;
|
||||
|
||||
@isatype = split(' ',<<END);
|
||||
my @isatype = split(' ',<<END);
|
||||
char uchar u_char
|
||||
short ushort u_short
|
||||
int uint u_int
|
||||
@ -59,14 +62,18 @@ die "Destination directory $Dest_dir doesn't exist or isn't a directory\n"
|
||||
FILE key_t caddr_t
|
||||
END
|
||||
|
||||
my %isatype;
|
||||
@isatype{@isatype} = (1) x @isatype;
|
||||
$inif = 0;
|
||||
my $inif = 0;
|
||||
my %Is_converted;
|
||||
|
||||
@ARGV = ('-') unless @ARGV;
|
||||
|
||||
build_preamble_if_necessary();
|
||||
|
||||
while (defined ($file = next_file())) {
|
||||
my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
|
||||
my ($incl, $next);
|
||||
while (defined (my $file = next_file())) {
|
||||
if (-l $file and -d $file) {
|
||||
link_if_possible($file) if ($opt_l);
|
||||
next;
|
||||
@ -130,7 +137,7 @@ while (defined ($file = next_file())) {
|
||||
my $proto = '() ';
|
||||
if ($args ne '') {
|
||||
$proto = '';
|
||||
foreach $arg (split(/,\s*/,$args)) {
|
||||
foreach my $arg (split(/,\s*/,$args)) {
|
||||
$arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/;
|
||||
$curargs{$arg} = 1;
|
||||
}
|
||||
@ -258,11 +265,11 @@ while (defined ($file = next_file())) {
|
||||
s@/\*.*?\*/@@g;
|
||||
s/\s+/ /g;
|
||||
/^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/;
|
||||
($enum_subs = $3) =~ s/\s//g;
|
||||
@enum_subs = split(/,/, $enum_subs);
|
||||
$enum_val = -1;
|
||||
for $enum (@enum_subs) {
|
||||
($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
|
||||
(my $enum_subs = $3) =~ s/\s//g;
|
||||
my @enum_subs = split(/,/, $enum_subs);
|
||||
my $enum_val = -1;
|
||||
foreach my $enum (@enum_subs) {
|
||||
my ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/;
|
||||
$enum_value =~ s/^=//;
|
||||
$enum_val = (length($enum_value) ? $enum_value : $enum_val + 1);
|
||||
if ($opt_h) {
|
||||
@ -281,12 +288,13 @@ while (defined ($file = next_file())) {
|
||||
}
|
||||
print OUT "1;\n";
|
||||
|
||||
$is_converted{$file} = 1;
|
||||
$Is_converted{$file} = 1;
|
||||
queue_includes_from($file) if ($opt_a);
|
||||
}
|
||||
|
||||
exit $Exit;
|
||||
|
||||
|
||||
sub reindent($) {
|
||||
my($text) = shift;
|
||||
$text =~ s/\n/\n /g;
|
||||
@ -294,9 +302,11 @@ sub reindent($) {
|
||||
$text;
|
||||
}
|
||||
|
||||
|
||||
sub expr {
|
||||
my $joined_args;
|
||||
if(keys(%curargs)) {
|
||||
my($joined_args) = join('|', keys(%curargs));
|
||||
$joined_args = join('|', keys(%curargs));
|
||||
}
|
||||
while ($_ ne '') {
|
||||
s/^\&\&// && do { $new .= " &&"; next;}; # handle && operator
|
||||
@ -348,7 +358,7 @@ sub expr {
|
||||
};
|
||||
# struct/union member, including arrays:
|
||||
s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do {
|
||||
$id = $1;
|
||||
my $id = $1;
|
||||
$id =~ s/(\.|(->))([^\.\-]*)/->\{$3\}/g;
|
||||
$id =~ s/\b([^\$])($joined_args)/$1\$$2/g if length($joined_args);
|
||||
while($id =~ /\[\s*([^\$\&\d\]]+)\]/) {
|
||||
@ -364,7 +374,7 @@ sub expr {
|
||||
$new .= " (\$$id)";
|
||||
};
|
||||
s/^([_a-zA-Z]\w*)// && do {
|
||||
$id = $1;
|
||||
my $id = $1;
|
||||
if ($id eq 'struct') {
|
||||
s/^\s+(\w+)//;
|
||||
$id .= ' ' . $1;
|
||||
@ -506,7 +516,7 @@ sub queue_includes_from
|
||||
}
|
||||
|
||||
if ($line =~ /^#\s*include\s+<(.*?)>/) {
|
||||
push(@ARGV, $1) unless $is_converted{$1};
|
||||
push(@ARGV, $1) unless $Is_converted{$1};
|
||||
}
|
||||
}
|
||||
close HEADER;
|
||||
@ -576,7 +586,8 @@ sub build_preamble_if_necessary
|
||||
sub _extract_cc_defines
|
||||
{
|
||||
my %define;
|
||||
my $allsymbols = join " ", @Config{ccsymbols, cppsymbols, cppccsymbols};
|
||||
my $allsymbols = join " ",
|
||||
@Config{'ccsymbols', 'cppsymbols', 'cppccsymbols'};
|
||||
|
||||
# Split compiler pre-definitions into `key=value' pairs:
|
||||
foreach (split /\s+/, $allsymbols) {
|
||||
@ -709,8 +720,6 @@ that it can translate.
|
||||
It's only intended as a rough tool.
|
||||
You may need to dicker with the files produced.
|
||||
|
||||
Doesn't run with C<use strict>
|
||||
|
||||
You have to run this program by hand; it's not run as part of the Perl
|
||||
installation.
|
||||
|
||||
|
||||
@ -46,7 +46,7 @@ while (<PATCH_LEVEL>) {
|
||||
my $patch_desc = "'" . join("',\n '", @patches) . "'";
|
||||
my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
|
||||
|
||||
close PATCH_LEVEL;
|
||||
close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
|
||||
|
||||
# TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
|
||||
# used, compare $Config::config_sh with the stored version. If they differ then
|
||||
@ -92,7 +92,7 @@ BEGIN {
|
||||
$::HaveUtil = ($@ eq "");
|
||||
};
|
||||
|
||||
my $Version = "1.28";
|
||||
my $Version = "1.33";
|
||||
|
||||
# Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
|
||||
# Changed in 1.07 to see more sendmail execs, and added pipe output.
|
||||
@ -125,6 +125,11 @@ my $Version = "1.28";
|
||||
# Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
|
||||
# Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
|
||||
# Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
|
||||
# Changed in 1.29 Perlbug(tron): auto(-ok), short prompts RFOLEY 05-05-2000
|
||||
# Changed in 1.30 Added warnings on failure to open files MSTEVENS 13-07-2000
|
||||
# Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000
|
||||
# Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000
|
||||
# Changed in 1.33 Don't require -t STDOUT for -ok.
|
||||
|
||||
# TODO: - Allow the user to re-name the file on mail failure, and
|
||||
# make sure failure (transmission-wise) of Mail::Send is
|
||||
@ -132,7 +137,7 @@ my $Version = "1.28";
|
||||
# - Test -b option
|
||||
|
||||
my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
|
||||
$subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
|
||||
$subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity,
|
||||
$fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
|
||||
|
||||
my $perl_version = $^V ? sprintf("v%vd", $^V) : $];
|
||||
@ -150,7 +155,6 @@ include a file, you can use the -f switch.
|
||||
EOF
|
||||
die "\n";
|
||||
}
|
||||
if (!-t STDOUT && !$outfile) { Dump(*STDOUT); exit; }
|
||||
|
||||
Query();
|
||||
Edit() unless $usefile || ($ok and not $::opt_n);
|
||||
@ -159,30 +163,45 @@ Send();
|
||||
|
||||
exit;
|
||||
|
||||
sub ask_for_alternatives {
|
||||
sub ask_for_alternatives { # (category|severity)
|
||||
my $name = shift;
|
||||
my $default = shift;
|
||||
my @alts = @_;
|
||||
my %alts = (
|
||||
'category' => {
|
||||
'default' => 'core',
|
||||
'ok' => 'install',
|
||||
'opts' => [qw(core docs install library utilities)], # patch, notabug
|
||||
},
|
||||
'severity' => {
|
||||
'default' => 'low',
|
||||
'ok' => 'none',
|
||||
'opts' => [qw(critical high medium low wishlist none)], # zero
|
||||
},
|
||||
);
|
||||
die "Invalid alternative($name) requested\n" unless grep(/^$name$/, keys %alts);
|
||||
my $alt = "";
|
||||
paraprint <<EOF;
|
||||
if ($ok) {
|
||||
$alt = $alts{$name}{'ok'};
|
||||
} else {
|
||||
my @alts = @{$alts{$name}{'opts'}};
|
||||
paraprint <<EOF;
|
||||
Please pick a \u$name from the following:
|
||||
|
||||
@alts
|
||||
|
||||
EOF
|
||||
my $err = 0;
|
||||
my $joined_alts = join('|', @alts);
|
||||
do {
|
||||
if ($err++ > 5) {
|
||||
die "Invalid $name: aborting.\n";
|
||||
}
|
||||
print "Please enter a \u$name [$default]: ";
|
||||
$alt = <>;
|
||||
chomp $alt;
|
||||
if ($alt =~ /^\s*$/) {
|
||||
$alt = $default;
|
||||
}
|
||||
} while ($alt !~ /^($joined_alts)$/i);
|
||||
my $err = 0;
|
||||
do {
|
||||
if ($err++ > 5) {
|
||||
die "Invalid $name: aborting.\n";
|
||||
}
|
||||
print "Please enter a \u$name [$alts{$name}{'default'}]: ";
|
||||
$alt = <>;
|
||||
chomp $alt;
|
||||
if ($alt =~ /^\s*$/) {
|
||||
$alt = $alts{$name}{'default'};
|
||||
}
|
||||
} while !((($alt) = grep(/^$alt/i, @alts)));
|
||||
}
|
||||
lc $alt;
|
||||
}
|
||||
|
||||
@ -197,7 +216,7 @@ sub Init {
|
||||
MacPerl::Ask('Provide command-line args here (-h for help):')
|
||||
if $Is_MacOS && $MacPerl::Version =~ /App/;
|
||||
|
||||
if (!getopts("dhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
|
||||
if (!getopts("Adhva:s:b:f:F:r:e:SCc:to:n:")) { Help(); exit; };
|
||||
|
||||
# This comment is needed to notify metaconfig that we are
|
||||
# using the $perladmin, $cf_by, and $cf_time definitions.
|
||||
@ -205,7 +224,7 @@ sub Init {
|
||||
# -------- Configuration ---------
|
||||
|
||||
# perlbug address
|
||||
$perlbug = 'perlbug@perl.com';
|
||||
$perlbug = 'perlbug@perl.org';
|
||||
|
||||
# Test address
|
||||
$testaddress = 'perlbug-test@perl.com';
|
||||
@ -277,8 +296,6 @@ EOF
|
||||
$subject = ($::opt_n ? 'Not ' : '')
|
||||
. "OK: perl $perl_version ${patch_tags}on"
|
||||
." $::Config{'archname'} $::Config{'osvers'} $subject";
|
||||
$category = "install";
|
||||
$severity = "none";
|
||||
$ok = 1;
|
||||
} else {
|
||||
Help();
|
||||
@ -469,14 +486,10 @@ EOF
|
||||
}
|
||||
|
||||
# Prompt for category of bug
|
||||
$category ||= ask_for_alternatives("category", "core",
|
||||
qw(core docs install
|
||||
library utilities));
|
||||
$category ||= ask_for_alternatives('category');
|
||||
|
||||
# Prompt for severity of bug
|
||||
$severity ||= ask_for_alternatives("severity", "low",
|
||||
qw(critical high medium
|
||||
low wishlist none));
|
||||
$severity ||= ask_for_alternatives('severity');
|
||||
|
||||
# Generate scratch file to edit report in
|
||||
$filename = filename();
|
||||
@ -510,7 +523,7 @@ EOF
|
||||
}
|
||||
|
||||
# Generate report
|
||||
open(REP,">$filename");
|
||||
open(REP,">$filename") or die "Unable to create report file `$filename': $!\n";
|
||||
my $reptype = !$ok ? "bug" : $::opt_n ? "build failure" : "success";
|
||||
|
||||
print REP <<EOF;
|
||||
@ -527,7 +540,7 @@ EOF
|
||||
while (<F>) {
|
||||
print REP $_
|
||||
}
|
||||
close(F);
|
||||
close(F) or die "Error closing `$file': $!";
|
||||
} else {
|
||||
print REP <<EOF;
|
||||
|
||||
@ -541,17 +554,17 @@ EOF
|
||||
EOF
|
||||
}
|
||||
Dump(*REP);
|
||||
close(REP);
|
||||
close(REP) or die "Error closing report file: $!";
|
||||
|
||||
# read in the report template once so that
|
||||
# we can track whether the user does any editing.
|
||||
# yes, *all* whitespace is ignored.
|
||||
open(REP, "<$filename");
|
||||
open(REP, "<$filename") or die "Unable to open report file `$filename': $!\n";
|
||||
while (<REP>) {
|
||||
s/\s+//g;
|
||||
$REP{$_}++;
|
||||
}
|
||||
close(REP);
|
||||
close(REP) or die "Error closing report file `$filename': $!";
|
||||
} # sub Query
|
||||
|
||||
sub Dump {
|
||||
@ -562,6 +575,13 @@ sub Dump {
|
||||
Flags:
|
||||
category=$category
|
||||
severity=$severity
|
||||
EFF
|
||||
if ($::opt_A) {
|
||||
print OUT <<EFF;
|
||||
ack=no
|
||||
EFF
|
||||
}
|
||||
print OUT <<EFF;
|
||||
---
|
||||
EFF
|
||||
print OUT "This perlbug was built using Perl $config_tag1\n",
|
||||
@ -631,7 +651,8 @@ EOF
|
||||
}
|
||||
|
||||
tryagain:
|
||||
my $sts = system("$ed $filename") unless $Is_MacOS;
|
||||
my $sts;
|
||||
$sts = system("$ed $filename") unless $Is_MacOS;
|
||||
if ($Is_MacOS) {
|
||||
require ExtUtils::MakeMaker;
|
||||
ExtUtils::MM_MacOS::launch_file($filename);
|
||||
@ -665,7 +686,7 @@ EOF
|
||||
# Check that we have a report that has some, eh, report in it.
|
||||
my $unseen = 0;
|
||||
|
||||
open(REP, "<$filename");
|
||||
open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
|
||||
# a strange way to check whether any significant editing
|
||||
# have been done: check whether any new non-empty lines
|
||||
# have been added. Yes, the below code ignores *any* space
|
||||
@ -720,22 +741,22 @@ EOF
|
||||
print "\nError opening $file: $!\n\n";
|
||||
goto retry;
|
||||
}
|
||||
open(REP, "<$filename");
|
||||
open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
|
||||
print FILE "To: $address\nSubject: $subject\n";
|
||||
print FILE "Cc: $cc\n" if $cc;
|
||||
print FILE "Reply-To: $from\n" if $from;
|
||||
print FILE "\n";
|
||||
while (<REP>) { print FILE }
|
||||
close(REP);
|
||||
close(FILE);
|
||||
close(REP) or die "Error closing report file `$filename': $!";
|
||||
close(FILE) or die "Error closing $file: $!";
|
||||
|
||||
print "\nMessage saved in `$file'.\n";
|
||||
exit;
|
||||
} elsif ($action =~ /^(d|l|sh)/i ) { # <D>isplay, <L>ist, <Sh>ow
|
||||
# Display the message
|
||||
open(REP, "<$filename");
|
||||
open(REP, "<$filename") or die "Couldn't open file `$filename': $!\n";
|
||||
while (<REP>) { print $_ }
|
||||
close(REP);
|
||||
close(REP) or die "Error closing report file `$filename': $!";
|
||||
} elsif ($action =~ /^se/i) { # <S>end
|
||||
# Send the message
|
||||
print "Are you certain you want to send this message?\n"
|
||||
@ -756,7 +777,7 @@ EOF
|
||||
Edit();
|
||||
} elsif ($action =~ /^[qc]/i) { # <C>ancel, <Q>uit
|
||||
Cancel();
|
||||
} elsif ($action =~ /^s/) {
|
||||
} elsif ($action =~ /^s/i) {
|
||||
paraprint <<EOF;
|
||||
I'm sorry, but I didn't understand that. Please type "send" or "save".
|
||||
EOF
|
||||
@ -777,9 +798,9 @@ sub Send {
|
||||
$msg->add("Reply-To",$from) if $from;
|
||||
|
||||
$fh = $msg->open;
|
||||
open(REP, "<$filename");
|
||||
open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
|
||||
while (<REP>) { print $fh $_ }
|
||||
close(REP);
|
||||
close(REP) or die "Error closing $filename: $!";
|
||||
$fh->close;
|
||||
|
||||
print "\nMessage sent.\n";
|
||||
@ -824,16 +845,16 @@ report. We apologize for the inconvenience.
|
||||
So you may attempt to find some way of sending your message, it has
|
||||
been left in the file `$filename'.
|
||||
EOF
|
||||
open(SENDMAIL, "|$sendmail -t") || die "'|$sendmail -t' failed: $!";
|
||||
open(SENDMAIL, "|$sendmail -t -oi") || die "'|$sendmail -t -oi' failed: $!";
|
||||
sendout:
|
||||
print SENDMAIL "To: $address\n";
|
||||
print SENDMAIL "Subject: $subject\n";
|
||||
print SENDMAIL "Cc: $cc\n" if $cc;
|
||||
print SENDMAIL "Reply-To: $from\n" if $from;
|
||||
print SENDMAIL "\n\n";
|
||||
open(REP, "<$filename");
|
||||
open(REP, "<$filename") or die "Couldn't open `$filename': $!\n";
|
||||
while (<REP>) { print SENDMAIL $_ }
|
||||
close(REP);
|
||||
close(REP) or die "Error closing $filename: $!";
|
||||
|
||||
if (close(SENDMAIL)) {
|
||||
printf "\nMessage %s.\n", $outfile ? "saved" : "sent";
|
||||
@ -854,7 +875,7 @@ be needed.
|
||||
Usage:
|
||||
$0 [-v] [-a address] [-s subject] [-b body | -f inpufile ] [ -F outputfile ]
|
||||
[-r returnaddress] [-e editor] [-c adminaddress | -C] [-S] [-t] [-h]
|
||||
$0 [-v] [-r returnaddress] [-ok | -okay | -nok | -nokay]
|
||||
$0 [-v] [-r returnaddress] [-A] [-ok | -okay | -nok | -nokay]
|
||||
|
||||
Simplest usage: run "$0", and follow the prompts.
|
||||
|
||||
@ -876,9 +897,9 @@ Options:
|
||||
this if you don't give it here.
|
||||
-e Editor to use.
|
||||
-t Test mode. The target address defaults to `$testaddress'.
|
||||
-d Data mode (the default if you redirect or pipe output.)
|
||||
This prints out your configuration data, without mailing
|
||||
-d Data mode. This prints out your configuration data, without mailing
|
||||
anything. You can use this with -v to get more complete data.
|
||||
-A Don't send a bug received acknowledgement to the return address.
|
||||
-ok Report successful build on this system to perl porters
|
||||
(use alone or with -v). Only use -ok if *everything* was ok:
|
||||
if there were *any* problems at all, use -nok.
|
||||
@ -893,12 +914,8 @@ EOF
|
||||
}
|
||||
|
||||
sub filename {
|
||||
my $dir = $Is_VMS ? 'sys$scratch:'
|
||||
: ($Is_MSWin32 && $ENV{'TEMP'}) ? $ENV{'TEMP'}
|
||||
: $Is_MacOS ? $ENV{'TMPDIR'}
|
||||
: '/tmp';
|
||||
my $dir = File::Spec->tmpdir();
|
||||
$filename = "bugrep0$$";
|
||||
# $dir .= "\\" if $Is_MSWin32 and $dir !~ m|[\\/]$|;
|
||||
$filename++ while -e File::Spec->catfile($dir, $filename);
|
||||
$filename = File::Spec->catfile($dir, $filename);
|
||||
}
|
||||
@ -930,10 +947,10 @@ B<perlbug> S<[ B<-v> ]> S<[ B<-a> I<address> ]> S<[ B<-s> I<subject> ]>
|
||||
S<[ B<-b> I<body> | B<-f> I<inputfile> ]> S<[ B<-F> I<outputfile> ]>
|
||||
S<[ B<-r> I<returnaddress> ]>
|
||||
S<[ B<-e> I<editor> ]> S<[ B<-c> I<adminaddress> | B<-C> ]>
|
||||
S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-h> ]>
|
||||
S<[ B<-S> ]> S<[ B<-t> ]> S<[ B<-d> ]> S<[ B<-A> ]> S<[ B<-h> ]>
|
||||
|
||||
B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
|
||||
S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
|
||||
S<[ B<-A> ]> S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
@ -951,7 +968,7 @@ will be needed. Simply run it, and follow the prompts.
|
||||
|
||||
If you are unable to run B<perlbug> (most likely because you don't have
|
||||
a working setup to send mail that perlbug recognizes), you may have to
|
||||
compose your own report, and email it to B<perlbug@perl.com>. You might
|
||||
compose your own report, and email it to B<perlbug@perl.org>. You might
|
||||
find the B<-d> option useful to get summary information in that case.
|
||||
|
||||
In any case, when reporting a bug, please make sure you have run through
|
||||
@ -1029,7 +1046,7 @@ definitely be fixed. Use the C<diff> program to generate your patches
|
||||
(C<diff> is being maintained by the GNU folks as part of the B<diffutils>
|
||||
package, so you should be able to get it from any of the GNU software
|
||||
repositories). If you do submit a patch, the cool-dude counter at
|
||||
perlbug@perl.com will register you as a savior of the world. Your
|
||||
perlbug@perl.org will register you as a savior of the world. Your
|
||||
patch may be returned with requests for changes, or requests for more
|
||||
detailed explanations about your fix.
|
||||
|
||||
@ -1049,7 +1066,7 @@ B<perlbug> will, amongst other things, ensure your report includes
|
||||
crucial information about your version of perl. If C<perlbug> is unable
|
||||
to mail your report after you have typed it in, you may have to compose
|
||||
the message yourself, add the output produced by C<perlbug -d> and email
|
||||
it to B<perlbug@perl.com>. If, for some reason, you cannot run
|
||||
it to B<perlbug@perl.org>. If, for some reason, you cannot run
|
||||
C<perlbug> at all on your system, be sure to include the entire output
|
||||
produced by running C<perl -V> (note the uppercase V).
|
||||
|
||||
@ -1076,7 +1093,14 @@ version of perl comes out and your bug is still present.
|
||||
|
||||
=item B<-a>
|
||||
|
||||
Address to send the report to. Defaults to `perlbug@perl.com'.
|
||||
Address to send the report to. Defaults to `perlbug@perl.org'.
|
||||
|
||||
=item B<-A>
|
||||
|
||||
Don't send a bug received acknowledgement to the reply address.
|
||||
Generally it is only a sensible to use this option if you are a
|
||||
perl maintainer actively watching perl porters for your message to
|
||||
arrive.
|
||||
|
||||
=item B<-b>
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user