summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1999-01-24 07:09:05 +0000
committerGurusamy Sarathy <gsar@cpan.org>1999-01-24 07:09:05 +0000
commit1875ffd79b5d40eef9919d3285c217ef3635e812 (patch)
treee3d8290ac66596412b09d9caf0e1eba1edb41e05
parentee4d903cc41711efc019efd25339b39970bad65c (diff)
parentea95c1407851ede0a28b53a77da0cb2fc072454d (diff)
downloadperl-1875ffd79b5d40eef9919d3285c217ef3635e812.tar.gz
integrate cfgperl changes into mainline
p4raw-id: //depot/perl@2695
-rw-r--r--AUTHORS1
-rwxr-xr-xConfigure447
-rw-r--r--MAINTAIN2
-rw-r--r--MANIFEST1
-rw-r--r--Makefile.SH7
-rw-r--r--Porting/patching.pod54
-rw-r--r--config_h.SH58
-rw-r--r--ext/B/B/CC.pm9
-rw-r--r--ext/Errno/Errno_pm.PL11
-rw-r--r--ext/IPC/SysV/SysV.xs40
-rw-r--r--ext/Opcode/Safe.pm4
-rw-r--r--ext/Opcode/ops.pm2
-rw-r--r--hints/aix.sh38
-rw-r--r--hints/dec_osf.sh24
-rw-r--r--hints/dos_djgpp.sh12
-rw-r--r--hints/freebsd.sh38
-rw-r--r--hints/hpux.sh81
-rw-r--r--hints/irix_4.sh21
-rw-r--r--hints/irix_5.sh21
-rw-r--r--hints/irix_6.sh85
-rw-r--r--hints/irix_6_0.sh21
-rw-r--r--hints/irix_6_1.sh20
-rw-r--r--hints/linux.sh12
-rw-r--r--hints/netbsd.sh61
-rw-r--r--hints/os2.sh14
-rw-r--r--hints/solaris_2.sh71
-rw-r--r--lib/AutoLoader.pm4
-rw-r--r--lib/CGI.pm38
-rw-r--r--lib/CPAN.pm456
-rw-r--r--lib/CPAN/FirstTime.pm225
-rw-r--r--lib/Carp.pm2
-rw-r--r--lib/Cwd.pm2
-rw-r--r--lib/Exporter.pm251
-rw-r--r--lib/Exporter/Heavy.pm210
-rw-r--r--lib/File/Path.pm9
-rw-r--r--lib/SelfLoader.pm4
-rw-r--r--lib/Symbol.pm2
-rw-r--r--lib/Test.pm2
-rwxr-xr-xlib/diagnostics.pm10
-rw-r--r--lib/overload.pm24
-rwxr-xr-xmakedepend.SH7
-rw-r--r--os2/Changes9
-rw-r--r--os2/OS2/PrfDB/PrfDB.xs4
-rw-r--r--os2/os2.c89
-rw-r--r--perl.c71
-rw-r--r--perl.h16
-rw-r--r--pod/perldiag.pod10
-rw-r--r--pod/perllocale.pod38
-rw-r--r--pp.c11
-rw-r--r--pp_hot.c3
-rw-r--r--pp_sys.c20
-rwxr-xr-xt/lib/safe2.t1
-rwxr-xr-xt/op/grent.t103
-rwxr-xr-xt/op/groups.t1
-rwxr-xr-xt/op/mkdir.t1
-rwxr-xr-xt/op/pat.t42
-rwxr-xr-xt/op/pwent.t111
-rwxr-xr-xt/op/subst.t8
-rw-r--r--toke.c14
-rw-r--r--unixish.h2
-rw-r--r--util.c11
-rw-r--r--utils/perlbug.PL2
-rw-r--r--vms/subconfigure.com16
63 files changed, 2047 insertions, 937 deletions
diff --git a/AUTHORS b/AUTHORS
index c66551280c..0ab647e3cd 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -7,6 +7,7 @@
alan.burlison Alan Burlison Alan.Burlison@UK.Sun.com
allen Norton T. Allen allen@huarp.harvard.edu
cbail Charles Bailey bailey@newman.upenn.edu
+dgris Daniel Grisinger dgris@dimensional.com
dogcow Tom Spindler dogcow@merit.edu
domo Dominic Dunlop domo@slipper.ip.lu
doug Doug MacEachern dougm@pobox.com
diff --git a/Configure b/Configure
index 1d99afea14..2995765f05 100755
--- a/Configure
+++ b/Configure
@@ -20,7 +20,7 @@
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Sat Jan 9 18:00:39 EET 1999 [metaconfig 3.0 PL70]
+# Generated on Fri Jan 22 10:52:50 EET 1999 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by jhi@iki.fi)
cat >/tmp/c1$$ <<EOF
@@ -481,6 +481,11 @@ d_sockpair=''
sockethdr=''
socketlib=''
d_statblks=''
+d_fstatfs=''
+d_statfs=''
+d_statfsflags=''
+d_fstatvfs=''
+d_statvfs=''
d_stdio_cnt_lval=''
d_stdio_ptr_lval=''
d_stdiobase=''
@@ -575,6 +580,7 @@ i_machcthr=''
i_malloc=''
i_math=''
i_memory=''
+i_mntent=''
i_ndbm=''
i_netdb=''
i_neterrno=''
@@ -603,12 +609,14 @@ i_bsdioctl=''
i_sysfilio=''
i_sysioctl=''
i_syssockio=''
+i_sysmount=''
i_sysndir=''
i_sysparam=''
i_sysresrc=''
i_syssecrt=''
i_sysselct=''
i_sysstat=''
+i_sysstatvfs=''
i_systimes=''
i_systypes=''
d_iovec_s=''
@@ -629,6 +637,7 @@ i_stdarg=''
i_varargs=''
i_varhdr=''
i_vfork=''
+installusrbinperl=''
intsize=''
longsize=''
shortsize=''
@@ -2424,7 +2433,7 @@ none) osvers='' ;;
esac
: who configured the system
-cf_time=`LC_ALL=C; export LC_ALL; $date 2>&1`
+cf_time=`LC_ALL=C; LANGUAGE=C; export LC_ALL; export LANGUAGE; $date 2>&1`
cf_by=`(logname) 2>/dev/null`
case "$cf_by" in
"")
@@ -2476,16 +2485,7 @@ y|Y) val="$define" ;;
esac
set usethreads
eval $setvar
-: Look for a hint-file generated 'call-back-unit'. If the
-: user has specified that a threading perl is to be built,
-: we may need to set or change some other defaults.
-case "$usethreads" in
-$define|true|[yY]*)
- if $test -f usethreads.cbu; then
- . ./usethreads.cbu
- fi
- ;;
-esac
+
case "$d_oldpthreads" in
'') : Configure tests would be welcome here. For now, assume undef.
val="$undef" ;;
@@ -2496,247 +2496,30 @@ eval $setvar
case "$usethreads" in
-"$define")
- case "$osname" in
- aix)
- ccflags="$ccflags -DNEED_PTHREAD_INIT"
- case "$cc" in
- xlc_r | cc_r) ;;
- cc)
- echo >&4 "Switching cc to xlc_r because of POSIX threads."
- cc=xlc_r
- ;;
- '')
- cc=xlc_r
- ;;
- *)
- cat >&4 <<EOM
-For pthreads you should use the AIX C compilers xlc_r or cc_r.
-(now your compiler was '$cc')
-Cannot continue, aborting.
-EOM
- exit 1
- ;;
- esac
-
- # Add the POSIX threads library and the re-entrant libc.
-
- lddlflags=`echo $lddlflags | sed 's/ -lc$/ -lpthreads -lc_r -lc/'`
-
- # Add the c_r library to the list of wanted libraries.
- # Make sure the c_r library is before the c library or
- # make will fail.
- set `echo X "$libswanted "| sed -e 's/ c / c_r c /'`
- shift
- libswanted="$*"
- ;;
- dec_osf)
- # Threads interfaces changed with V4.0.
- case "`uname -r`" in
- *[123].*)
- libswanted="$libswanted pthreads mach exc c_r"
- ccflags="-threads $ccflags"
- ;;
- *)
- libswanted="$libswanted pthread exc"
- ccflags="-pthread $ccflags"
- ;;
- esac
-
- usemymalloc='n'
- ;;
- dos_djgpp)
- set `echo X "$libswanted "| sed -e 's/ c / gthreads c /'`
- shift
- libswanted="$*"
- ;;
- freebsd)
- case "$osvers" in
- [34].*) ldflags="-pthread $ldflags"
- ;;
- 2.2*) if [ ! -r /usr/lib/libc_r ]; then
- cat <<'EOM' >&4
-POSIX threads are not supported by default on FreeBSD $osvers. Follow the
-instructions in 'man pthread' to build and install the needed libraries.
-EOM
- exit 1
- fi
- set `echo X "$libswanted "| sed -e 's/ c / c_r /'`
- shift
- libswanted="$*"
- # Configure will probably pick the wrong libc to use for nm
- # scan.
- # The safest quick-fix is just to not use nm at all.
- usenm=false
- ;;
- *) cat <<'EOM' >&4
-
-It is not known if FreeBSD $osvers supports POSIX threads or not.
-Consider upgrading to the latest STABLE release.
-
-EOM
- exit 1
- ;;
- esac
- ;;
- hpux)
- if [ "$xxOsRevMajor" -lt 10 ]; then
- cat <<EOM >&4
-HP-UX $xxOsRevMajor cannot support POSIX threads.
-Consider upgrading to at least HP-UX 11.
-Cannot continue, aborting.
-EOM
- exit 1
- fi
- case "$xxOsRevMajor" in
- 10)
- # Under 10.X, a threaded perl can be built, but it needs
- # libcma and OLD_PTHREADS_API. Also <pthread.h> needs to
- # be #included before any other includes (in perl.h)
- if [ ! -f /usr/include/pthread.h -o ! -f /usr/lib/libcma.sl ]; then
- cat <<EOM >&4
-In HP-UX 10.X for POSIX threads you need both of the files
-/usr/include/pthread.h and /usr/lib/libcma.sl.
-Either you must install the CMA package or you must upgrade to HP-UX 11.
-Cannot continue, aborting.
-EOM
- exit 1
- fi
-
- # HP-UX 10.X uses the old pthreads API
- case "$d_oldpthreads" in
- '') d_oldpthreads="$define" ;;
- esac
-
- # include libcma before all the others
- libswanted="cma $libswanted"
-
- # tell perl.h to include <pthread.h> before other include files
- ccflags="$ccflags -DPTHREAD_H_FIRST"
-
- # CMA redefines select to cma_select, and cma_select expects int *
- # instead of fd_set * (just like 9.X)
- selecttype='int *'
- ;;
- 11 | 12) # 12 may want upping the _POSIX_C_SOURCE
- ccflags="$ccflags -D_POSIX_C_SOURCE=199506L"
- libswanted="$libswanted pthread"
- ;;
- esac
- ;;
- irix)
- if test ! -f ${TOOLROOT}/usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then
- case "`uname -r`" in
- [1-5].*|6.[01]|6.[01])
- cat >&4 <<EOM
-IRIX `uname -r` does not support POSIX threads.
-You should upgrade to at least IRIX 6.2 with pthread patches.
-EOM
- ;;
- 6.2)
- cat >&4 <<EOM
-IRIX 6.2 can have the POSIX threads.
-However,the following IRIX patches (or their replacements) MUST be installed:
- 1404 Irix 6.2 Posix 1003.1b man pages
- 1645 IRIX 6.2 & 6.3 POSIX header file updates
- 2000 Irix 6.2 Posix 1003.1b support modules
- 2254 Pthread library fixes
- 2401 6.2 all platform kernel rollup
-IMPORTANT:
- Without patch 2401, a kernel bug in IRIX 6.2 will
- cause your machine to panic and crash when running
- threaded perl. IRIX 6.3 and up should be OK.
-EOM
- ;;
- [67].*)
+"$define"|true|[yY]*)
+: Look for a hint-file generated 'call-back-unit'. If the
+: user has specified that a threading perl is to be built,
+: we may need to set or change some other defaults.
+ if $test -f usethreads.cbu; then
+ . ./usethreads.cbu
+ fi
+ case "$osname" in
+ aix|dec_osf|dos_djgpp|freebsd|hpux|irix|linux|os2|solaris|vmesa)
+ # Known thread-capable platforms.
+ ;;
+ *)
cat >&4 <<EOM
-IRIX `uname -r` should have the POSIX threads.
-But, somehow, you do not seem to have them installed.
-EOM
- ;;
- esac
- cat >&4 <<EOM
-Cannot continue, aborting.
-EOM
- exit 1
- fi
- set `echo X "$libswanted "| sed -e 's/ c / pthread /'`
- ld="${cc:-cc}"
- shift
- libswanted="$*"
-
- usemymalloc='n'
- ;;
- linux)
- ccflags="-D_REENTRANT $ccflags"
-
- set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
- shift
- libswanted="$*"
- ;;
- os2)
- ccflags="-Zmt $ccflags"
- cppflags="-Zmt $cppflags" # Do we really need to set this?
- aout_ccflags="-DUSE_THREADS $aout_ccflags"
- aout_cppflags="-DUSE_THREADS $aout_cppflags"
- aout_lddlflags="-Zmt $aout_lddlflags"
- aout_ldflags="-Zmt $aout_ldflags"
- ;;
- solaris)
- ccflags="-D_REENTRANT $ccflags"
-
- # sched_yield is in -lposix4
- set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'`
- shift
- libswanted="$*"
-
- # On Solaris 2.6 x86 there is a bug with sigsetjmp() and siglongjmp()
- # when linked with the threads library, such that whatever positive
- # value you pass to siglongjmp(), sigsetjmp() returns 1.
- # Thanks to Simon Parsons <S.Parsons@ftel.co.uk> for this report.
- # Sun BugID is 4117946, "sigsetjmp always returns 1 when called by
- # siglongjmp in a MT program". As of 19980622, there is no patch
- # available.
- cat >try.c <<'EOM'
- /* Test for sig(set|long)jmp bug. */
- #include <setjmp.h>
-
- main()
- {
- sigjmp_buf env;
- int ret;
-
- ret = sigsetjmp(env, 1);
- if (ret) { return ret == 2; }
- siglongjmp(env, 2);
- }
-EOM
- if test "`arch`" = i86pc -a "$osvers" = 2.6 && \
- ${cc:-cc} try.c -lpthread >/dev/null 2>&1 && ./a.out; then
- d_sigsetjmp=$undef
- cat << 'EOM' >&2
-
-You will see a *** WHOA THERE!!! *** message from Configure for
-d_sigsetjmp. Keep the recommended value. See hints/solaris_2.sh
-for more information.
-
-EOM
- fi
- ;;
- vmesa)
- ;;
- *)
- cat >&4 <<EOM
$osname is not known to support threads.
Please let me (jhi@iki.fi) know how to do that.
Cannot continue, aborting.
EOM
- exit 1
+ exit 1
;;
- esac # $osname
+ esac # $osname
;;
esac # $usethreads
+
cat <<EOM
Perl can be built so that multiple Perl interpreters can coexist
@@ -2783,97 +2566,35 @@ esac
set use64bits
eval $setvar
-archname64=''
+case "$archname64" in
+'') archname64='' ;; # not a typo
+esac
case "$use64bits" in
-"$define")
+"$define"|true|[yY]*)
+: Look for a hint-file generated 'call-back-unit'. If the
+: user has specified that a threading perl is to be built,
+: we may need to set or change some other defaults.
+ if $test -f use64bits.cbu; then
+ . ./use64bits.cbu
+ fi
case "$osname" in
- dec_osf)
- # Pretty much everything is 64-bit already.
- ;;
- hpux)
- if [ "$xxOsRevMajor" -lt 11 ]; then
- cat <<EOM >&4
-64-bit compilation is not supported on HP-UX $xxOsRevMajor.
-You need at least HP-UX 11.0.
-Cannot continue, aborting.
-EOM
- exit 1
- fi
- if [ ! -d /lib/pa20_64 ]; then
- cat <<EOM >&4
-You do not seem to have the 64-bit libraries, /lib/pa20_64.
-Cannot continue, aborting.
-EOM
- exit 1
- fi
- ccflags="$ccflags +DD64 -D_FILE_OFFSET_BITS=64"
- ldflags="$ldflags +DD64"
- ld=/usr/bin/ld
- set `echo " $libswanted " | sed -e 's@ dl @ @'`
- libswanted="$*"
- glibpth="/lib/pa20_64"
- ;;
- irix)
- case "`uname -r`" in
- [1-5]*|6.[01])
- cat >&4 <<EOM
-IRIX `uname -r` does not support 64-bit types.
-You should upgrade to at least IRIX 6.2.
-Cannot continue, aborting.
-EOM
- exit 1
- ;;
- esac
- case "$ccflags" in
- *-n32*)
- ccflags="$ccflags -DUSE_LONG_LONG"
- archname64="-n32"
- d_open64="$undef"
- # In -n32 mode (ILP32LL64) we use the standard open().
- # In -64 we will use the open64().
- cat << 'EOM' >&2
-
-You will see a *** WHOA THERE!!! *** message from Configure for
-d_open64. Keep the recommended value. See hints/irix6.sh
-for more information.
-
-EOM
- ;;
- esac
- ccflags="$ccflags -DUSE_64_BIT_FILES"
- ;;
- solaris)
- case "`uname -r`" in
- 1.*|2.[1-5])
- cat >&4 <<EOM
-Solaris `uname -r` does not support 64-bit interfaces.
-You should upgrade to at least Solaris 2.6.
-EOM
- exit 1
+ dec_osf|hpux|irix|solaris|unicos)
+ # Known 64-bit capable platforms.
;;
- esac
- ccflags="$ccflags `getconf LFS_CFLAGS` -DUSE_LONG_LONG"
- ldflags="$ldflags `getconf LFS_LDFLAGS`"
- libswanted="$libswanted `getconf LFS_LIBS`"
- # When a 64-bit cc becomes available $archname64
- # may need setting so that $archname gets it attached.
- ;;
- unicos)
- # Pretty much everything is 64-bit already.
- ;;
*)
- cat >&4 <<EOM
+ cat >&4 <<EOM
$osname is not known to support 64-bit interfaces.
Please let me (jhi@iki.fi) know how to do that.
Cannot continue, aborting.
EOM
- exit 1
- ;;
+ exit 1
+ ;;
esac
;;
esac
+
: determine the architecture name
echo " "
if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then
@@ -3304,16 +3025,19 @@ echo ".)"
if test 0 -eq "$subversion"; then
version=`LC_ALL=C; export LC_ALL; \
+ LANGUAGE=C; export LANGUAGE; \
echo $baserev $patchlevel | \
$awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
else
version=`LC_ALL=C; export LC_ALL; \
+ LANGUAGE=C; export LANGUAGE; \
echo $baserev $patchlevel $subversion | \
$awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'`
fi
: Figure out perl API version. Perhaps this should be in patchlevel.h
if test "$subversion" -lt 50; then
apiversion=`LC_ALL=C; export LC_ALL; \
+ LANGUAGE=C; export LANGUAGE; \
echo $baserev $patchlevel | \
$awk '{ printf "%.3f\n", $1 + $2/1000.0 }'`
else
@@ -4797,6 +4521,33 @@ else
installbin="$binexp"
fi
+: determine whether to install perl also as /usr/bin/perl
+
+echo " "
+case "$installusrbinperl" in
+'') if test -d /usr/bin -a "X$installbin" != X/usr/bin; then
+ $cat <<EOM
+Many scripts expect to perl to be installed as /usr/bin/perl.
+I can install the perl you are about to compile also as /usr/bin/perl
+(in addition to $installbin/perl).
+EOM
+ dflt='y'
+ rp="Do you want to install perl as /usr/bin/perl?"
+ . ./myread
+ case "$ans" in
+ [yY]*) val="$define";;
+ *) val="$undef";;
+ esac
+ fi
+ ;;
+esac
+case "$installusrbinperl" in
+"$undef"|[nN]*) val="$undef";;
+*) val="$define";;
+esac
+set installusrbinperl
+eval $setvar
+
: define a shorthand compile call
compile='
mc_file=$1;
@@ -8230,6 +7981,37 @@ eval $inlibc
set fsetpos d_fsetpos
eval $inlibc
+: see if this is a sys/param system
+set sys/param.h i_sysparam
+eval $inhdr
+
+: see if this is a sys/mount.h system
+set sys/mount.h i_sysmount
+eval $inhdr
+
+
+: see if statfs exists
+set statfs d_statfs
+eval $inlibc
+
+: see if fstatfs exists
+set fstatfs d_fstatfs
+eval $inlibc
+
+: see if statfs knows about mount flags
+set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h
+eval $hasfield
+
+
+: see if statvfs exists
+set statvfs d_statvfs
+eval $inlibc
+
+: see if fstatvfs exists
+set fstatvfs d_fstatvfs
+eval $inlibc
+
+
: see if ftello exists
set ftello d_ftello
eval $inlibc
@@ -11943,6 +11725,10 @@ fi
set math.h i_math
eval $inhdr
+: see if this is a mntent.h system
+set mntent.h i_mntent
+eval $inhdr
+
: see if ndbm.h is available
set ndbm.h t_ndbm
eval $inhdr
@@ -12291,10 +12077,6 @@ fi
set i_sysioctl
eval $setvar
-: see if this is a sys/param system
-set sys/param.h i_sysparam
-eval $inhdr
-
: see if sys/resource.h has to be included
set sys/resource.h i_sysresrc
eval $inhdr
@@ -12303,6 +12085,10 @@ eval $inhdr
set sys/security.h i_syssecrt
eval $inhdr
+: see if this is a sys/statvfs.h system
+set sys/statvfs.h i_sysstatvfs
+eval $inhdr
+
: see if this is a sys/un.h system
set sys/un.h i_sysun
eval $inhdr
@@ -12777,6 +12563,8 @@ d_fseeko='$d_fseeko'
d_fsetpos64='$d_fsetpos64'
d_fsetpos='$d_fsetpos'
d_fstat64='$d_fstat64'
+d_fstatfs='$d_fstatfs'
+d_fstatvfs='$d_fstatvfs'
d_ftell64='$d_ftell64'
d_ftello64='$d_ftello64'
d_ftello='$d_ftello'
@@ -12934,6 +12722,9 @@ d_socket='$d_socket'
d_sockpair='$d_sockpair'
d_stat64='$d_stat64'
d_statblks='$d_statblks'
+d_statfs='$d_statfs'
+d_statfsflags='$d_statfsflags'
+d_statvfs='$d_statvfs'
d_stdio_cnt_lval='$d_stdio_cnt_lval'
d_stdio_ptr_lval='$d_stdio_ptr_lval'
d_stdiobase='$d_stdiobase'
@@ -13036,6 +12827,7 @@ i_machcthr='$i_machcthr'
i_malloc='$i_malloc'
i_math='$i_math'
i_memory='$i_memory'
+i_mntent='$i_mntent'
i_ndbm='$i_ndbm'
i_netdb='$i_netdb'
i_neterrno='$i_neterrno'
@@ -13055,6 +12847,7 @@ i_sysfile='$i_sysfile'
i_sysfilio='$i_sysfilio'
i_sysin='$i_sysin'
i_sysioctl='$i_sysioctl'
+i_sysmount='$i_sysmount'
i_sysndir='$i_sysndir'
i_sysparam='$i_sysparam'
i_sysresrc='$i_sysresrc'
@@ -13062,6 +12855,7 @@ i_syssecrt='$i_syssecrt'
i_sysselct='$i_sysselct'
i_syssockio='$i_syssockio'
i_sysstat='$i_sysstat'
+i_sysstatvfs='$i_sysstatvfs'
i_systime='$i_systime'
i_systimek='$i_systimek'
i_systimes='$i_systimes'
@@ -13089,6 +12883,7 @@ installprivlib='$installprivlib'
installscript='$installscript'
installsitearch='$installsitearch'
installsitelib='$installsitelib'
+installusrbinperl='$installusrbinperl'
intsize='$intsize'
known_extensions='$known_extensions'
ksh='$ksh'
diff --git a/MAINTAIN b/MAINTAIN
index ea225be490..0daec7ffe4 100644
--- a/MAINTAIN
+++ b/MAINTAIN
@@ -45,7 +45,7 @@ Porting/genlog
Porting/makerel
Porting/p4d2p
Porting/p4desc
-Porting/patching.pod
+Porting/patching.pod dgris
Porting/patchls
Porting/pumpkin.pod
README
diff --git a/MANIFEST b/MANIFEST
index 55fef1026c..39d727bdad 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -517,6 +517,7 @@ lib/DirHandle.pm like FileHandle only for directories
lib/Dumpvalue.pm Screen dump of perl values
lib/English.pm Readable aliases for short variables
lib/Env.pm Map environment into ordinary variables
+lib/Exporter/Heavy.pm Complicated routines for Exporter
lib/Exporter.pm Exporter base class
lib/ExtUtils/Command.pm Utilities for Make on non-UNIX platforms
lib/ExtUtils/Embed.pm Utilities for embedding Perl in C programs
diff --git a/Makefile.SH b/Makefile.SH
index f5426f3a49..22bb3357cd 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -46,9 +46,12 @@ true)
os2*) # OS/2 doesn't need anything special for LD_LIBRARY_PATH.
ldlibpth=''
;;
- sunos*|freebsd[23]*|netbsd*)
+ sunos*|freebsd[23]*)
linklibperl="-lperl"
;;
+ netbsd*)
+ linklibperl="-L. -lperl"
+ ;;
aix*)
shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp"
case "$osvers" in
@@ -538,7 +541,7 @@ _cleaner:
-@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) $(nonxs_ext) ; do \
sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \
done
- rm -f *.orig */*.orig *~ */*~ core core.perl.*.? core.miniperl.*.? perl.core miniperl.core t/core t/core.perl.*.? t/perl.core t/tmp???? t/c t/perl
+ rm -f *.orig */*.orig *~ */*~ core core.perl.*.? core.miniperl.*.? perl.core miniperl.core t/core t/core.perl.*.? t/perl.core t/tmp???? t/c t/perl so_locations t/nonexistent1
rm -rf $(addedbyconf)
rm -f $(FIRSTMAKEFILE) $(FIRSTMAKEFILE).old
rm -f $(private)
diff --git a/Porting/patching.pod b/Porting/patching.pod
index e3b6188ff7..caada0c980 100644
--- a/Porting/patching.pod
+++ b/Porting/patching.pod
@@ -10,7 +10,7 @@ The latest version of this document is available from
=head2 How to contribute to this document
You may mail corrections, additions, and suggestions to me
-at dgris@tdrenterprises.com but the preferred method would be
+at dgris@dimensional.com but the preferred method would be
to follow the instructions set forth in this document and
submit a patch 8-).
@@ -36,6 +36,12 @@ and patches not produced using standard utilities (such as diff).
=head1 Proper Patch Guidelines
+=head2 What to patch
+
+Generally speaking you should patch the latest development release
+of perl. The maintainers of the individual branches will see to it
+that patches are picked up and applied as appropriate.
+
=head2 How to prepare your patch
=over 4
@@ -159,18 +165,19 @@ guidelines (courtesy of Gurusamy Sarathy (gsar@engin.umich.edu))-
Interpret results strictly.
Use unrelated features (this will flush out bizarre interactions).
Use non-standard idioms (otherwise you are not testing TIMTOWTDI).
- Avoid using hardcoded test umbers whenever possible (the EXPECTED/GOT style
- found in t/op/tie.t is much more maintainable, and gives better failure
- reports).
+ Avoid using hardcoded test numbers whenever possible (the
+ EXPECTED/GOT found in t/op/tie.t is much more maintainable,
+ and gives better failure reports).
Give meaningful error messages when a test fails.
Avoid using qx// and system() unless you are testing for them. If you
do use them, make sure that you cover _all_ perl platforms.
Unlink any temporary files you create.
Promote unforeseen warnings to errors with $SIG{__WARN__}.
- Be sure to use the libraries and modules shipped with version being tested,
- not those that were already installed.
+ Be sure to use the libraries and modules shipped with version
+ being tested, not those that were already installed.
Add comments to the code explaining what you are testing for.
- Make updating the '1..42' string unnecessary. Or make sure that you update it.
+ Make updating the '1..42' string unnecessary. Or make sure that
+ you update it.
Test _all_ behaviors of a given operator, library, or function-
All optional arguments
Return values in various contexts (boolean, scalar, list, lvalue)
@@ -289,23 +296,25 @@ others will have an easy time using your work, and it should be easier
for the maintainers to coordinate the occasionally large numbers of
patches received.
-Also, just because you're not a brilliant coder doesn't mean that you can't
-contribute. As valuable as code patches are there is always a need for better
-documentation (especially considering the general level of joy that most
-programmers feel when forced to sit down and write docs). If all you do
-is patch the documentation you have still contributed more than the person
-who sent in an amazing new feature that noone can use because noone understands
-the code (what I'm getting at is that documentation is both the hardest part to
-do (because everyone hates doing it) and the most valuable).
-
-Mostly, when contributing patches, imagine that it is B<you> receiving hundreds
-of patches and that it is B<your> responsibility to integrate them into the source.
-Obviously you'd want the patches to be as easy to apply as possible. Keep that in
-mind. 8-)
+Also, just because you're not a brilliant coder doesn't mean that you
+can't contribute. As valuable as code patches are there is always a
+need for better documentation (especially considering the general
+level of joy that most programmers feel when forced to sit down and
+write docs). If all you do is patch the documentation you have still
+contributed more than the person who sent in an amazing new feature
+that no one can use because no one understands the code (what I'm
+getting at is that documentation is both the hardest part to do
+(because everyone hates doing it) and the most valuable).
+
+Mostly, when contributing patches, imagine that it is B<you> receiving
+hundreds of patches and that it is B<your> responsibility to integrate
+them into the source. Obviously you'd want the patches to be as easy
+to apply as possible. Keep that in mind. 8-)
=head1 Last Modified
-Last modified 21 May 1998 by Daniel Grisinger <dgris@perrin.dimensional.com>
+Last modified 21 January 1999
+Daniel Grisinger <dgris@dimensional.com>
=head1 Author and Copyright Information
@@ -314,6 +323,3 @@ Copyright (c) 1998 Daniel Grisinger
Adapted from a posting to perl5-porters by Tim Bunce (Tim.Bunce@ig.co.uk).
I'd like to thank the perl5-porters for their suggestions.
-
-
-
diff --git a/config_h.SH b/config_h.SH
index d286068a2c..b67f029969 100644
--- a/config_h.SH
+++ b/config_h.SH
@@ -2051,6 +2051,26 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$d_sfio USE_SFIO /**/
+/* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to do stat filesystems of file descriptors.
+ */
+/* HAS_STRUCT_STATFS_FLAGS:
+ * This symbol, if defined, indicates that the struct statfs
+ * does have the f_flags member containing the mount flags of
+ * the filesystem holding the file.
+ * This kind of struct statfs is coming from sys/mount.h (BSD)
+ * and not from sys/statfs.h (SYSV).
+ */
+#$d_fstatfs HAS_FSTATFS /**/
+#$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/
+
+/* HAS_FSTATVFS:
+ * This symbol, if defined, indicates that the fstatvfs routine is
+ * available to do stat filesystems of file descriptors.
+ */
+#$d_fstatvfs HAS_FSTATVFS /**/
+
/* HAS_WRITEV:
* This symbol, if defined, indicates that the writev routine is
* available to do scatter writes.
@@ -2124,12 +2144,36 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
#$i_inttypes I_INTTYPES /**/
#$d_int64t HAS_INT64_T /**/
+/* I_MNTENT:
+ * This symbol, if defined, indicates that <mntent.h> exists and
+ * should be included.
+ */
+#$i_mntent I_MNTENT /**/
+
/* I_POLL:
* This symbol, if defined, indicates that <poll.h> exists and
* should be included.
*/
#$i_poll I_POLL /**/
+/* I_SYS_MOUNT:
+ * This symbol, if defined, indicates that <sys/mount.h> exists and
+ * should be included.
+ */
+#$i_sysmount I_SYS_MOUNT /**/
+
+/* I_SYS_STATVFS:
+ * This symbol, if defined, indicates that <sys/statvfs.h> exists and
+ * should be included.
+ */
+#$i_sysstatvfs I_SYS_STATVFS /**/
+
+/* INSTALL_USR_BIN_PERL:
+ * This symbol, if defined, indicates that Perl is to be installed
+ * also as /usr/bin/perl.
+ */
+#$installusrbinperl INSTALL_USR_BIN_PERL /**/
+
/* HAS_FSTAT64:
* This symbol, if defined, indicates that the fstat64 routine is
* available to stat files (fds) larger than 2 gigabytes.
@@ -2308,6 +2352,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$use64bits USE_64_BITS /**/
+/* MULTIPLICITY:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use multiplicity.
+ */
+#$usemultiplicity MULTIPLICITY /**/
+
/* USE_PERLIO:
* This symbol, if defined, indicates that the PerlIO abstraction should
* be used throughout. If not defined, stdio should be
@@ -2397,7 +2447,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
* in joinable (aka undetached) state. NOTE: not defined
* if pthread.h already has defined PTHREAD_CREATE_JOINABLE
* (the new version of the constant).
- * If defined, possible values are PTHREAD_CREATE_UNDETACHED
+ * If defined, known values are PTHREAD_CREATE_UNDETACHED
* and __UNDETACHED.
*/
#$d_old_pthread_create_joinable OLD_PTHREAD_CREATE_JOINABLE $old_pthread_create_joinable /**/
@@ -2427,12 +2477,6 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
*/
#$i_machcthr I_MACH_CTHREADS /**/
-/* MULTIPLICITY:
- * This symbol, if defined, indicates that Perl should
- * be built to use multiplicity.
- */
-#$usemultiplicity MULTIPLICITY /**/
-
/* USE_THREADS:
* This symbol, if defined, indicates that Perl should
* be built to use threads.
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index d9cf11966c..d8cc090479 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -1020,7 +1020,14 @@ sub pp_mapstart {
$need_freetmps = 0;
}
write_back_stack();
- doop($op);
+ # pp_mapstart can return either op_next->op_next or op_next->op_other and
+ # we need to be able to distinguish the two at runtime.
+ my $sym= doop($op);
+ my $next=$op->next;
+ $next->save;
+ my $nexttonext=$next->next;
+ $nexttonext->save;
+ runtime(sprintf("if (PL_op == (($sym)->op_next)->op_next) goto %s;", label($nexttonext)));
return $op->next->other;
}
diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL
index 286dbc6d46..3df9881eee 100644
--- a/ext/Errno/Errno_pm.PL
+++ b/ext/Errno/Errno_pm.PL
@@ -87,7 +87,16 @@ sub get_files {
$pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
}
while(<CPPO>) {
- $file{$1} = 1 if /$pat/o;
+ if ($^O eq 'os2') {
+ if (/$pat/o) {
+ my $f = $1;
+ $f =~ s,\\\\,/,g;
+ $file{$f} = 1;
+ }
+ }
+ else {
+ $file{$1} = 1 if /$pat/o;
+ }
}
close(CPPO);
}
diff --git a/ext/IPC/SysV/SysV.xs b/ext/IPC/SysV/SysV.xs
index 1f87a4d46e..e6c7555c68 100644
--- a/ext/IPC/SysV/SysV.xs
+++ b/ext/IPC/SysV/SysV.xs
@@ -4,32 +4,36 @@
#include <sys/types.h>
#ifdef __linux__
-#include <asm/page.h>
+# include <asm/page.h>
#endif
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
-#include <sys/ipc.h>
-#ifdef HAS_MSG
-#include <sys/msg.h>
-#endif
-#ifdef HAS_SEM
-#include <sys/sem.h>
-#endif
-#ifdef HAS_SHM
-#if defined(PERL_SCO5) || defined(PERL_ISC)
-#include <sys/sysmacros.h>
-#endif
-#include <sys/shm.h>
-# ifndef HAS_SHMAT_PROTOTYPE
- extern Shmat_t shmat _((int, char *, int));
-# endif
-#endif
+# include <sys/ipc.h>
+# ifdef HAS_MSG
+# include <sys/msg.h>
+# endif
+# ifdef HAS_SEM
+# include <sys/sem.h>
+# endif
+# ifdef HAS_SHM
+# if defined(PERL_SCO5) || defined(PERL_ISC)
+# include <sys/sysmacros.h> /* SHMLBA */
+# endif
+# include <sys/shm.h>
+# ifndef HAS_SHMAT_PROTOTYPE
+ extern Shmat_t shmat _((int, char *, int));
+# endif
+# if defined(__NetBSD__) && defined(__sparc__)
+# undef SHMLBA /* not static: determined at boot time */
+# define SHMLBA getpagesize()
+# endif
+# endif
#endif
/* Required in BSDI to get PAGE_SIZE definition for SHMLBA.
* Ugly. More beautiful solutions welcome.
* Shouting at BSDI sounds quite beautiful. */
#ifdef __bsdi__
-# include <vm/vm_param.h>
+# include <vm/vm_param.h> /* move upwards under HAS_SHM? */
#endif
#ifndef S_IRWXU
diff --git a/ext/Opcode/Safe.pm b/ext/Opcode/Safe.pm
index 940a972fd1..2d09c2e5c7 100644
--- a/ext/Opcode/Safe.pm
+++ b/ext/Opcode/Safe.pm
@@ -283,8 +283,8 @@ perl code is compiled into an internal format before execution.
Evaluating perl code (e.g. via "eval" or "do 'file'") causes
the code to be compiled into an internal format and then,
provided there was no error in the compilation, executed.
-Code evaulated in a compartment compiles subject to the
-compartment's operator mask. Attempting to evaulate code in a
+Code evaluated in a compartment compiles subject to the
+compartment's operator mask. Attempting to evaluate code in a
compartment which contains a masked operator will cause the
compilation to fail with an error. The code will not be executed.
diff --git a/ext/Opcode/ops.pm b/ext/Opcode/ops.pm
index b9ea36cef3..9b553b7634 100644
--- a/ext/Opcode/ops.pm
+++ b/ext/Opcode/ops.pm
@@ -31,7 +31,7 @@ ops - Perl pragma to restrict unsafe operations when compiling
=head1 DESCRIPTION
-Since the ops pragma currently has an irreversable global effect, it is
+Since the ops pragma currently has an irreversible global effect, it is
only of significant practical use with the C<-M> option on the command line.
See the L<Opcode> module for information about opcodes, optags, opmasks
diff --git a/hints/aix.sh b/hints/aix.sh
index bbcc52210f..727cf93fd6 100644
--- a/hints/aix.sh
+++ b/hints/aix.sh
@@ -74,3 +74,41 @@ case "$osvers" in
;;
esac
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ ccflags="$ccflags -DNEED_PTHREAD_INIT"
+ case "$cc" in
+ xlc_r | cc_r) ;;
+ cc)
+ echo >&4 "Switching cc to xlc_r because of POSIX threads."
+ cc=xlc_r
+ ;;
+ '')
+ cc=xlc_r
+ ;;
+ *)
+ cat >&4 <<EOM
+For pthreads you should use the AIX C compilers xlc_r or cc_r.
+(now your compiler was '$cc')
+Cannot continue, aborting.
+EOM
+ exit 1
+ ;;
+ esac
+
+ # Add the POSIX threads library and the re-entrant libc.
+
+ lddlflags=`echo $lddlflags | sed 's/ -lc$/ -lpthreads -lc_r -lc/'`
+
+ # Add the c_r library to the list of wanted libraries.
+ # Make sure the c_r library is before the c library or
+ # make will fail.
+ set `echo X "$libswanted "| sed -e 's/ c / c_r c /'`
+ shift
+ libswanted="$*"
+ ;;
+esac
+EOCBU
diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh
index b2a730004b..686ae2c089 100644
--- a/hints/dec_osf.sh
+++ b/hints/dec_osf.sh
@@ -191,6 +191,28 @@ esac
pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"'
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ # Threads interfaces changed with V4.0.
+ case "`uname -r`" in
+ *[123].*)
+ libswanted="$libswanted pthreads mach exc c_r"
+ ccflags="-threads $ccflags"
+ ;;
+ *)
+ libswanted="$libswanted pthread exc"
+ ccflags="-pthread $ccflags"
+ ;;
+ esac
+
+ usemymalloc='n'
+ ;;
+esac
+EOCBU
+
#
# Unset temporary variables no more needed.
#
@@ -326,3 +348,5 @@ unset _DEC_cc_style
# * Set -Olimit to 3200 because perl_yylex.c got too big
# for the optimizer.
#
+
+
diff --git a/hints/dos_djgpp.sh b/hints/dos_djgpp.sh
index 94c09d0e6a..db09cbc6d9 100644
--- a/hints/dos_djgpp.sh
+++ b/hints/dos_djgpp.sh
@@ -52,3 +52,15 @@ sitearch=$sitelib
eagain='EAGAIN'
rd_nodata='-1'
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ set `echo X "$libswanted "| sed -e 's/ c / gthreads c /'`
+ shift
+ libswanted="$*"
+ ;;
+esac
+EOCBU
+
diff --git a/hints/freebsd.sh b/hints/freebsd.sh
index d6384628e7..e341de4107 100644
--- a/hints/freebsd.sh
+++ b/hints/freebsd.sh
@@ -99,7 +99,8 @@ esac
case "$osvers" in
0.*|1.0*) ;;
-3.0*) objformat=`/usr/bin/objformat`
+3.*|4.0*)
+ objformat=`/usr/bin/objformat`
if [ x$objformat = xelf ]; then
libpth="/usr/lib /usr/local/lib"
glibpth="/usr/lib /usr/local/lib"
@@ -139,4 +140,39 @@ EOM
signal_t='void'
d_voidsig='define'
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ case "$osvers" in
+ 3.*|4.0*) ldflags="-pthread $ldflags"
+ ;;
+ 2.2*) if [ ! -r /usr/lib/libc_r ]; then
+ cat <<'EOM' >&4
+POSIX threads are not supported by default on FreeBSD $osvers. Follow the
+instructions in 'man pthread' to build and install the needed libraries.
+EOM
+ exit 1
+ fi
+ set `echo X "$libswanted "| sed -e 's/ c / c_r /'`
+ shift
+ libswanted="$*"
+ # Configure will probably pick the wrong libc to use for nm
+ # scan.
+ # The safest quick-fix is just to not use nm at all.
+ usenm=false
+ ;;
+ *) cat <<'EOM' >&4
+
+It is not known if FreeBSD $osvers supports POSIX threads or not.
+Consider upgrading to the latest STABLE release.
+
+EOM
+ exit 1
+ ;;
+ esac
+ ;;
+esac
+EOCBU
diff --git a/hints/hpux.sh b/hints/hpux.sh
index ceef5a3a5b..70250b7a75 100644
--- a/hints/hpux.sh
+++ b/hints/hpux.sh
@@ -193,3 +193,84 @@ esac
# assembler of the form:
# (warning) Use of GR3 when frame >= 8192 may cause conflict.
# These warnings are harmless and can be safely ignored.
+
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ if [ "$xxOsRevMajor" -lt 10 ]; then
+ cat <<EOM >&4
+HP-UX $xxOsRevMajor cannot support POSIX threads.
+Consider upgrading to at least HP-UX 11.
+Cannot continue, aborting.
+EOM
+ exit 1
+ fi
+ case "$xxOsRevMajor" in
+ 10)
+ # Under 10.X, a threaded perl can be built, but it needs
+ # libcma and OLD_PTHREADS_API. Also <pthread.h> needs to
+ # be #included before any other includes (in perl.h)
+ if [ ! -f /usr/include/pthread.h -o ! -f /usr/lib/libcma.sl ]; then
+ cat <<EOM >&4
+In HP-UX 10.X for POSIX threads you need both of the files
+/usr/include/pthread.h and /usr/lib/libcma.sl.
+Either you must install the CMA package or you must upgrade to HP-UX 11.
+Cannot continue, aborting.
+EOM
+ exit 1
+ fi
+
+ # HP-UX 10.X uses the old pthreads API
+ case "$d_oldpthreads" in
+ '') d_oldpthreads="$define" ;;
+ esac
+
+ # include libcma before all the others
+ libswanted="cma $libswanted"
+
+ # tell perl.h to include <pthread.h> before other include files
+ ccflags="$ccflags -DPTHREAD_H_FIRST"
+
+ # CMA redefines select to cma_select, and cma_select expects int *
+ # instead of fd_set * (just like 9.X)
+ selecttype='int *'
+ ;;
+ 11 | 12) # 12 may want upping the _POSIX_C_SOURCE
+ ccflags="$ccflags -D_POSIX_C_SOURCE=199506L"
+ libswanted="$libswanted pthread"
+ ;;
+ esac
+ ;;
+esac
+EOCBU
+
+# This script UU/use64bits.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use 64 bits.
+cat > UU/use64bits.cbu <<'EOCBU'
+case "$use64bits" in
+$define|true|[yY]*)
+ if [ "$xxOsRevMajor" -lt 11 ]; then
+ cat <<EOM >&4
+64-bit compilation is not supported on HP-UX $xxOsRevMajor.
+You need at least HP-UX 11.0.
+Cannot continue, aborting.
+EOM
+ exit 1
+ fi
+ if [ ! -d /lib/pa20_64 ]; then
+ cat <<EOM >&4
+You do not seem to have the 64-bit libraries, /lib/pa20_64.
+Cannot continue, aborting.
+EOM
+ exit 1
+ fi
+ ccflags="$ccflags +DD64 -D_FILE_OFFSET_BITS=64"
+ ldflags="$ldflags +DD64"
+ ld=/usr/bin/ld
+ set `echo " $libswanted " | sed -e 's@ dl @ @'`
+ libswanted="$*"
+ glibpth="/lib/pa20_64"
+esac
+EOCBU
diff --git a/hints/irix_4.sh b/hints/irix_4.sh
index f5883f38cb..1e90f989bd 100644
--- a/hints/irix_4.sh
+++ b/hints/irix_4.sh
@@ -22,3 +22,24 @@ If you have problems, you might have try including
-DSTANDARD_C -cckr
in ccflags.
EOM
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
+case "$use64bits" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support 64-bit types.
+You should upgrade to at least IRIX 6.2.
+Cannot continue, aborting.
+EOM
+ exit 1
+esac
+
diff --git a/hints/irix_5.sh b/hints/irix_5.sh
index 9d6e80246c..30f11d7676 100644
--- a/hints/irix_5.sh
+++ b/hints/irix_5.sh
@@ -32,3 +32,24 @@ libswanted="$*"
# patchSG0000596. The patch can be downloaded from Advantage OnLine (SGI's
# WWW server) or from the Support Advantage 9/95 Patch CDROM. Thanks to Tom
# Christiansen and others who provided assistance.
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
+case "$use64bits" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support 64-bit types.
+You should upgrade to at least IRIX 6.2.
+Cannot continue, aborting.
+EOM
+ exit 1
+esac
+
diff --git a/hints/irix_6.sh b/hints/irix_6.sh
index 8f4dbd64af..cb2f5dd609 100644
--- a/hints/irix_6.sh
+++ b/hints/irix_6.sh
@@ -161,3 +161,88 @@ set `echo X "$libswanted "|sed -e 's/ sun / /' -e 's/ crypt / /' -e 's/ bsd / /'
shift
libswanted="$*"
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ if test ! -f ${TOOLROOT}/usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then
+ case "`uname -r`" in
+ [1-5].*|6.[01])
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ ;;
+ 6.2)
+ cat >&4 <<EOM
+IRIX 6.2 can have the POSIX threads.
+However,the following IRIX patches (or their replacements) MUST be installed:
+ 1404 Irix 6.2 Posix 1003.1b man pages
+ 1645 IRIX 6.2 & 6.3 POSIX header file updates
+ 2000 Irix 6.2 Posix 1003.1b support modules
+ 2254 Pthread library fixes
+ 2401 6.2 all platform kernel rollup
+IMPORTANT:
+ Without patch 2401, a kernel bug in IRIX 6.2 will
+ cause your machine to panic and crash when running
+ threaded perl. IRIX 6.3 and up should be OK.
+EOM
+ ;;
+ [67].*)
+ cat >&4 <<EOM
+IRIX `uname -r` should have the POSIX threads.
+But, somehow, you do not seem to have them installed.
+EOM
+ ;;
+ esac
+ cat >&4 <<EOM
+Cannot continue, aborting.
+EOM
+ exit 1
+ fi
+ set `echo X "$libswanted "| sed -e 's/ c / pthread /'`
+ ld="${cc:-cc}"
+ shift
+ libswanted="$*"
+
+ usemymalloc='n'
+ ;;
+esac
+EOCBU
+
+# This script UU/use64bits.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use 64 bits.
+cat > UU/use64bits.cbu <<'EOCBU'
+case "$use64bits" in
+$define|true|[yY]*)
+ case "`uname -r`" in
+ [1-5]*|6.[01])
+ cat >&4 <<EOM
+IRIX `uname -r` does not support 64-bit types.
+You should upgrade to at least IRIX 6.2.
+Cannot continue, aborting.
+EOM
+ exit 1
+ ;;
+ esac
+ case "$ccflags" in
+ *-n32*)
+ ccflags="$ccflags -DUSE_LONG_LONG"
+ archname64="-n32"
+ d_open64="$undef"
+ # In -n32 mode (ILP32LL64) we use the standard open().
+ # In -64 we will use the open64().
+ cat << 'EOM' >&2
+
+You will see a *** WHOA THERE!!! *** message from Configure for
+d_open64. Keep the recommended value. See hints/irix6.sh
+for more information.
+
+EOM
+ ;;
+ esac
+ ccflags="$ccflags -DUSE_64_BIT_FILES"
+ ;;
+esac
+EOCBU
diff --git a/hints/irix_6_0.sh b/hints/irix_6_0.sh
index 38fe27d282..b34b3ecaff 100644
--- a/hints/irix_6_0.sh
+++ b/hints/irix_6_0.sh
@@ -41,3 +41,24 @@ libswanted="$*"
# set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ sun / /' -e 's/ crypt / /' -e 's/ nsl / /' -e 's/ dl / /'`
# shift
# libswanted="$*"
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
+case "$use64bits" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support 64-bit types.
+You should upgrade to at least IRIX 6.2.
+Cannot continue, aborting.
+EOM
+ exit 1
+esac
+
diff --git a/hints/irix_6_1.sh b/hints/irix_6_1.sh
index 38fe27d282..3359639818 100644
--- a/hints/irix_6_1.sh
+++ b/hints/irix_6_1.sh
@@ -41,3 +41,23 @@ libswanted="$*"
# set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ sun / /' -e 's/ crypt / /' -e 's/ nsl / /' -e 's/ dl / /'`
# shift
# libswanted="$*"
+
+case "$usethreads" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support POSIX threads.
+You should upgrade to at least IRIX 6.2 with pthread patches.
+EOM
+ exit 1
+ ;;
+esac
+
+case "$use64bits" in
+$define|true|[yY]*)
+ cat >&4 <<EOM
+IRIX `uname -r` does not support 64-bit types.
+You should upgrade to at least IRIX 6.2.
+Cannot continue, aborting.
+EOM
+ exit 1
+esac
diff --git a/hints/linux.sh b/hints/linux.sh
index 9b69e9b4ac..a49e004bbd 100644
--- a/hints/linux.sh
+++ b/hints/linux.sh
@@ -216,3 +216,15 @@ fi
# it should be:
# ccdlflags='-Wl,-E'
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ ccflags="-D_REENTRANT $ccflags"
+ set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
+ shift
+ libswanted="$*"
+ ;;
+esac
+EOCBU
diff --git a/hints/netbsd.sh b/hints/netbsd.sh
index 71d508448a..a8cc7dc708 100644
--- a/hints/netbsd.sh
+++ b/hints/netbsd.sh
@@ -1,12 +1,11 @@
# hints/netbsd.sh
#
-# talk to mrg@eterna.com.au if you want to change this file.
+# talk to packages@netbsd.org if you want to change this file.
#
# netbsd keeps dynamic loading dl*() functions in /usr/lib/crt0.o,
# so Configure doesn't find them (unless you abandon the nm scan).
# this should be *just* 0.9 below as netbsd 0.9a was the first to
-# introduce shared libraries. however, they don't work/build on
-# pmax, powerpc and alpha ports correctly, yet.
+# introduce shared libraries.
case "$archname" in
'')
@@ -19,34 +18,26 @@ case "$osvers" in
usedl="$undef"
;;
*)
- case `uname -m` in
- alpha|powerpc|pmax)
+ if [ -f /usr/libexec/ld.elf_so ]; then
+ d_dlopen=$define
+ d_dlerror=$define
+ ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
+ cccdlflags="-DPIC -fPIC $cccdlflags"
+ lddlflags="--whole-archive -shared $lddlflags"
+ elif [ "`uname -m`" = "pmax" ]; then
+# NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work.
d_dlopen=$undef
- ;;
-# this doesn't work (yet).
-# alpha)
-# d_dlopen=$define
-# d_dlerror=$define
-# cccdlflags="-DPIC -fPIC $cccdlflags"
-# lddlflags="-shared $lddlflags"
-# ;;
- *)
+ elif [ -f /usr/libexec/ld.so ]; then
d_dlopen=$define
d_dlerror=$define
+ ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
# we use -fPIC here because -fpic is *NOT* enough for some of the
# extensions like Tk on some netbsd platforms (the sparc is one)
cccdlflags="-DPIC -fPIC $cccdlflags"
lddlflags="-Bforcearchive -Bshareable $lddlflags"
- ;;
- esac
- ;;
-esac
-# netbsd 1.3 linker warns about setr[gu]id being deprecated.
-# (setregid, setreuid, preferred?)
-case "$osvers" in
-1.3|1.3*)
- d_setrgid="$undef"
- d_setruid="$undef"
+ else
+ d_dlopen=$undef
+ fi
;;
esac
@@ -55,25 +46,25 @@ esac
# way to make perl call setuid() or setgid(). if they aren't, then
# ($<, $>) = ($u, $u); will work (same for $(/$)). this is because
# you can not change the real userid of a process under 4.4BSD.
-# netbsd fixed this in 1.2A.
+# netbsd fixed this in 1.3.2.
case "$osvers" in
-0.9*|1.0*|1.1*|1.2_*|1.2|1.2.*)
+0.9*|1.[012]*|1.3|1.3.1)
d_setregid="$undef"
d_setreuid="$undef"
d_setrgid="$undef"
d_setruid="$undef"
;;
esac
-# netbsd 1.3 linker warns about setr[gu]id being deprecated.
-# (setregid, setreuid, preferred?)
-case "$osvers" in
-1.3|1.3*)
- d_setrgid="$undef"
- d_setruid="$undef"
- ;;
-esac
-# vfork is ok on NetBSD.
+# there's no problem with vfork.
case "$usevfork" in
'') usevfork=true ;;
esac
+
+# Avoid telldir prototype conflict in pp_sys.c (NetBSD uses const DIR *)
+# Configure should test for this. Volunteers?
+pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
+
+# Pre-empt the /usr/bin/perl question of installperl.
+installusrbinperl='n'
+
diff --git a/hints/os2.sh b/hints/os2.sh
index 0560175ae1..fe0c2d3ab5 100644
--- a/hints/os2.sh
+++ b/hints/os2.sh
@@ -289,6 +289,20 @@ for xxx in * ; do
fi
done
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ ccflags="-Zmt $ccflags"
+ cppflags="-Zmt $cppflags" # Do we really need to set this?
+ aout_ccflags="-DUSE_THREADS $aout_ccflags"
+ aout_cppflags="-DUSE_THREADS $aout_cppflags"
+ aout_lddlflags="-Zmt $aout_lddlflags"
+ aout_ldflags="-Zmt $aout_ldflags"
+ ;;
+esac
+EOCBU
# Now go back
cd ../..
diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh
index e518540b40..ad84669a70 100644
--- a/hints/solaris_2.sh
+++ b/hints/solaris_2.sh
@@ -261,6 +261,77 @@ rm -f core
# XXX
EOSH
+# This script UU/usethreads.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use threads.
+cat > UU/usethreads.cbu <<'EOCBU'
+case "$usethreads" in
+$define|true|[yY]*)
+ ccflags="-D_REENTRANT $ccflags"
+
+ # sched_yield is in -lposix4
+ set `echo X "$libswanted "| sed -e 's/ c / posix4 pthread c /'`
+ shift
+ libswanted="$*"
+
+ # On Solaris 2.6 x86 there is a bug with sigsetjmp() and siglongjmp()
+ # when linked with the threads library, such that whatever positive
+ # value you pass to siglongjmp(), sigsetjmp() returns 1.
+ # Thanks to Simon Parsons <S.Parsons@ftel.co.uk> for this report.
+ # Sun BugID is 4117946, "sigsetjmp always returns 1 when called by
+ # siglongjmp in a MT program". As of 19980622, there is no patch
+ # available.
+ cat >try.c <<'EOM'
+ /* Test for sig(set|long)jmp bug. */
+ #include <setjmp.h>
+
+ main()
+ {
+ sigjmp_buf env;
+ int ret;
+
+ ret = sigsetjmp(env, 1);
+ if (ret) { return ret == 2; }
+ siglongjmp(env, 2);
+ }
+EOM
+ if test "`arch`" = i86pc -a "$osvers" = 2.6 && \
+ ${cc:-cc} try.c -lpthread >/dev/null 2>&1 && ./a.out; then
+ d_sigsetjmp=$undef
+ cat << 'EOM' >&2
+
+You will see a *** WHOA THERE!!! *** message from Configure for
+d_sigsetjmp. Keep the recommended value. See hints/solaris_2.sh
+for more information.
+
+EOM
+ fi
+ ;;
+esac
+EOCBU
+
+# This script UU/use64bits.cbu will get 'called-back' by Configure
+# after it has prompted the user for whether to use 64 bits.
+cat > UU/use64bits.cbu <<'EOCBU'
+case "$use64bits" in
+$define|true|[yY]*)
+ case "`uname -r`" in
+ 2.[1-5])
+ cat >&4 <<EOM
+Solaris `uname -r` does not support 64-bit interfaces.
+You should upgrade to at least Solaris 2.6.
+EOM
+ exit 1
+ ;;
+ esac
+ ccflags="$ccflags `getconf LFS_CFLAGS` -DUSE_LONG_LONG"
+ ldflags="$ldflags `getconf LFS_LDFLAGS`"
+ libswanted="$libswanted `getconf LFS_LIBS`"
+ # When a 64-bit cc becomes available $archname64
+ # may need setting so that $archname gets it attached.
+ ;;
+esac
+EOCBU
+
# This is just a trick to include some useful notes.
cat > /dev/null <<'End_of_Solaris_Notes'
diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm
index 666c6cacf9..5b083a7894 100644
--- a/lib/AutoLoader.pm
+++ b/lib/AutoLoader.pm
@@ -178,7 +178,7 @@ such a file exists, AUTOLOAD will read and evaluate it,
thus (presumably) defining the needed subroutine. AUTOLOAD will then
C<goto> the newly defined subroutine.
-Once this process completes for a given funtion, it is defined, so
+Once this process completes for a given function, it is defined, so
future calls to the subroutine will bypass the AUTOLOAD mechanism.
=head2 Subroutine Stubs
@@ -266,7 +266,7 @@ C<__DATA__>, after which routines are cached. B<SelfLoader> can also
handle multiple packages in a file.
B<AutoLoader> only reads code as it is requested, and in many cases
-should be faster, but requires a machanism like B<AutoSplit> be used to
+should be faster, but requires a mechanism like B<AutoSplit> be used to
create the individual files. L<ExtUtils::MakeMaker> will invoke
B<AutoSplit> automatically if B<AutoLoader> is used in a module source
file.
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 22d91a46c7..9fe8f40d6b 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -3273,10 +3273,10 @@ the CGI script, and because each object's parameter list is
independent of the others, this allows you to save the state of the
script and restore it later.
-For example, using the object oriented style, here is now you create
+For example, using the object oriented style, here is how you create
a simple "Hello World" HTML page:
- #!/usr/local/bin/pelr
+ #!/usr/local/bin/perl -w
use CGI; # load CGI routines
$q = new CGI; # create new CGI object
print $q->header, # create the HTTP header
@@ -3319,7 +3319,7 @@ acceptable. In fact, only the first argument needs to begin with a
dash. If a dash is present in the first argument, CGI.pm assumes
dashes for the subsequent ones.
-You don't have to use the hyphen at allif you don't want to. After
+You don't have to use the hyphen at all if you don't want to. After
creating a CGI object, call the B<use_named_parameters()> method with
a nonzero value. This will tell CGI.pm that you intend to use named
parameters exclusively:
@@ -3667,7 +3667,7 @@ methods, and then use them directly:
$zipcode = param('zipcode');
More frequently, you'll import common sets of functions by referring
-to the gropus by name. All function sets are preceded with a ":"
+to the groups by name. All function sets are preceded with a ":"
character as in ":html3" (for tags defined in the HTML 3 standard).
Here is a list of the function sets you can import:
@@ -3719,7 +3719,7 @@ provide for the rapidly-evolving HTML "standard." For example, say
Microsoft comes out with a new tag called <GRADIENT> (which causes the
user's desktop to be flooded with a rotating gradient fill until his
machine reboots). You don't need to wait for a new version of CGI.pm
-to start using it immeidately:
+to start using it immediately:
use CGI qw/:standard :html3 gradient/;
print gradient({-start=>'red',-end=>'blue'});
@@ -3799,7 +3799,7 @@ This causes the indicated autoloaded methods to be compiled up front,
rather than deferred to later. This is useful for scripts that run
for an extended period of time under FastCGI or mod_perl, and for
those destined to be crunched by Malcom Beattie's Perl compiler. Use
-it in conjunction with the methods or method familes you plan to use.
+it in conjunction with the methods or method families you plan to use.
use CGI qw(-compile :standard :html3);
@@ -4114,19 +4114,19 @@ header. Just pass the list of script sections as an array reference.
this allows you to specify different source files for different dialects
of JavaScript. Example:
- print $q-&gt;start_html(-title=&gt;'The Riddle of the Sphinx',
- -script=&gt;[
- { -language =&gt; 'JavaScript1.0',
- -src =&gt; '/javascript/utilities10.js'
+ print $q->start_html(-title=>'The Riddle of the Sphinx',
+ -script=>[
+ { -language => 'JavaScript1.0',
+ -src => '/javascript/utilities10.js'
},
- { -language =&gt; 'JavaScript1.1',
- -src =&gt; '/javascript/utilities11.js'
+ { -language => 'JavaScript1.1',
+ -src => '/javascript/utilities11.js'
},
- { -language =&gt; 'JavaScript1.2',
- -src =&gt; '/javascript/utilities12.js'
+ { -language => 'JavaScript1.2',
+ -src => '/javascript/utilities12.js'
},
- { -language =&gt; 'JavaScript28.2',
- -src =&gt; '/javascript/utilities219.js'
+ { -language => 'JavaScript28.2',
+ -src => '/javascript/utilities219.js'
}
]
);
@@ -4262,7 +4262,7 @@ This example shows how to use the HTML methods:
print $q->blockquote(
"Many years ago on the island of",
$q->a({href=>"http://crete.org/"},"Crete"),
- "there lived a minotaur named",
+ "there lived a Minotaur named",
$q->strong("Fred."),
),
$q->hr;
@@ -4325,7 +4325,7 @@ that points to an undef string:
Prior to CGI.pm version 2.41, providing an empty ('') string as an
attribute argument was the same as providing undef. However, this has
-changed in order to accomodate those who want to create tags of the form
+changed in order to accommodate those who want to create tags of the form
<IMG ALT="">. The difference is shown in these two pieces of code:
CODE RESULT
@@ -5093,7 +5093,7 @@ To include row and column headings in the returned table, you
can use the B<-rowheader> and B<-colheader> parameters. Both
of these accept a pointer to an array of headings to use.
The headings are just decorative. They don't reorganize the
-interpetation of the radio buttons -- they're still a single named
+interpretation of the radio buttons -- they're still a single named
unit.
=back
diff --git a/lib/CPAN.pm b/lib/CPAN.pm
index 3c94cd9f0d..f12d41c0e6 100644
--- a/lib/CPAN.pm
+++ b/lib/CPAN.pm
@@ -5,13 +5,13 @@ use vars qw{$Try_autoload $Revision
$Frontend $Defaultsite
};
-$VERSION = '1.40';
+$VERSION = '1.44_54';
-# $Id: CPAN.pm,v 1.239 1998/07/24 16:37:04 k Exp $
+# $Id: CPAN.pm,v 1.250 1999/01/14 12:26:13 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.239 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.250 $, 10)."]";
use Carp ();
use Config ();
@@ -224,7 +224,7 @@ sub AUTOLOAD {
$CPAN::Frontend->mywarn(qq{
Commands starting with "w" require CPAN::WAIT to be installed.
Please consider installing CPAN::WAIT to use the fulltext index.
-For this you just need to type
+For this you just need to type
install CPAN::WAIT
});
}
@@ -254,7 +254,7 @@ sub try_dot_al {
if (defined($name=$INC{"$pkg.pm"}))
{
$name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
- $name = undef unless (-r $name);
+ $name = undef unless (-r $name);
}
unless (defined $name)
{
@@ -269,7 +269,7 @@ sub try_dot_al {
*$autoload = sub {};
$ok = 1;
} else {
- if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+ if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
eval {local $SIG{__DIE__};require $name};
}
if ($@){
@@ -316,10 +316,80 @@ use vars qw($AUTOLOAD @ISA);
package CPAN::Queue;
# currently only used to determine if we should or shouldn't announce
# the availability of a new CPAN module
+
+# but now we try to use it for dependency tracking. For that to happen
+# we need to draw a dependency tree and do the leaves first. This can
+# easily be reached by running CPAN.pm recursively, but we don't want
+# to waste memory and run into deep recursion. So what we can do is
+# this: run the queue as the user suggested. When a dependency is
+# detected check if it is in the queue. If so, rearrange, otherwise
+# unshift it on the queue.
+
+use vars qw{ @All };
+
sub new {
my($class,$mod) = @_;
- # warn "Queue object for mod[$mod]";
- bless {mod => $mod}, $class;
+ my $self = bless {mod => $mod}, $class;
+ push @All, $self;
+ # my @all = map { $_->{mod} } @All;
+ # warn "Adding Queue object for mod[$mod] all[@all]";
+ return $self;
+
+}
+
+sub first {
+ my $obj = $All[0];
+ $obj->{mod};
+}
+
+sub delete_first {
+ my($class,$what) = @_;
+ my $i;
+ for my $i (0..$#All) {
+ if ( $All[$i]->{mod} eq $what ) {
+ splice @All, $i, 1;
+ return;
+ }
+ }
+}
+
+sub jumpqueue {
+ my $class = shift;
+ my @what = @_;
+ my $obj;
+ WHAT: for my $what (reverse @what) {
+ my $jumped = 0;
+ for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
+ if ($All[$i]->{mod} eq $what){
+ $jumped++;
+ if ($jumped > 100) { # one's OK if e.g. just processing now;
+ # more are OK if user typed it several
+ # times
+ $CPAN::Frontend->mywarn(
+qq{Object [$what] queued more than 100 times, ignoring}
+ );
+ next WHAT;
+ }
+ }
+ }
+ my $obj = bless { mod => $what }, $class;
+ unshift @All, $obj;
+ }
+}
+
+sub exists {
+ my($self,$what) = @_;
+ my @all = map { $_->{mod} } @All;
+ my $exists = grep { $_->{mod} eq $what } @All;
+ # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]";
+ $exists;
+}
+
+sub delete {
+ my($self,$mod) = @_;
+ @All = grep { $_->{mod} ne $mod } @All;
+ # my @all = map { $_->{mod} } @All;
+ # warn "Deleting Queue object for mod[$mod] all[@all]";
}
package CPAN;
@@ -632,7 +702,7 @@ sub disk_usage {
sub {
$File::Find::prune++ if $CPAN::Signal;
return if -l $_;
- $Du += -s _;
+ $Du += (-s _); # parens to help cperl-mode
},
$dir
);
@@ -664,26 +734,36 @@ sub new {
my $self = {
ID => $CPAN::Config->{'build_dir'},
MAX => $CPAN::Config->{'build_cache'},
+ SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
DU => 0
};
File::Path::mkpath($self->{ID});
my $dh = DirHandle->new($self->{ID});
bless $self, $class;
- my $e;
+ $self->scan_cache;
+ $t2 = time;
+ $debug .= "timing of CacheMgr->new: ".($t2 - $time);
+ $time = $t2;
+ CPAN->debug($debug) if $CPAN::DEBUG;
+ $self;
+}
+
+#-> sub CPAN::CacheMgr::scan_cache ;
+sub scan_cache {
+ my $self = shift;
+ return if $self->{SCAN} eq 'never';
+ $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
+ unless $self->{SCAN} eq 'atstart';
$CPAN::Frontend->myprint(
sprintf("Scanning cache %s for sizes\n",
$self->{ID}));
+ my $e;
for $e ($self->entries($self->{ID})) {
next if $e eq ".." || $e eq ".";
$self->disk_usage($e);
return if $CPAN::Signal;
}
$self->tidyup;
- $t2 = time;
- $debug .= "timing of CacheMgr->new: ".($t2 - $time);
- $time = $t2;
- CPAN->debug($debug) if $CPAN::DEBUG;
- $self;
}
package CPAN::Debug;
@@ -788,6 +868,7 @@ Please specify a filename where to save the configuration or try
EOF
$msg ||= "\n";
my($fh) = FileHandle->new;
+ rename $configpm, "$configpm~" if -f $configpm;
open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
$fh->print(qq[$msg\$CPAN::Config = \{\n]);
foreach (sort keys %$CPAN::Config) {
@@ -832,6 +913,7 @@ sub init {
sub load {
my($self) = shift;
my(@miss);
+ use Carp;
eval {require CPAN::Config;}; # We eval because of some
# MakeMaker problems
unless ($dot_cpan++){
@@ -896,11 +978,11 @@ sub load {
}
}
local($") = ", ";
- $CPAN::Frontend->myprint(qq{
+ $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
We have to reconfigure CPAN.pm due to following uninitialized parameters:
@miss
-}) if $redo && ! $theycalled;
+END
$CPAN::Frontend->myprint(qq{
$configpm initialized.
});
@@ -912,9 +994,10 @@ $configpm initialized.
sub not_loaded {
my(@miss);
for (qw(
- cpan_home keep_source_where build_dir build_cache index_expire
- gzip tar unzip make pager makepl_arg make_arg make_install_arg
- urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
+ cpan_home keep_source_where build_dir build_cache scan_cache
+ index_expire gzip tar unzip make pager makepl_arg make_arg
+ make_install_arg urllist inhibit_startup_message
+ ftp_proxy http_proxy no_proxy prerequisites_policy
)) {
push @miss, $_ unless defined $CPAN::Config->{$_};
}
@@ -1032,7 +1115,9 @@ sub b {
#-> sub CPAN::Shell::d ;
sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
#-> sub CPAN::Shell::m ;
-sub m { $CPAN::Frontend->myprint(shift->format_result('Module',@_));}
+sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
+ $CPAN::Frontend->myprint(shift->format_result('Module',@_));
+}
#-> sub CPAN::Shell::i ;
sub i {
@@ -1509,22 +1594,23 @@ sub rematein {
CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
my($s,@s);
foreach $s (@some) {
+ CPAN::Queue->new($s);
+ }
+ while ($s = CPAN::Queue->first) {
my $obj;
if (ref $s) {
$obj = $s;
} elsif ($s =~ m|/|) { # looks like a file
$obj = $CPAN::META->instance('CPAN::Distribution',$s);
} elsif ($s =~ m|^Bundle::|) {
- $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s);
$obj = $CPAN::META->instance('CPAN::Bundle',$s);
} else {
- $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s);
$obj = $CPAN::META->instance('CPAN::Module',$s)
if $CPAN::META->exists('CPAN::Module',$s);
}
if (ref $obj) {
CPAN->debug(
- qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
+ qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
$obj->as_string.
qq{\]}
) if $CPAN::DEBUG;
@@ -1539,7 +1625,9 @@ sub rematein {
if ($]>=5.00303 && $obj->can('called_for')) {
$obj->called_for($s);
}
- $obj->$meth();
+ CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
+ # than once in
+ # the queue
} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
$obj = $CPAN::META->instance('CPAN::Author',$s);
$CPAN::Frontend->myprint(
@@ -1549,7 +1637,9 @@ sub rematein {
" ;-)\n"
);
} else {
- $CPAN::Frontend->myprint(qq{Warning: Cannot $meth $s, don\'t know what it is.
+ $CPAN::Frontend
+ ->myprint(qq{Warning: Cannot $meth $s, }.
+ qq{don\'t know what it is.
Try the command
i /$s/
@@ -1557,6 +1647,7 @@ Try the command
to find objects with similar identifiers.
});
}
+ CPAN::Queue->delete_first($s);
}
}
@@ -1609,7 +1700,7 @@ sub ftp_get {
}
# If more accuracy is wanted/needed, Chris Leach sent me this patch...
-
+
# leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
# leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997
# leach,> ***************
@@ -1713,7 +1804,7 @@ sub localize {
@reordered =
sort {
(substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
- <=>
+ <=>
(substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
or
defined($Thesite)
@@ -1807,6 +1898,10 @@ sub hosteasy {
$CPAN::Frontend->myprint("Fetching with LWP:
$url
");
+ unless ($Ua) {
+ require LWP::UserAgent;
+ $Ua = LWP::UserAgent->new;
+ }
my $res = $Ua->mirror($url, $aslocal);
if ($res->is_success) {
$Thesite = $i;
@@ -1877,7 +1972,7 @@ sub hosthard {
# gave us a socksified (or other) ftp program...
my($i);
- my($devnull) = $CPAN::Config->{devnull} || "";
+ my($devnull) = $CPAN::Config->{devnull} || "";
# < /dev/null ";
my($aslocal_dir) = File::Basename::dirname($aslocal);
File::Path::mkpath($aslocal_dir);
@@ -1937,9 +2032,9 @@ Trying with "$funkyftp$source_switch" to get
CPAN::Tarzip->gzip($aslocal_uncompressed,
"$aslocal_uncompressed.gz");
}
- $Thesite = $i;
- return $aslocal;
}
+ $Thesite = $i;
+ return $aslocal;
} elsif ($url !~ /\.gz$/) {
unlink $aslocal_uncompressed if
-f $aslocal_uncompressed && -s _ == 0;
@@ -2097,7 +2192,6 @@ sub talk_ftp {
Subprocess "|$command"
returned status $estatus (wstat $wstatus)
}) if $wstatus;
-
}
# find2perl needs modularization, too, all the following is stolen
@@ -2403,7 +2497,7 @@ sub rd_authindex {
while (<FH>) {
chomp;
my($userid,$fullname,$email) =
- /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
+ m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
next unless $userid && $fullname && $email;
# instantiate an author object
@@ -2437,11 +2531,11 @@ sub rd_modpacks {
# if it is a bundle, instatiate a bundle object
my($bundle,$id,$userid);
-
+
if ($mod eq 'CPAN' &&
! (
- $CPAN::META->exists('CPAN::Queue','Bundle::CPAN') ||
- $CPAN::META->exists('CPAN::Queue','CPAN')
+ CPAN::Queue->exists('Bundle::CPAN') ||
+ CPAN::Queue->exists('CPAN')
)
) {
local($^W)= 0;
@@ -2992,16 +3086,14 @@ sub eq_MD5 {
#-> sub CPAN::Distribution::force ;
sub force {
- my($self) = @_;
- $self->{'force_update'}++;
- delete $self->{'MD5_STATUS'};
- delete $self->{'archived'};
- delete $self->{'build_dir'};
- delete $self->{'localfile'};
- delete $self->{'make'};
- delete $self->{'install'};
- delete $self->{'unwrapped'};
- delete $self->{'writemakefile'};
+ my($self) = @_;
+ $self->{'force_update'}++;
+ for my $att (qw(
+ MD5_STATUS archived build_dir localfile make install unwrapped
+ writemakefile have_sponsored
+ )) {
+ delete $self->{$att};
+ }
}
sub isa_perl {
@@ -3145,6 +3237,30 @@ or
$self->{writemakefile} = "YES";
}
return if $CPAN::Signal;
+ if (my @prereq = $self->needs_prereq){
+ my $id = $self->id;
+ $CPAN::Frontend->myprint("---- Dependencies detected ".
+ "during [$id] -----\n");
+
+ for my $p (@prereq) {
+ $CPAN::Frontend->myprint(" $p\n");
+ }
+ sleep 2;
+ my $follow = 0;
+ if ($CPAN::Config->{prerequisites_policy} eq "follow") {
+ $follow = 1;
+ } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
+ require ExtUtils::MakeMaker;
+ my $answer = ExtUtils::MakeMaker::prompt(
+"Shall I follow them and prepend them to the queue
+of modules we are processing right now?", "yes");
+ $follow = $answer =~ /^\s*y/i;
+ }
+ if ($follow) {
+ CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself
+ return;
+ }
+ }
$system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
@@ -3156,6 +3272,57 @@ or
}
}
+#-> sub CPAN::Distribution::needs_prereq ;
+sub needs_prereq {
+ my($self) = @_;
+ return unless -f "Makefile"; # we cannot say much
+ my $fh = FileHandle->new("<Makefile") or
+ $CPAN::Frontend->mydie("Couldn't open Makefile: $!");
+ local($/) = "\n";
+ my($v);
+ while (<$fh>) {
+ last if ($v) = m| ^ \# \s+ ( \d+\.\d+ ) .* Revision: |x;
+ }
+
+ my(@p,@need);
+ if (1) { # probably all versions of MakeMaker ever so far
+ while (<$fh>) {
+ last if /MakeMaker post_initialize section/;
+ my($p) = m{^[\#]
+ \s+PREREQ_PM\s+=>\s+(.+)
+ }x;
+ next unless $p;
+ # warn "Found prereq expr[$p]";
+
+ while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){
+ push @p, $1;
+ }
+ last;
+ }
+ } else { # MakeMaker after a patch I suggested. Let's wait and see
+ while (<$fh>) {
+ last if /MakeMaker post_initialize section/;
+ my($p) = m|\# prerequisite (\S+).+not found|;
+ next unless $p;
+ push @p, $p;
+ }
+ }
+ for my $p (@p) {
+ unless ($CPAN::META->instance("CPAN::Module",$p)->inst_file){
+ if ($self->{'have_sponsored'}{$p}++) {
+ # We have already sponsored it and for some reason it's still
+ # not available. So we do nothing. Or what should we do?
+ } else {
+ # warn "----- Protegere $p -----";
+ push @need, $p;
+ # CPAN::Queue->jumpqueue($p);
+ # $ret++;
+ }
+ }
+ }
+ return @need;
+}
+
#-> sub CPAN::Distribution::test ;
sub test {
my($self) = @_;
@@ -3244,7 +3411,8 @@ sub install {
if $CPAN::DEBUG;
my $system = join(" ", $CPAN::Config->{'make'},
"install", $CPAN::Config->{make_install_arg});
- my($pipe) = FileHandle->new("$system 2>&1 |");
+ my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
+ my($pipe) = FileHandle->new("$system $stderr |");
my($makeout) = "";
while (<$pipe>){
$CPAN::Frontend->myprint($_);
@@ -3253,7 +3421,7 @@ sub install {
$pipe->close;
if ($?==0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{'install'} = "YES";
+ return $self->{'install'} = "YES";
} else {
$self->{'install'} = "NO";
$CPAN::Frontend->myprint(" $system -- NOT OK\n");
@@ -3342,7 +3510,6 @@ sub find_bundle_file {
### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
### my $bu = MM->catfile($where,$what);
### return $bu if -f $bu;
- my $bu;
my $manifest = MM->catfile($where,"MANIFEST");
unless (-f $manifest) {
require ExtUtils::Manifest;
@@ -3355,20 +3522,22 @@ sub find_bundle_file {
my $fh = FileHandle->new($manifest)
or Carp::croak("Couldn't open $manifest: $!");
local($/) = "\n";
+ my $what2 = $what;
+ $what2 =~ s|Bundle/||;
+ my $bu;
while (<$fh>) {
next if /^\s*\#/;
my($file) = /(\S+)/;
if ($file =~ m|\Q$what\E$|) {
$bu = $file;
- return MM->catfile($where,$bu);
- } elsif ($what =~ s|Bundle/||) { # retry if she managed to
- # have no Bundle directory
- if ($file =~ m|\Q$what\E$|) {
- $bu = $file;
- return MM->catfile($where,$bu);
- }
+ # return MM->catfile($where,$bu); # bad
+ last;
}
+ # retry if she managed to
+ # have no Bundle directory
+ $bu = $file if $file =~ m|\Q$what2\E$|;
}
+ return MM->catfile($where, $bu) if $bu;
Carp::croak("Couldn't find a Bundle file in $where");
}
@@ -3397,7 +3566,7 @@ sub rematein {
my($id) = $self->id;
Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
unless $self->inst_file || $self->{CPAN_FILE};
- my($s);
+ my($s,%fail);
for $s ($self->contains) {
my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
$s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
@@ -3408,7 +3577,26 @@ explicitly a file $s.
});
sleep 3;
}
- $CPAN::META->instance($type,$s)->$meth();
+ # possibly noisy action:
+ my $obj = $CPAN::META->instance($type,$s);
+ $obj->$meth();
+ my $success = $obj->can("uptodate") ? $obj->uptodate : 0;
+ $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
+ $fail{$s} = 1 unless $success;
+ }
+ # recap with less noise
+ if ( $meth eq "install") {
+ if (%fail) {
+ $CPAN::Frontend->myprint(qq{\nBundle summary: }.
+ qq{The following items seem to }.
+ qq{have had installation problems:\n});
+ for $s ($self->contains) {
+ $CPAN::Frontend->myprint( "$s " ) if $fail{$s};
+ }
+ $CPAN::Frontend->myprint(qq{\n});
+ } else {
+ $self->{'install'} = 'YES';
+ }
}
}
@@ -3431,7 +3619,6 @@ sub test { shift->rematein('test',@_); }
sub install {
my $self = shift;
$self->rematein('install',@_);
- $CPAN::META->delete('CPAN::Queue',$self->id);
}
#-> sub CPAN::Bundle::clean ;
sub clean { shift->rematein('clean',@_); }
@@ -3588,7 +3775,7 @@ sub cpan_file {
#-> sub CPAN::Module::cpan_version ;
sub cpan_version {
my $self = shift;
- $self->{'CPAN_VERSION'} = 'undef'
+ $self->{'CPAN_VERSION'} = 'undef'
unless defined $self->{'CPAN_VERSION'}; # I believe this is
# always a bug in the
# index and should be
@@ -3642,10 +3829,9 @@ sub get { shift->rematein('get',@_); }
sub make { shift->rematein('make') }
#-> sub CPAN::Module::test ;
sub test { shift->rematein('test') }
-#-> sub CPAN::Module::install ;
-sub install {
+#-> sub CPAN::Module::uptodate ;
+sub uptodate {
my($self) = @_;
- my($doit) = 0;
my($latest) = $self->cpan_version;
$latest ||= 0;
my($inst_file) = $self->inst_file;
@@ -3659,16 +3845,25 @@ sub install {
if ($inst_file
&&
$have >= $latest
- &&
- not exists $self->{'force_update'}
) {
- $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
- } else {
- $doit = 1;
+ return 1;
}
}
+ return;
+}
+#-> sub CPAN::Module::install ;
+sub install {
+ my($self) = @_;
+ my($doit) = 0;
+ if ($self->uptodate
+ &&
+ not exists $self->{'force_update'}
+ ) {
+ $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
+ } else {
+ $doit = 1;
+ }
$self->rematein('install') if $doit;
- $CPAN::META->delete('CPAN::Queue',$self->id);
}
#-> sub CPAN::Module::clean ;
sub clean { shift->rematein('clean') }
@@ -3731,7 +3926,7 @@ sub gzip {
$fhw->close;
return 1;
} else {
- system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
+ system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
}
}
@@ -3833,9 +4028,30 @@ sub untar {
if (MM->maybe_command($CPAN::Config->{'gzip'})
&&
MM->maybe_command($CPAN::Config->{'tar'})) {
- my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
- "$file | $CPAN::Config->{tar} xvf -";
- return system($system) == 0;
+ if ($^O =~ /win/i) { # irgggh
+ # people find the most curious tar binaries that cannot handle
+ # pipes
+ my $system = "$CPAN::Config->{'gzip'} --decompress $file";
+ if (system($system)==0) {
+ $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(
+ qq{Couldn\'t uncompress $file\n}
+ );
+ }
+ $file =~ s/\.gz$//;
+ $system = "$CPAN::Config->{tar} xvf $file";
+ if (system($system)==0) {
+ $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
+ }
+ return 1;
+ } else {
+ my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
+ "< $file | $CPAN::Config->{tar} xvf -";
+ return system($system) == 0;
+ }
} elsif ($CPAN::META->has_inst("Archive::Tar")
&&
$CPAN::META->has_inst("Compress::Zlib") ) {
@@ -3994,7 +4210,7 @@ Example:
OpenGL-0.4/COPYRIGHT
[...]
-A C<clean> command results in a
+A C<clean> command results in a
make clean
@@ -4144,7 +4360,7 @@ functionalities that are available in the shell.
=back
-=head2 Methods in the four
+=head2 Methods in the four Classes
=head2 Cache Manager
@@ -4250,7 +4466,7 @@ have an idea which part of the package may have a bug, it's sometimes
worth to give it a try and send me more specific output. You should
know that "o debug" has built-in completion support.
-=head2 Floppy, Zip, and all that Jazz
+=head2 Floppy, Zip, Offline Mode
CPAN.pm works nicely without network too. If you maintain machines
that are not networked at all, you should consider working with file:
@@ -4289,10 +4505,14 @@ defined:
make_install_arg same as make_arg for 'make install'
makepl_arg arguments passed to 'perl Makefile.PL'
pager location of external program more (or any pager)
+ scan_cache controls scanning of cache ('atstart' or 'never')
tar location of external program tar
unzip location of external program unzip
urllist arrayref to nearby CPAN sites (or equivalent locations)
wait_list arrayref to a wait server to try (See CPAN::WAIT)
+ ftp_proxy, } the three usual variables for configuring
+ http_proxy, } proxy requests. Both as CPAN::Config variables
+ no_proxy } and as environment variables configurable.
You can set and query each of these options interactively in the cpan
shell with the command set defined within the C<o conf> command:
@@ -4360,6 +4580,90 @@ Most functions in package CPAN are exported per default. The reason
for this is that the primary use is intended for the cpan shell or for
oneliners.
+=head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
+
+To populate a freshly installed perl with my favorite modules is pretty
+easiest by maintaining a private bundle definition file. To get a useful
+blueprint of a bundle definition file, the command autobundle can be used
+on the CPAN shell command line. This command writes a bundle definition
+file for all modules that re installed for the currently running perl
+interpreter. It's recommended to run this command only once and from then
+on maintain the file manually under a private name, say
+Bundle/my_bundle.pm. With a clever bundle file you can then simply say
+
+ cpan> install Bundle::my_bundle
+
+then answer a few questions and then go out.
+
+Maintaining a bundle definition file means to keep track of two things:
+dependencies and interactivity. CPAN.pm (currently) does not take into
+account dependencies between distributions, so a bundle definition file
+should specify distributions that depend on others B<after> the others.
+On the other hand, it's a bit annoying that many distributions need some
+interactive configuring. So what I try to accomplish in my private bundle
+file is to have the packages that need to be configured early in the file
+and the gentle ones later, so I can go out after a few minutes and leave
+CPAN.pm unattained.
+
+=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
+
+Thanks to Graham Barr for contributing the firewall following howto.
+
+Firewalls can be categorized into three basic types.
+
+=over
+
+=item http firewall
+
+This is where the firewall machine runs a web server and to access the
+outside world you must do it via the web server. If you set environment
+variables like http_proxy or ftp_proxy to a values beginning with http://
+or in your web browser you have to set proxy information then you know
+you are running a http firewall.
+
+To access servers outside these types of firewalls with perl (even for
+ftp) you will need to use LWP.
+
+=item ftp firewall
+
+This where the firewall machine runs a ftp server. This kind of firewall will
+only let you access ftp serves outside the firewall. This is usually done by
+connecting to the firewall with ftp, then entering a username like
+"user@outside.host.com"
+
+To access servers outside these type of firewalls with perl you
+will need to use Net::FTP.
+
+=item One way visibility
+
+I say one way visibility as these firewalls try to make themselves look
+invisible to the users inside the firewall. An FTP data connection is
+normally created by sending the remote server your IP address and then
+listening for the connection. But the remote server will not be able to
+connect to you because of the firewall. So for these types of firewall
+FTP connections need to be done in a passive mode.
+
+There are two that I can think off.
+
+=over
+
+=item SOCKS
+
+If you are using a SOCKS firewall you will need to compile perl and link
+it with the SOCKS library, this is what is normally called a ``socksified''
+perl. With this executable you will be able to connect to servers outside
+the firewall as if it is not there.
+
+=item IP Masquerade
+
+This is the firewall implemented in the Linux kernel, it allows you to
+hide a complete network behind one IP address. With this firewall no
+special compiling is need as you can access hosts directly.
+
+=back
+
+=back
+
=head1 BUGS
We should give coverage for _all_ of the CPAN and not just the PAUSE
diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm
index ff1f723d5e..14ef54169b 100644
--- a/lib/CPAN/FirstTime.pm
+++ b/lib/CPAN/FirstTime.pm
@@ -16,7 +16,7 @@ use FileHandle ();
use File::Basename ();
use File::Path ();
use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.30 $, 10;
+$VERSION = substr q$Revision: 1.33 $, 10;
=head1 NAME
@@ -37,7 +37,9 @@ file. Nothing special.
sub init {
my($configpm) = @_;
use Config;
- require CPAN::Nox;
+ unless ($CPAN::VERSION) {
+ require CPAN::Nox;
+ }
eval {require CPAN::Config;};
$CPAN::Config ||= {};
local($/) = "\n";
@@ -45,7 +47,7 @@ sub init {
local($|) = 1;
my($ans,$default,$local,$cont,$url,$expected_size);
-
+
#
# Files, directories
#
@@ -120,7 +122,7 @@ First of all, I\'d like to create this directory. Where?
}
}
$CPAN::Config->{cpan_home} = $ans;
-
+
print qq{
If you want, I can keep the source files after a build in the cpan
@@ -151,6 +153,40 @@ with all the intermediate files?
# XXX This the time when we refetch the index files (in days)
$CPAN::Config->{'index_expire'} = 1;
+ print qq{
+
+By default, each time the CPAN module is started, cache scanning
+is performed to keep the cache size in sync. To prevent from this,
+disable the cache scanning with 'never'.
+
+};
+
+ $default = $CPAN::Config->{scan_cache} || 'atstart';
+ do {
+ $ans = prompt("Perform cache scanning (atstart or never)?", $default);
+ } while ($ans ne 'atstart' && $ans ne 'never');
+ $CPAN::Config->{scan_cache} = $ans;
+
+ #
+ # prerequisites_policy
+ # Do we follow PREREQ_PM?
+ #
+ print qq{
+
+The CPAN module can detect when a module that which you are trying to
+build depends on prerequisites. If this happens, it can build the
+prerequisites for you automatically ('follow'), ask you for
+confirmation ('ask'), or just ignore them ('ignore'). Please set your
+policy to one of the three values.
+
+};
+
+ $default = $CPAN::Config->{prerequisites_policy} || 'follow';
+ do {
+ $ans = prompt("Perform cache scanning (follow, ask or ignore)?", $default);
+ } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
+ $CPAN::Config->{prerequisites_policy} = $ans;
+
#
# External programs
#
@@ -329,6 +365,32 @@ sub find_exe {
}
}
+sub picklist {
+ my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
+ $default ||= '';
+
+ my ($item, $i);
+ for $item (@$items) {
+ printf "(%d) %s\n", ++$i, $item;
+ }
+
+ my @nums;
+ while (1) {
+ my $num = prompt($prompt,$default);
+ @nums = split (' ', $num);
+ (warn "invalid items entered, try again\n"), next
+ if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
+ if ($require_nonempty) {
+ (warn "$empty_warning\n"), next
+ unless @nums;
+ }
+ last;
+ }
+ print "\n";
+ for (@nums) { $_-- }
+ @{$items}[@nums];
+}
+
sub read_mirrored_by {
my($local) = @_;
my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
@@ -341,6 +403,7 @@ sub read_mirrored_by {
/location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
($continent, $country) = @location[-1,-2];
$continent =~ s/\s\(.*//;
+ $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
next unless $host && $dst && $continent && $country;
$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
@@ -349,93 +412,97 @@ sub read_mirrored_by {
}
$fh->close;
$CPAN::Config->{urllist} ||= [];
- if ($expected_size = @{$CPAN::Config->{urllist}}) {
- for $url (@{$CPAN::Config->{urllist}}) {
- # sanity check, scheme+colon, not "q" there:
- next unless $url =~ /^\w+:\/./;
- $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
- }
+ my(@previous_urls);
+ if (@previous_urls = @{$CPAN::Config->{urllist}}) {
$CPAN::Config->{urllist} = [];
- } else {
- $expected_size = 6;
}
-
+
print qq{
-Now we need to know, where your favorite CPAN sites are located. Push
+Now we need to know where your favorite CPAN sites are located. Push
a few sites onto the array (just in case the first on the array won\'t
work). If you are mirroring CPAN to your local workstation, specify a
file: URL.
-You can enter the number in front of the URL on the next screen, a
-file:, ftp: or http: URL, or "q" to finish selecting.
+First, pick a nearby continent and country (you can pick several of
+each, separated by spaces, or none if you just want to keep your
+existing selections). Then, you will be presented with a list of URLs
+of CPAN mirrors in the countries you selected, along with previously
+selected URLs. Select some of those URLs, or just keep the old list.
+Finally, you will be prompted for any extra URLs -- file:, ftp:, or
+http: -- that host a CPAN mirror.
};
- $ans = prompt("Press RETURN to continue");
- my $other;
- $ans = $other = "";
- my(%seen);
-
- my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
- while () {
- my(@valid,$previous_best);
- my $fh = FileHandle->new;
- $fh->open($pipe);
- {
- my($cont,$country,$url,$item);
- my(@cont) = sort keys %all;
- for $cont (@cont) {
- $fh->print(" $cont\n");
- for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
- for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
- my $t = sprintf(
- " %-16s (%2d) %s\n",
- $country,
- ++$item,
- $url
- );
- if ($cont =~ /^\[/) {
- $previous_best ||= $item;
- }
- push @valid, $all{$cont}{$country}{$url};
- $fh->print($t);
- }
- }
- }
- }
- $fh->close;
- $previous_best ||= "";
- $default =
- @{$CPAN::Config->{urllist}} >=
- $expected_size ? "q" : $previous_best;
- $ans = prompt(
- "\nSelect an$other ftp or file URL or a number (q to finish)",
- $default
- );
- my $sel;
- if ($ans =~ /^\d/) {
- my $this = $valid[$ans-1];
- my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
- push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
- delete $all{$con}{$cou}{$url};
- # print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
- } elsif ($ans =~ /^q/i) {
- last;
- } else {
- $ans =~ s|/?$|/|; # has to end with one slash
- $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
- if ($ans =~ /^\w+:\/./) {
- push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
- } else {
- print qq{"$ans" doesn\'t look like an URL at first sight.
-I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
-later and report a bug in my Makefile.PL to me (andreas koenig).
-Thanks.\n};
- }
- }
- $other ||= "other";
+ my (@cont, $cont, %cont, @countries, @urls, %seen);
+ my $no_previous_warn =
+ "Sorry! since you don't have any existing picks, you must make a\n" .
+ "geographic selection.";
+ @cont = picklist([sort keys %all],
+ "Select your continent (or several nearby continents)",
+ '',
+ ! @previous_urls,
+ $no_previous_warn);
+
+
+ foreach $cont (@cont) {
+ my @c = sort keys %{$all{$cont}};
+ @cont{@c} = map ($cont, 0..$#c);
+ @c = map ("$_ ($cont)", @c) if @cont > 1;
+ push (@countries, @c);
}
+
+ if (@countries) {
+ @countries = picklist (\@countries,
+ "Select your country (or several nearby countries)",
+ '',
+ ! @previous_urls,
+ $no_previous_warn);
+ %seen = map (($_ => 1), @previous_urls);
+ # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
+ foreach $country (@countries) {
+ (my $bare_country = $country) =~ s/ \(.*\)//;
+ my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
+ @u = grep (! $seen{$_}, @u);
+ @u = map ("$_ ($bare_country)", @u)
+ if @countries > 1;
+ push (@urls, @u);
+ }
+ }
+ push (@urls, map ("$_ (previous pick)", @previous_urls));
+ my $prompt = "Select as many URLs as you like";
+ if (@previous_urls) {
+ $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
+ (scalar @urls));
+ $prompt .= "\n(or just hit RETURN to keep your previous picks)";
+ }
+
+ @urls = picklist (\@urls, $prompt, $default);
+ foreach (@urls) { s/ \(.*\)//; }
+ %seen = map (($_ => 1), @urls);
+
+ do {
+ $ans = prompt ("Enter another URL or RETURN to quit:", "");
+
+ if ($ans) {
+ $ans =~ s|/?$|/|; # has to end with one slash
+ $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
+ if ($ans =~ /^\w+:\/./) {
+ push @urls, $ans
+ unless $seen{$ans};
+ }
+ else {
+ print qq{"$ans" doesn\'t look like an URL at first sight.
+I\'ll ignore it for now. You can add it to $INC{'CPAN/MyConfig.pm'}
+later if you\'re sure it\'s right.\n};
+ }
+ }
+ } while $ans;
+
+ push @{$CPAN::Config->{urllist}}, @urls;
+ # xxx delete or comment these out when you're happy that it works
+ print "New set of picks:\n";
+ map { print " $_\n" } @{$CPAN::Config->{urllist}};
}
1;
diff --git a/lib/Carp.pm b/lib/Carp.pm
index 6bac36446a..c6545650ef 100644
--- a/lib/Carp.pm
+++ b/lib/Carp.pm
@@ -35,7 +35,7 @@ and a carp as a cluck across I<all> modules. In other words, force a
detailed stack trace to be given. This can be very helpful when trying
to understand why, or from where, a warning or error is being generated.
-This feature is enabled by 'importing' the non-existant symbol
+This feature is enabled by 'importing' the non-existent symbol
'verbose'. You would typically enable it by saying
perl -MCarp=verbose script.pl
diff --git a/lib/Cwd.pm b/lib/Cwd.pm
index 72937e25d8..5c10e8e168 100644
--- a/lib/Cwd.pm
+++ b/lib/Cwd.pm
@@ -32,7 +32,7 @@ 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 algoritm as
+absolute pathname for that argument. It uses the same algorithm as
getcwd(). (actually getcwd() is abs_path("."))
The fastcwd() function looks the same as getcwd(), but runs faster.
diff --git a/lib/Exporter.pm b/lib/Exporter.pm
index a66079a142..bc07e9b2be 100644
--- a/lib/Exporter.pm
+++ b/lib/Exporter.pm
@@ -2,226 +2,59 @@ package Exporter;
require 5.001;
-#
-# We go to a lot of trouble not to 'require Carp' at file scope,
-# because Carp requires Exporter, and something has to give.
-#
-
$ExportLevel = 0;
-$Verbose = 0 unless $Verbose;
-
-sub export {
-
- # First make import warnings look like they're coming from the "use".
- local $SIG{__WARN__} = sub {
- my $text = shift;
- if ($text =~ s/ at \S*Exporter.pm line \d+.*\n//) {
- require Carp;
- local $Carp::CarpLevel = 1; # ignore package calling us too.
- Carp::carp($text);
- }
- else {
- warn $text;
- }
- };
- local $SIG{__DIE__} = sub {
- require Carp;
- local $Carp::CarpLevel = 1; # ignore package calling us too.
- Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
- if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
- };
-
- my($pkg, $callpkg, @imports) = @_;
- my($type, $sym, $oops);
- *exports = *{"${pkg}::EXPORT"};
-
- if (@imports) {
- if (!%exports) {
- grep(s/^&//, @exports);
- @exports{@exports} = (1) x @exports;
- my $ok = \@{"${pkg}::EXPORT_OK"};
- if (@$ok) {
- grep(s/^&//, @$ok);
- @exports{@$ok} = (1) x @$ok;
- }
- }
-
- if ($imports[0] =~ m#^[/!:]#){
- my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
- my $tagdata;
- my %imports;
- my($remove, $spec, @names, @allexports);
- # negated first item implies starting with default set:
- unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
- foreach $spec (@imports){
- $remove = $spec =~ s/^!//;
-
- if ($spec =~ s/^://){
- if ($spec eq 'DEFAULT'){
- @names = @exports;
- }
- elsif ($tagdata = $tagsref->{$spec}) {
- @names = @$tagdata;
- }
- else {
- warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
- ++$oops;
- next;
- }
- }
- elsif ($spec =~ m:^/(.*)/$:){
- my $patn = $1;
- @allexports = keys %exports unless @allexports; # only do keys once
- @names = grep(/$patn/, @allexports); # not anchored by default
- }
- else {
- @names = ($spec); # is a normal symbol name
- }
-
- warn "Import ".($remove ? "del":"add").": @names "
- if $Verbose;
-
- if ($remove) {
- foreach $sym (@names) { delete $imports{$sym} }
- }
- else {
- @imports{@names} = (1) x @names;
- }
- }
- @imports = keys %imports;
- }
-
- foreach $sym (@imports) {
- if (!$exports{$sym}) {
- if ($sym =~ m/^\d/) {
- $pkg->require_version($sym);
- # If the version number was the only thing specified
- # then we should act as if nothing was specified:
- if (@imports == 1) {
- @imports = @exports;
- last;
- }
- # We need a way to emulate 'use Foo ()' but still
- # allow an easy version check: "use Foo 1.23, ''";
- if (@imports == 2 and !$imports[1]) {
- @imports = ();
- last;
- }
- } elsif ($sym !~ s/^&// || !$exports{$sym}) {
- require Carp;
- Carp::carp(qq["$sym" is not exported by the $pkg module]);
- $oops++;
- }
- }
- }
- if ($oops) {
- require Carp;
- Carp::croak("Can't continue after import errors");
- }
- }
- else {
- @imports = @exports;
- }
+$Verbose ||= 0;
- *fail = *{"${pkg}::EXPORT_FAIL"};
- if (@fail) {
- if (!%fail) {
- # Build cache of symbols. Optimise the lookup by adding
- # barewords twice... both with and without a leading &.
- # (Technique could be applied to %exports cache at cost of memory)
- my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
- warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
- @fail{@expanded} = (1) x @expanded;
- }
- my @failed;
- foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
- if (@failed) {
- @failed = $pkg->export_fail(@failed);
- foreach $sym (@failed) {
- require Carp;
- Carp::carp(qq["$sym" is not implemented by the $pkg module ],
- "on this architecture");
- }
- if (@failed) {
- require Carp;
- Carp::croak("Can't continue after import errors");
- }
- }
- }
-
- warn "Importing into $callpkg from $pkg: ",
- join(", ",sort @imports) if $Verbose;
-
- foreach $sym (@imports) {
- # shortcut for the common case of no type character
- (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
- unless $sym =~ s/^(\W)//;
- $type = $1;
- *{"${callpkg}::$sym"} =
- $type eq '&' ? \&{"${pkg}::$sym"} :
- $type eq '$' ? \${"${pkg}::$sym"} :
- $type eq '@' ? \@{"${pkg}::$sym"} :
- $type eq '%' ? \%{"${pkg}::$sym"} :
- $type eq '*' ? *{"${pkg}::$sym"} :
- do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
- }
-}
-
-sub export_to_level
-{
- my $pkg = shift;
- my $level = shift;
- my $callpkg = caller($level);
- $pkg->export($callpkg, @_);
+sub export_to_level {
+ require Exporter::Heavy;
+ goto &heavy_export_to_level;
}
-sub import {
- my $pkg = shift;
- my $callpkg = caller($ExportLevel);
- export $pkg, $callpkg, @_;
+sub export {
+ require Exporter::Heavy;
+ goto &heavy_export;
}
-
-
-# Utility functions
-
-sub _push_tags {
- my($pkg, $var, $syms) = @_;
- my $nontag;
- *export_tags = \%{"${pkg}::EXPORT_TAGS"};
- push(@{"${pkg}::$var"},
- map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
- (@$syms) ? @$syms : keys %export_tags);
- if ($nontag and $^W) {
- # This may change to a die one day
- require Carp;
- Carp::carp("Some names are not tags");
- }
+sub export_tags {
+ require Exporter::Heavy;
+ _push_tags((caller)[0], "EXPORT", \@_);
}
-sub export_tags { _push_tags((caller)[0], "EXPORT", \@_) }
-sub export_ok_tags { _push_tags((caller)[0], "EXPORT_OK", \@_) }
-
-
-# Default methods
-
-sub export_fail {
- my $self = shift;
- @_;
+sub export_ok_tags {
+ require Exporter::Heavy;
+ _push_tags((caller)[0], "EXPORT_OK", \@_);
}
-sub require_version {
- my($self, $wanted) = @_;
- my $pkg = ref $self || $self;
- my $version = ${"${pkg}::VERSION"};
- if (!$version or $version < $wanted) {
- $version ||= "(undef)";
- my $file = $INC{"$pkg.pm"};
- $file &&= " ($file)";
- require Carp;
- Carp::croak("$pkg $wanted required--this is only version $version$file")
+sub import {
+ my $pkg = shift;
+ my $callpkg = caller($ExportLevel);
+ *exports = *{"$pkg\::EXPORT"};
+ # We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
+ *fail = *{"$pkg\::EXPORT_FAIL"};
+ return export $pkg, $callpkg, @_
+ if $Verbose or $Debug or @fail > 1;
+ my $args = @_ or @_ = @exports;
+
+ if ($args and not %exports) {
+ foreach my $sym (@exports, @{"$pkg\::EXPORT_OK"}) {
+ $sym =~ s/^&//;
+ $exports{$sym} = 1;
}
- $version;
+ }
+ if ($Verbose or $Debug
+ or grep {/\W/ or $args and not exists $exports{$_}
+ or @fail and $_ eq $fail[0]
+ or (@{"$pkg\::EXPORT_OK"}
+ and $_ eq ${"$pkg\::EXPORT_OK"}[0])} @_) {
+ return export $pkg, $callpkg, ($args ? @_ : ());
+ }
+ #local $SIG{__WARN__} = sub {require Carp; goto &Carp::carp};
+ local $SIG{__WARN__} =
+ sub {require Carp; local $Carp::CarpLevel = 1; &Carp::carp};
+ foreach $sym (@_) {
+ # shortcut for the common case of no type character
+ *{"$callpkg\::$sym"} = \&{"$pkg\::$sym"};
+ }
}
1;
diff --git a/lib/Exporter/Heavy.pm b/lib/Exporter/Heavy.pm
new file mode 100644
index 0000000000..f7e95e2b1b
--- /dev/null
+++ b/lib/Exporter/Heavy.pm
@@ -0,0 +1,210 @@
+package Exporter;
+
+#
+# We go to a lot of trouble not to 'require Carp' at file scope,
+# because Carp requires Exporter, and something has to give.
+#
+
+sub heavy_export {
+
+ # First make import warnings look like they're coming from the "use".
+ local $SIG{__WARN__} = sub {
+ my $text = shift;
+ if ($text =~ s/ at \S*Exporter\S*.pm line \d+.*\n//) {
+ require Carp;
+ local $Carp::CarpLevel = 1; # ignore package calling us too.
+ Carp::carp($text);
+ }
+ else {
+ warn $text;
+ }
+ };
+ local $SIG{__DIE__} = sub {
+ require Carp;
+ local $Carp::CarpLevel = 1; # ignore package calling us too.
+ Carp::croak("$_[0]Illegal null symbol in \@${1}::EXPORT")
+ if $_[0] =~ /^Unable to create sub named "(.*?)::"/;
+ };
+
+ my($pkg, $callpkg, @imports) = @_;
+ my($type, $sym, $oops);
+ *exports = *{"${pkg}::EXPORT"};
+
+ if (@imports) {
+ if (!%exports) {
+ grep(s/^&//, @exports);
+ @exports{@exports} = (1) x @exports;
+ my $ok = \@{"${pkg}::EXPORT_OK"};
+ if (@$ok) {
+ grep(s/^&//, @$ok);
+ @exports{@$ok} = (1) x @$ok;
+ }
+ }
+
+ if ($imports[0] =~ m#^[/!:]#){
+ my $tagsref = \%{"${pkg}::EXPORT_TAGS"};
+ my $tagdata;
+ my %imports;
+ my($remove, $spec, @names, @allexports);
+ # negated first item implies starting with default set:
+ unshift @imports, ':DEFAULT' if $imports[0] =~ m/^!/;
+ foreach $spec (@imports){
+ $remove = $spec =~ s/^!//;
+
+ if ($spec =~ s/^://){
+ if ($spec eq 'DEFAULT'){
+ @names = @exports;
+ }
+ elsif ($tagdata = $tagsref->{$spec}) {
+ @names = @$tagdata;
+ }
+ else {
+ warn qq["$spec" is not defined in %${pkg}::EXPORT_TAGS];
+ ++$oops;
+ next;
+ }
+ }
+ elsif ($spec =~ m:^/(.*)/$:){
+ my $patn = $1;
+ @allexports = keys %exports unless @allexports; # only do keys once
+ @names = grep(/$patn/, @allexports); # not anchored by default
+ }
+ else {
+ @names = ($spec); # is a normal symbol name
+ }
+
+ warn "Import ".($remove ? "del":"add").": @names "
+ if $Verbose;
+
+ if ($remove) {
+ foreach $sym (@names) { delete $imports{$sym} }
+ }
+ else {
+ @imports{@names} = (1) x @names;
+ }
+ }
+ @imports = keys %imports;
+ }
+
+ foreach $sym (@imports) {
+ if (!$exports{$sym}) {
+ if ($sym =~ m/^\d/) {
+ $pkg->require_version($sym);
+ # If the version number was the only thing specified
+ # then we should act as if nothing was specified:
+ if (@imports == 1) {
+ @imports = @exports;
+ last;
+ }
+ # We need a way to emulate 'use Foo ()' but still
+ # allow an easy version check: "use Foo 1.23, ''";
+ if (@imports == 2 and !$imports[1]) {
+ @imports = ();
+ last;
+ }
+ } elsif ($sym !~ s/^&// || !$exports{$sym}) {
+ require Carp;
+ Carp::carp(qq["$sym" is not exported by the $pkg module]);
+ $oops++;
+ }
+ }
+ }
+ if ($oops) {
+ require Carp;
+ Carp::croak("Can't continue after import errors");
+ }
+ }
+ else {
+ @imports = @exports;
+ }
+
+ *fail = *{"${pkg}::EXPORT_FAIL"};
+ if (@fail) {
+ if (!%fail) {
+ # Build cache of symbols. Optimise the lookup by adding
+ # barewords twice... both with and without a leading &.
+ # (Technique could be applied to %exports cache at cost of memory)
+ my @expanded = map { /^\w/ ? ($_, '&'.$_) : $_ } @fail;
+ warn "${pkg}::EXPORT_FAIL cached: @expanded" if $Verbose;
+ @fail{@expanded} = (1) x @expanded;
+ }
+ my @failed;
+ foreach $sym (@imports) { push(@failed, $sym) if $fail{$sym} }
+ if (@failed) {
+ @failed = $pkg->export_fail(@failed);
+ foreach $sym (@failed) {
+ require Carp;
+ Carp::carp(qq["$sym" is not implemented by the $pkg module ],
+ "on this architecture");
+ }
+ if (@failed) {
+ require Carp;
+ Carp::croak("Can't continue after import errors");
+ }
+ }
+ }
+
+ warn "Importing into $callpkg from $pkg: ",
+ join(", ",sort @imports) if $Verbose;
+
+ foreach $sym (@imports) {
+ # shortcut for the common case of no type character
+ (*{"${callpkg}::$sym"} = \&{"${pkg}::$sym"}, next)
+ unless $sym =~ s/^(\W)//;
+ $type = $1;
+ *{"${callpkg}::$sym"} =
+ $type eq '&' ? \&{"${pkg}::$sym"} :
+ $type eq '$' ? \${"${pkg}::$sym"} :
+ $type eq '@' ? \@{"${pkg}::$sym"} :
+ $type eq '%' ? \%{"${pkg}::$sym"} :
+ $type eq '*' ? *{"${pkg}::$sym"} :
+ do { require Carp; Carp::croak("Can't export symbol: $type$sym") };
+ }
+}
+
+sub heavy_export_to_level
+{
+ my $pkg = shift;
+ my $level = shift;
+ my $callpkg = caller($level);
+ $pkg->export($callpkg, @_);
+}
+
+# Utility functions
+
+sub _push_tags {
+ my($pkg, $var, $syms) = @_;
+ my $nontag;
+ *export_tags = \%{"${pkg}::EXPORT_TAGS"};
+ push(@{"${pkg}::$var"},
+ map { $export_tags{$_} ? @{$export_tags{$_}} : scalar(++$nontag,$_) }
+ (@$syms) ? @$syms : keys %export_tags);
+ if ($nontag and $^W) {
+ # This may change to a die one day
+ require Carp;
+ Carp::carp("Some names are not tags");
+ }
+}
+
+# Default methods
+
+sub export_fail {
+ my $self = shift;
+ @_;
+}
+
+sub require_version {
+ my($self, $wanted) = @_;
+ my $pkg = ref $self || $self;
+ my $version = ${"${pkg}::VERSION"};
+ if (!$version or $version < $wanted) {
+ $version ||= "(undef)";
+ my $file = $INC{"$pkg.pm"};
+ $file &&= " ($file)";
+ require Carp;
+ Carp::croak("$pkg $wanted required--this is only version $version$file")
+ }
+ $version;
+}
+
+1;
diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index 225ecab4b6..a5c91feb54 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -148,10 +148,17 @@ sub rmtree {
my($roots, $verbose, $safe) = @_;
my(@files);
my($count) = 0;
- $roots = [$roots] unless ref $roots;
$verbose ||= 0;
$safe ||= 0;
+ if ( defined($roots) && length($roots) ) {
+ $roots = [$roots] unless ref $roots;
+ }
+ else {
+ carp "No root path(s) specified\n";
+ return 0;
+ }
+
my($root);
foreach $root (@{$roots}) {
$root =~ s#/$##;
diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm
index a73f68a8c4..311d953721 100644
--- a/lib/SelfLoader.pm
+++ b/lib/SelfLoader.pm
@@ -133,7 +133,7 @@ is available for reading via the filehandle FOOBAR::DATA,
where FOOBAR is the name of the current package when the C<__DATA__>
token is reached. This works just the same as C<__END__> does in
package 'main', but for other modules data after C<__END__> is not
-automatically retreivable , whereas data after C<__DATA__> is.
+automatically retrievable, whereas data after C<__DATA__> is.
The C<__DATA__> token is not recognized in versions of perl prior to
5.001m.
@@ -203,7 +203,7 @@ There is no need to inherit from the B<SelfLoader>.
The B<SelfLoader> works similarly to the AutoLoader, but picks up the
subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
-There is a maintainance gain in not needing to run AutoSplit on the module
+There is a maintenance gain in not needing to run AutoSplit on the module
at installation, and a runtime gain in not needing to keep opening and
closing files to load subs. There is a runtime loss in needing
to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and
diff --git a/lib/Symbol.pm b/lib/Symbol.pm
index 5ed6b2667b..a842c1cd7b 100644
--- a/lib/Symbol.pm
+++ b/lib/Symbol.pm
@@ -46,7 +46,7 @@ C<Symbol::qualify> turns unqualified symbol names into qualified
variable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a
second parameter, C<qualify> uses it as the default package;
otherwise, it uses the package of its caller. Regardless, global
-variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with
+variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with
"main::".
Qualification applies only to symbol names (strings). References are
diff --git a/lib/Test.pm b/lib/Test.pm
index daf6e4e127..00b32368d8 100644
--- a/lib/Test.pm
+++ b/lib/Test.pm
@@ -220,7 +220,7 @@ triggered at the end of a test run. C<onfail> is passed an array ref
of hash refs that describe each test failure. Each hash will contain
at least the following fields: C<package>, C<repetition>, and
C<result>. (The file, line, and test number are not included because
-their correspondance to a particular test is tenuous.) If the test
+their correspondence to a particular test is tenuous.) If the test
had an expected value or a diagnostic string, these will also be
included.
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index f74e7352e4..648ea1281b 100755
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -4,7 +4,7 @@ package diagnostics;
diagnostics - Perl compiler pragma to force verbose warning diagnostics
-splain - standalone program to do the same thing
+splain - stand-alone program to do the same thing
=head1 SYNOPSIS
@@ -27,7 +27,7 @@ Aa a program:
=head2 The C<diagnostics> Pragma
This module extends the terse diagnostics normally emitted by both the
-perl compiler and the perl interpeter, augmenting them with the more
+perl compiler and the perl interpreter, augmenting them with the more
explicative and endearing descriptions found in L<perldiag>. Like the
other pragmata, it affects the compilation phase of your program rather
than merely the execution phase.
@@ -41,9 +41,9 @@ that this I<does> enable perl's B<-w> flag.) Your whole
compilation will then be subject(ed :-) to the enhanced diagnostics.
These still go out B<STDERR>.
-Due to the interaction between runtime and compiletime issues,
+Due to the interaction between runtime and compile time issues,
and because it's probably not a very good idea anyway,
-you may not use C<no diagnostics> to turn them off at compiletime.
+you may not use C<no diagnostics> to turn them off at compile time.
However, you may control there behaviour at runtime using the
disable() and enable() methods to turn them off and on respectively.
@@ -66,7 +66,7 @@ Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
=head1 EXAMPLES
The following file is certain to trigger a few errors at both
-runtime and compiletime:
+runtime and compile time:
use diagnostics;
print NOWHERE "nothing\n";
diff --git a/lib/overload.pm b/lib/overload.pm
index 81d9a120ba..6508ad1cf4 100644
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -276,7 +276,7 @@ value of their arguments, and may leave it as is. The result is going
to be assigned to the value in the left-hand-side if different from
this value.
-This allows for the same method to be used as averloaded C<+=> and
+This allows for the same method to be used as overloaded C<+=> and
C<+>. Note that this is I<allowed>, but not recommended, since by the
semantic of L<"Fallback"> Perl will call the method for C<+> anyway,
if C<+=> is not overloaded.
@@ -285,7 +285,7 @@ if C<+=> is not overloaded.
B<Warning.> Due to the presense of assignment versions of operations,
routines which may be called in assignment context may create
-self-referencial structures. Currently Perl will not free self-referential
+self-referential structures. Currently Perl will not free self-referential
structures until cycles are C<explicitly> broken. You may get problems
when traversing your structures too.
@@ -558,7 +558,7 @@ C<'='> was overloaded with C<\&clone>.
=back
-Same behaviour is triggered by C<$b = $a++>, which is consider a synonim for
+Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for
C<$b = $a; ++$a>.
=head1 MAGIC AUTOGENERATION
@@ -777,7 +777,7 @@ There is no size penalty for data if overload is not used. The only
size penalty if overload is used in some package is that I<all> the
packages acquire a magic during the next C<bless>ing into the
package. This magic is three-words-long for packages without
-overloading, and carries the cache tabel if the package is overloaded.
+overloading, and carries the cache table if the package is overloaded.
Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
carried out before any operation that can imply an assignment to the
@@ -789,8 +789,8 @@ to be changed are constant (but this is not enforced).
=head1 Metaphor clash
-One may wonder why the semantic of overloaded C<=> is so counterintuive.
-If it I<looks> counterintuive to you, you are subject to a metaphor
+One may wonder why the semantic of overloaded C<=> is so counter intuitive.
+If it I<looks> counter intuitive to you, you are subject to a metaphor
clash.
Here is a Perl object metaphor:
@@ -1025,7 +1025,7 @@ Put this in F<symbolic.pm> in your Perl library directory:
This module is very unusual as overloaded modules go: it does not
provide any usual overloaded operators, instead it provides the L<Last
Resort> operator C<nomethod>. In this example the corresponding
-subroutine returns an object which encupsulates operations done over
+subroutine returns an object which encapsulates operations done over
the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
symbolic 3> contains C<['+', 2, ['n', 3]]>.
@@ -1112,7 +1112,7 @@ compare an object to 0. In fact, it is easier to write a numeric
conversion routine.
Here is the text of F<symbolic.pm> with such a routine added (and
-slightly modifed str()):
+slightly modified str()):
package symbolic; # Primitive symbolic calculator
use overload
@@ -1151,7 +1151,7 @@ slightly modifed str()):
}
All the work of numeric conversion is done in %subr and num(). Of
-course, %subr is not complete, it contains only operators used in teh
+course, %subr is not complete, it contains only operators used in the
example below. Here is the extra-credit question: why do we need an
explicit recursion in num()? (Answer is at the end of this section.)
@@ -1181,7 +1181,7 @@ mutator methods (C<++>, C<-=> and so on), does not do deep copying
(not required without mutators!), and implements only those arithmetic
operations which are used in the example.
-To implement most arithmetic operattions is easy, one should just use
+To implement most arithmetic operations is easy, one should just use
the tables of operations, and change the code which fills %subr to
my %subr = ( 'n' => sub {$_[0]} );
@@ -1259,8 +1259,8 @@ the argument of num().
If you wonder why defaults for conversion are different for str() and
num(), note how easy it was to write the symbolic calculator. This
simplicity is due to an appropriate choice of defaults. One extra
-note: due to teh explicit recursion num() is more fragile than sym():
-we need to explicitly check for the type of $a and $b. If componets
+note: due to the explicit recursion num() is more fragile than sym():
+we need to explicitly check for the type of $a and $b. If components
$a and $b happen to be of some related type, this may lead to problems.
=head2 I<Really> symbolic calculator
diff --git a/makedepend.SH b/makedepend.SH
index 74c3ecb817..0f32da33c6 100755
--- a/makedepend.SH
+++ b/makedepend.SH
@@ -67,6 +67,7 @@ if test -f Makefile; then
# to be out of date. I don't know if OS/2 has touch, so do this:
case "$osname" in
os2) ;;
+ netbsd) ;;
*) $touch $firstmakefile ;;
esac
fi
@@ -101,7 +102,11 @@ for file in `$cat .clist`; do
if [ "$osname" = uwin ]; then
uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
else
- uwinfix=
+ if [ "$osname" = os2 ]; then
+ uwinfix="-e s,\\\\\\\\,/,g"
+ else
+ uwinfix=
+ fi
fi
case "$file" in
*.c) filebase=`basename $file .c` ;;
diff --git a/os2/Changes b/os2/Changes
index f7251376ec..910ec467f4 100644
--- a/os2/Changes
+++ b/os2/Changes
@@ -220,6 +220,9 @@ after 5.005_53:
pre-fixpak22 configuration (calling getpriority() on
non-existing process triggers a system-wide bug).
+
+ PrfDB was using a bug in processing XSUBs returning U32.
+
Variable $OS2::emx_rev implemented (string and numberic values
are the same as C variables _emx_rev and _emx_vprt).
Variable $OS2::emx_env implemented (same as C variable _emx_env).
@@ -287,3 +290,9 @@ after 5.005_53:
it is incremented by the number of messages retrieved.
Dies with "QUITing..." if WM_QUIT message is obtained.
+after 5.005_54:
+ Opening pipes from/to processes could fail if (un)appropriate
+ combination of STDIN/STDOUT was closed.
+
+ If the only shell-metachars of a command are ' 2>&1' at the
+ end of a command, it is executed without calling the external shell.
diff --git a/os2/OS2/PrfDB/PrfDB.xs b/os2/OS2/PrfDB/PrfDB.xs
index 13123200a2..2ba836c183 100644
--- a/os2/OS2/PrfDB/PrfDB.xs
+++ b/os2/OS2/PrfDB/PrfDB.xs
@@ -33,7 +33,7 @@ Prf_Get(HINI hini, PSZ app, PSZ key) {
return sv;
}
-U32
+I32
Prf_GetLength(HINI hini, PSZ app, PSZ key) {
U32 len;
@@ -110,7 +110,7 @@ Prf_Set(hini, app, key, s, l = (SvPOK(ST(3)) ? SvCUR(ST(3)): -1))
PSZ s;
ULONG l;
-U32
+I32
Prf_GetLength(hini, app, key)
HINI hini;
PSZ app;
diff --git a/os2/os2.c b/os2/os2.c
index 6b814dec39..7084074344 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -459,11 +459,12 @@ static ULONG os2_mytype;
/* global PL_Argv[] contains arguments. */
int
-do_spawn_ve(really, flag, execf, inicmd)
+do_spawn_ve(really, flag, execf, inicmd, addflag)
SV *really;
U32 flag;
U32 execf;
char *inicmd;
+U32 addflag;
{
dTHR;
int trueflag = flag;
@@ -476,6 +477,7 @@ char *inicmd;
char **argsp = fargs;
char nargs = 4;
int force_shell;
+ int new_stderr = -1, nostderr = 0, fl_stderr;
STRLEN n_a;
if (flag == P_WAIT)
@@ -558,6 +560,24 @@ char *inicmd;
}
}
+ if (addflag) {
+ addflag = 0;
+ new_stderr = dup(2); /* Preserve stderr */
+ if (new_stderr == -1) {
+ if (errno == EBADF)
+ nostderr = 1;
+ else {
+ rc = -1;
+ goto finish;
+ }
+ } else
+ fl_stderr = fcntl(2, F_GETFD);
+ rc = dup2(1,2);
+ if (rc == -1)
+ goto finish;
+ fcntl(new_stderr, F_SETFD, FD_CLOEXEC);
+ }
+
#if 0
rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
#else
@@ -593,7 +613,9 @@ char *inicmd;
if (l >= sizeof scrbuf) {
Safefree(scr);
longbuf:
- croak("Size of scriptname too big: %d", l);
+ warn("Size of scriptname too big: %d", l);
+ rc = -1;
+ goto finish;
}
strcpy(scrbuf, scr);
Safefree(scr);
@@ -781,6 +803,13 @@ char *inicmd;
&& ((trueflag & 0xFF) == P_WAIT))
rc = 255 << 8; /* Emulate the fork(). */
+ finish:
+ if (new_stderr != -1) { /* How can we use error codes? */
+ dup2(new_stderr, 2);
+ close(new_stderr);
+ fcntl(2, F_SETFD, fl_stderr);
+ } else if (nostderr)
+ close(2);
return rc;
}
@@ -815,7 +844,7 @@ register SV **sp;
}
*a = Nullch;
- rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL);
+ rc = do_spawn_ve(really, flag, EXECF_SPAWN, NULL, 0);
} else
rc = -1;
do_execfree();
@@ -832,7 +861,7 @@ int execf;
register char *s;
char flags[10];
char *shell, *copt, *news = NULL;
- int rc, err, seenspace = 0;
+ int rc, err, seenspace = 0, mergestderr = 0;
char fullcmd[MAXNAMLEN + 1];
#ifdef TRYSHELL
@@ -885,6 +914,18 @@ int execf;
break;
} else if (*s == '\\' && !seenspace) {
continue; /* Allow backslashes in names */
+ } else if (*s == '>' && s >= cmd + 3
+ && s[-1] == '2' && s[1] == '&' && s[2] == '1'
+ && isSPACE(s[-2]) ) {
+ char *t = s + 3;
+
+ while (*t && isSPACE(*t))
+ t++;
+ if (!*t) {
+ s[-2] = '\0';
+ mergestderr = 1;
+ break; /* Allow 2>&1 as the last thing */
+ }
}
/* We do not convert this to do_spawn_ve since shell
should be smart enough to start itself gloriously. */
@@ -927,7 +968,7 @@ int execf;
}
*a = Nullch;
if (PL_Argv[0])
- rc = do_spawn_ve(NULL, 0, execf, cmd);
+ rc = do_spawn_ve(NULL, 0, execf, cmd, mergestderr);
else
rc = -1;
if (news)
@@ -977,6 +1018,7 @@ char *mode;
register I32 pid, rc;
PerlIO *res;
SV *sv;
+ int fh_fl;
/* `this' is what we use in the parent, `that' in the child. */
this = (*mode == 'w');
@@ -988,26 +1030,51 @@ char *mode;
if (pipe(p) < 0)
return Nullfp;
/* Now we need to spawn the child. */
+ if (p[this] == (*mode == 'r')) { /* if fh 0/1 was initially closed. */
+ int new = dup(p[this]);
+
+ if (new == -1)
+ goto closepipes;
+ close(p[this]);
+ p[this] = new;
+ }
newfd = dup(*mode == 'r'); /* Preserve std* */
- if (p[that] != (*mode == 'r')) {
+ if (newfd == -1) {
+ /* This cannot happen due to fh being bad after pipe(), since
+ pipe() should have created fh 0 and 1 even if they were
+ initially closed. But we closed p[this] before. */
+ if (errno != EBADF) {
+ closepipes:
+ close(p[0]);
+ close(p[1]);
+ return Nullfp;
+ }
+ } else
+ fh_fl = fcntl(*mode == 'r', F_GETFD);
+ if (p[that] != (*mode == 'r')) { /* if fh 0/1 was initially closed. */
dup2(p[that], *mode == 'r');
close(p[that]);
}
/* Where is `this' and newfd now? */
fcntl(p[this], F_SETFD, FD_CLOEXEC);
- fcntl(newfd, F_SETFD, FD_CLOEXEC);
+ if (newfd != -1)
+ fcntl(newfd, F_SETFD, FD_CLOEXEC);
pid = do_spawn_nowait(cmd);
- if (newfd != (*mode == 'r')) {
+ if (newfd == -1)
+ close(*mode == 'r'); /* It was closed initially */
+ else if (newfd != (*mode == 'r')) { /* Probably this check is not needed */
dup2(newfd, *mode == 'r'); /* Return std* back. */
close(newfd);
- }
+ fcntl(*mode == 'r', F_SETFD, fh_fl);
+ } else
+ fcntl(*mode == 'r', F_SETFD, fh_fl);
if (p[that] == (*mode == 'r'))
close(p[that]);
if (pid == -1) {
close(p[this]);
- return NULL;
+ return Nullfp;
}
- if (p[that] < p[this]) {
+ if (p[that] < p[this]) { /* Make fh as small as possible */
dup2(p[this], p[that]);
close(p[this]);
p[this] = p[that];
diff --git a/perl.c b/perl.c
index 95cb0d0dc8..c91c960632 100644
--- a/perl.c
+++ b/perl.c
@@ -64,6 +64,9 @@ static void my_exit_jump _((void)) __attribute__((noreturn));
static void nuke_stacks _((void));
static void open_script _((char *, bool, SV *, int *fd));
static void usage _((char *));
+#ifdef IAMSUID
+static int fd_on_nosuid_fs _((int));
+#endif
static void validate_suid _((char *, char*, int));
static I32 read_e_script _((int idx, SV *buf_sv, int maxlen));
#endif
@@ -2110,6 +2113,70 @@ sed %s -e \"/^[^#]/b\" \
}
}
+#ifdef IAMSUID
+static int
+fd_on_nosuid_fs(int fd)
+{
+ int on_nosuid = 0;
+ int check_okay = 0;
+/*
+ * Preferred order: fstatvfs(), fstatfs(), getmntent().
+ * fstatvfs() is UNIX98.
+ * fstatfs() is BSD.
+ * getmntent() is O(number-of-mounted-filesystems) and can hang.
+ */
+
+# ifdef HAS_FSTATVFS
+ struct statvfs stfs;
+ check_okay = fstatvfs(fd, &stfs) == 0;
+ on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID);
+# else
+# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS)
+ struct statfs stfs;
+ check_okay = fstatfs(fd, &stfs) == 0;
+# undef PERL_MOUNT_NOSUID
+# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID)
+# define PERL_MOUNT_NOSUID MNT_NOSUID
+# endif
+# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID)
+# define PERL_MOUNT_NOSUID MS_NOSUID
+# endif
+# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID)
+# define PERL_MOUNT_NOSUID M_NOSUID
+# endif
+# ifdef PERL_MOUNT_NOSUID
+ on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID);
+# endif
+# else
+# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID)
+ FILE *mtab = fopen("/etc/mtab", "r");
+ struct mntent *entry;
+ struct stat stb, fsb;
+
+ if (mtab && (fstat(fd, &stb) == 0)) {
+ while (entry = getmntent(mtab)) {
+ if (stat(entry->mnt_dir, &fsb) == 0
+ && fsb.st_dev == stb.st_dev)
+ {
+ /* found the filesystem */
+ check_okay = 1;
+ if (hasmntopt(entry, MNTOPT_NOSUID))
+ on_nosuid = 1;
+ break;
+ } /* A single fs may well fail its stat(). */
+ }
+ }
+ if (mtab)
+ fclose(mtab);
+# endif /* mntent */
+# endif /* statfs */
+# endif /* statvfs */
+ if (!check_okay)
+ croak("Can't check filesystem of script \"%s\"", PL_origfilename);
+ return on_nosuid;
+}
+#endif /* IAMSUID */
+
STATIC void
validate_suid(char *validarg, char *scriptname, int fdscript)
{
@@ -2178,6 +2245,10 @@ validate_suid(char *validarg, char *scriptname, int fdscript)
croak("Can't swap uid and euid"); /* really paranoid */
if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
croak("Permission denied"); /* testing full pathname here */
+#if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
+ if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
+ croak("Permission denied");
+#endif
if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
tmpstatbuf.st_ino != PL_statbuf.st_ino) {
(void)PerlIO_close(PL_rsfp);
diff --git a/perl.h b/perl.h
index 1546bcdb7e..c7e328a2a3 100644
--- a/perl.h
+++ b/perl.h
@@ -2778,4 +2778,20 @@ typedef struct am_table_short AMTS;
# endif
#endif
+/* Mention INSTALL_USR_BIN_PERL here so that Configure picks it up. */
+
+#ifdef IAMSUID
+
+#ifdef I_SYS_STATVFS
+# include <sys/statvfs.h> /* for f?statvfs() */
+#endif
+#ifdef I_SYS_MOUNT
+# include <sys/mount.h> /* for *BSD f?statfs() */
+#endif
+#ifdef I_MNTENT
+# include <mntent.h> /* for getmntent() */
+#endif
+
+#endif /* IAMSUID */
+
#endif /* Include guard */
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 211262c626..eb84876d4e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -517,6 +517,10 @@ Something like this will reproduce the error:
(F) You called C<perl -x/foo/bar>, but C</foo/bar> is not a directory
that you can chdir to, possibly because it doesn't exist.
+=item Can't check filesystem of script "%s"
+
+(P) For some reason you can't check the filesystem of the script for nosuid.
+
=item Can't coerce %s to integer in %s
(F) Certain types of SVs, in particular real symbol table entries
@@ -896,6 +900,12 @@ and the variable had earlier been declared as a lexical variable.
Either qualify the sort variable with the package name, or rename the
lexical variable.
+=item Bad evalled substitution pattern
+
+(F) You've used the /e switch to evaluate the replacement for a
+substitution, but perl found a syntax error in the code to evaluate,
+most likely an unexpected right brace '}'.
+
=item Can't use %s for loop variable
(F) Only a simple scalar variable may be used as a loop variable on a foreach.
diff --git a/pod/perllocale.pod b/pod/perllocale.pod
index dba15feffe..08b50e0d12 100644
--- a/pod/perllocale.pod
+++ b/pod/perllocale.pod
@@ -215,6 +215,8 @@ I<SEE ALSO> section). If that fails, try the following command lines:
ls /usr/lib/nls
+ ls /usr/share/locale
+
and see whether they list something resembling these
en_US.ISO8859-1 de_DE.ISO8859-1 ru_RU.ISO8859-5
@@ -225,18 +227,18 @@ and see whether they list something resembling these
english.iso88591 german.iso88591 russian.iso88595
english.roman8 russian.koi8r
-Sadly, even though the calling interface for setlocale() has
-been standardized, names of locales and the directories where the
+Sadly, even though the calling interface for setlocale() has been
+standardized, names of locales and the directories where the
configuration resides have not been. The basic form of the name is
-I<language_country/territory>B<.>I<codeset>, but the latter parts after
-I<language> are not always present. The I<language> and I<country> are
-usually from the standards B<ISO 3166> and B<ISO 639>, the two-letter
-abbreviations for the countries and the languages of the world,
-respectively. The I<codeset> part often mentions some B<ISO 8859>
-character set, the Latin codesets. For example, C<ISO 8859-1> is the
-so-called "Western codeset" that can be used to encode most Western
-European languages. Again, there are several ways to write even the
-name of that one standard. Lamentably.
+I<language_territory>B<.>I<codeset>, but the latter parts after
+I<language> are not always present. The I<language> and I<country>
+are usually from the standards B<ISO 3166> and B<ISO 639>, the
+two-letter abbreviations for the countries and the languages of the
+world, respectively. The I<codeset> part often mentions some B<ISO
+8859> character set, the Latin codesets. For example, C<ISO 8859-1>
+is the so-called "Western European codeset" that can be used to encode
+most Western European languages adequately. Again, there are several
+ways to write even the name of that one standard. Lamentably.
Two special locales are worth particular mention: "C" and "POSIX".
Currently these are effectively the same locale: the difference is
@@ -807,6 +809,20 @@ for controlling an application's opinion on data.
C<LC_ALL> is the "override-all" locale environment variable. If
set, it overrides all the rest of the locale environment variables.
+=item LANGUAGE
+
+B<NOTE>: C<LANGUAGE> is a GNU extension, it affects you only if you
+are using the GNU libc. This is the case if you are using e.g. Linux.
+If you are using "commercial" UNIXes you are most probably I<not>
+using GNU libc and you can ignore C<LANGUAGE>.
+
+However, in the case you are using C<LANGUAGE>: it affects the
+language of informational, warning, and error messages output by
+commands (in other words, it's like C<LC_MESSAGES>) but it has higher
+priority than L<LC_ALL>. Moreover, it's not a single value but
+instead a "path" (":"-separated list) of I<languages> (not locales).
+See the GNU C<gettext> library documentation for more information.
+
=item LC_CTYPE
In the absence of C<LC_ALL>, C<LC_CTYPE> chooses the character type
diff --git a/pp.c b/pp.c
index 84ee4f4fca..b378d7d21c 100644
--- a/pp.c
+++ b/pp.c
@@ -3594,6 +3594,17 @@ PP(pp_unpack)
Copy(s, &auint, 1, unsigned int);
s += sizeof(unsigned int);
sv = NEWSV(41, 0);
+#ifdef __osf__
+ /* Without the dummy below unpack("I", pack("I",0xFFFFFFFF))
+ * returns 1.84467440737096e+19 instead of 0xFFFFFFFF for
+ * DEC C V5.8-009 on Digital UNIX V4.0 (Rev. 1091) (aka V4.0D)
+ * with optimization turned on.
+ * (DEC C V5.2-040 on Digital UNIX V4.0 (Rev. 564) (aka V4.0B)
+ * does not have this problem even with -O4)
+ */
+ (auint) ?
+ sv_setuv(sv, (UV)auint) :
+#endif
sv_setuv(sv, (UV)auint);
PUSHs(sv_2mortal(sv));
}
diff --git a/pp_hot.c b/pp_hot.c
index b53842775e..622621f081 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -881,7 +881,8 @@ PP(pp_match)
if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
MAGIC* mg = mg_find(TARG, 'g');
if (mg && mg->mg_len >= 0) {
- rx->endp[0] = rx->startp[0] = s + mg->mg_len;
+ if (!(rx->reganch & ROPT_GPOS_SEEN))
+ rx->endp[0] = rx->startp[0] = s + mg->mg_len;
minmatch = (mg->mg_flags & MGf_MINMATCH);
update_minmatch = 0;
}
diff --git a/pp_sys.c b/pp_sys.c
index d60c8dc7e8..538fb684db 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -187,24 +187,32 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
/* F_OK unused: if stat() cannot find it... */
#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) && defined(EFF_ONLY_OK) && !defined(NO_EFF_ONLY_OK)
-/* Digital UNIX (when the EFF_ONLY_OK gets fixed), UnixWare */
+ /* Digital UNIX (when the EFF_ONLY_OK gets fixed), UnixWare */
# define PERL_EFF_ACCESS_R_OK(p) (access((p), R_OK | EFF_ONLY_OK))
# define PERL_EFF_ACCESS_W_OK(p) (access((p), W_OK | EFF_ONLY_OK))
# define PERL_EFF_ACCESS_X_OK(p) (access((p), X_OK | EFF_ONLY_OK))
#endif
#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_EACCESS)
-/* HP SecureWare */
# if defined(I_SYS_SECURITY)
# include <sys/security.h>
# endif
-# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
-# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
-# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
+ /* XXX Configure test needed for eaccess */
+# ifdef ACC_SELF
+ /* HP SecureWare */
+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
+# else
+ /* SCO */
+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK))
+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK))
+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK))
+# endif
#endif
#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
-/* AIX */
+ /* AIX */
# define PERL_EFF_ACCESS_R_OK(p) (accessx((p), R_OK, ACC_SELF))
# define PERL_EFF_ACCESS_W_OK(p) (accessx((p), W_OK, ACC_SELF))
# define PERL_EFF_ACCESS_X_OK(p) (accessx((p), X_OK, ACC_SELF))
diff --git a/t/lib/safe2.t b/t/lib/safe2.t
index 6afc117729..e0dcfdda1c 100755
--- a/t/lib/safe2.t
+++ b/t/lib/safe2.t
@@ -10,6 +10,7 @@ BEGIN {
}
# test 30 rather naughtily expects English error messages
$ENV{'LC_ALL'} = 'C';
+ $ENV{LANGUAGE} = 'C'; # GNU locale extension
}
# Tests Todo:
diff --git a/t/op/grent.t b/t/op/grent.t
index d054ccc2b9..abe6b5add0 100755
--- a/t/op/grent.t
+++ b/t/op/grent.t
@@ -2,36 +2,62 @@
BEGIN {
chdir 't' if -d 't';
- @INC = "../lib" if -d "../lib";
+ unshift @INC, "../lib" if -d "../lib";
eval { require Config; import Config; };
- my $GR = "/etc/group";
+ unless (defined $Config{'i_grp'} &&
+ $Config{'i_grp'} eq 'define' &&
+ -f "/etc/group" ) { # Play safe.
+ print "1..0\n";
+ exit 0;
+ }
- $where = $GR;
+ if (not defined $where) { # Try NIS.
+ foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
+ if (-x $ypcat &&
+ open(GR, "$ypcat group 2>/dev/null |") &&
+ defined(<GR>)) {
+ $where = "NIS group";
+ last;
+ }
+ }
+ }
+
+ if (not defined $where) { # Try NetInfo.
+ foreach my $nidump (qw(/usr/bin/nidump)) {
+ if (-x $nidump &&
+ open(GR, "$nidump group . 2>/dev/null |") &&
+ defined(<GR>)) {
+ $where = "NetInfo group";
+ last;
+ }
+ }
+ }
- if (-x "/usr/bin/nidump") { # nidump is not just NeXT/OpenStep
- if (open(GR, "nidump group . |")) {
- $where = "NetInfo group";
- } else {
- print "1..0\n";
- exit 0;
+ if (not defined $where) { # Try local.
+ my $GR = "/etc/group";
+ if (-f $GR && open(GR, $GR) && defined(<GR>)) {
+ $where = $GR;
}
- } elsif ((defined $Config{'i_grp'} and $Config{'i_grp'} ne 'define')
- or not -f $GR or not open(GR, $GR)
- ) {
+ }
+
+ if (not defined $where) { # Give up.
print "1..0\n";
exit 0;
}
}
+# By now GR filehandle should be open and full of juicy group entries.
+
print "1..1\n";
# Go through at most this many groups.
+# (note that the first entry has been read away by now)
my $max = 25;
my $n = 0;
my $tst = 1;
-my %suspect;
+my %perfect;
my %seen;
while (<GR>) {
@@ -44,7 +70,7 @@ while (<GR>) {
warn "# Your $where line $. is empty.\n";
next;
}
- next if $n == $max;
+ last if $n == $max;
# In principle we could whine if @s != 4 but do we know enough
# of group file formats everywhere?
if (@s == 4) {
@@ -61,31 +87,42 @@ while (<GR>) {
($name,$passwd,$gid,$members) = @n;
next if $name_s ne $name;
}
+ # NOTE: group names *CAN* contain whitespace.
$members =~ s/\s+/,/g;
- $suspect{$name_s}++
- if $name ne $name_s or
-# Shadow passwords confuse this.
+ # what about different orders of members?
+ $perfect{$name_s}++
+ if $name eq $name_s and
+# Do not compare passwords: think shadow passwords.
# Not that group passwords are used much but better not assume anything.
-# $passwd ne $passwd_s or
- $gid ne $gid_s or
- $members ne $members_s;
+ $gid eq $gid_s and
+ $members eq $members_s;
}
$n++;
}
-# Drop the multiply defined groups.
-
-foreach (sort keys %seen) {
- my $times = @{ $seen{$_} };
- if ($times > 1) {
- # Multiply defined groups are rarely intentional.
- local $" = ", ";
- print "# Group '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n";
- delete $suspect{$_};
- }
+if (keys %perfect == 0) {
+ $max++;
+ print <<EOEX;
+#
+# The failure of op/grent test is not necessarily serious.
+# It may fail due to local group administration conventions.
+# If you are for example using both NIS and local groups,
+# test failure is possible. Any distributed group scheme
+# can cause such failures.
+#
+# What the grent test is doing is that it compares the $max first
+# entries of $where
+# with the results of getgrgid() and getgrnam() call. If it finds no
+# matches at all, it suspects something is wrong.
+#
+EOEX
+ print "not ";
+ $not = 1;
+} else {
+ $not = 0;
}
-
-print "not " if keys %suspect;
-print "ok ", $tst++, "\n";
+print "ok ", $tst++;
+print "\t# (not necessarily serious: run t/op/grent.t by itself)" if $not;
+print "\n";
close(GR);
diff --git a/t/op/groups.t b/t/op/groups.t
index dc8385b853..5778795a0e 100755
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -3,6 +3,7 @@
$ENV{PATH} ="/bin:/usr/bin:/usr/xpg4/bin:/usr/ucb" .
exists $ENV{PATH} ? ":$ENV{PATH}" : "";
$ENV{LC_ALL} = "C"; # so that external utilities speak English
+$ENV{LANGUAGE} = 'C'; # GNU locale extension
sub quit {
print "1..0\n";
diff --git a/t/op/mkdir.t b/t/op/mkdir.t
index acf16c14a4..fc91b6b6a2 100755
--- a/t/op/mkdir.t
+++ b/t/op/mkdir.t
@@ -8,6 +8,7 @@ $^O eq 'MSWin32' ? `del /s /q blurfl 2>&1` : `rm -rf blurfl`;
# tests 3 and 7 rather naughtily expect English error messages
$ENV{'LC_ALL'} = 'C';
+$ENV{LANGUAGE} = 'C'; # GNU locale extension
print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
diff --git a/t/op/pat.t b/t/op/pat.t
index abb10fd841..63219a39f8 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,7 +4,7 @@
# the format supported by op/regexp.t. If you want to add a test
# that does fit that format, add it to op/re_tests, not here.
-print "1..178\n";
+print "1..184\n";
BEGIN {
chdir 't' if -d 't';
@@ -803,6 +803,46 @@ print "#'@res' '$_'\nnot "
print "ok $test\n";
$test++;
+#Some more \G anchor checks
+$foo='aabbccddeeffgg';
+
+pos($foo)=1;
+
+$foo=~/.\G(..)/g;
+print "not " unless($1 eq 'ab');
+print "ok $test\n";
+$test++;
+
+pos($foo) += 1;
+$foo=~/.\G(..)/g;
+print "not " unless($1 eq 'cc');
+print "ok $test\n";
+$test++;
+
+pos($foo) += 1;
+$foo=~/.\G(..)/g;
+print "not " unless($1 eq 'de');
+print "ok $test\n";
+$test++;
+
+undef pos $foo;
+
+$foo=~/\G(..)/g;
+print "not " unless($1 eq 'aa');
+print "ok $test\n";
+$test++;
+
+$foo=~/\G(..)/g;
+print "not " unless($1 eq 'bb');
+print "ok $test\n";
+$test++;
+
+pos($foo)=5;
+$foo=~/\G(..)/g;
+print "not " unless($1 eq 'cd');
+print "ok $test\n";
+$test++;
+
# see if matching against temporaries (created via pp_helem()) is safe
{ foo => "ok $test\n".$^X }->{foo} =~ /^(.*)\n/g;
print "$1\n";
diff --git a/t/op/pwent.t b/t/op/pwent.t
index 4151ef26b3..cd5db34cf5 100755
--- a/t/op/pwent.t
+++ b/t/op/pwent.t
@@ -2,49 +2,76 @@
BEGIN {
chdir 't' if -d 't';
- @INC = "../lib" if -d "../lib";
+ unshift @INC, "../lib" if -d "../lib";
eval { require Config; import Config; };
- my $PW = "/etc/passwd";
+ unless (defined $Config{'i_pwd'} &&
+ $Config{'i_pwd'} eq 'define' &&
+ -f "/etc/passwd" ) { # Play safe.
+ print "1..0\n";
+ exit 0;
+ }
+
+ if (not defined $where) { # Try NIS.
+ foreach my $ypcat (qw(/usr/bin/ypcat /bin/ypcat /etc/ypcat)) {
+ if (-x $ypcat &&
+ open(PW, "$ypcat passwd 2>/dev/null |") &&
+ defined(<PW>)) {
+ $where = "NIS passwd";
+ last;
+ }
+ }
+ }
- $where = $PW;
+ if (not defined $where) { # Try NetInfo.
+ foreach my $nidump (qw(/usr/bin/nidump)) {
+ if (-x $nidump &&
+ open(PW, "$nidump passwd . 2>/dev/null |") &&
+ defined(<PW>)) {
+ $where = "NetInfo passwd";
+ last;
+ }
+ }
+ }
- if (-x "/usr/bin/nidump") { # nidump is not just NeXT/OpenStep
- if (open(PW, "nidump passwd . |")) {
- $where = "NetInfo passwd";
- } else {
- print "1..0\n";
- exit 0;
+ if (not defined $where) { # Try local.
+ my $PW = "/etc/passwd";
+ if (-f $PW && open(PW, $PW) && defined(<PW>)) {
+ $where = $PW;
}
- } elsif ((defined $Config{'i_pwd'} and $Config{'i_pwd'} ne 'define')
- or not -f $PW or not open(PW, $PW)) {
+ }
+
+ if (not defined $where) { # Give up.
print "1..0\n";
exit 0;
}
}
+# By now PW filehandle should be open and full of juicy password entries.
+
print "1..1\n";
# Go through at most this many users.
-my $max = 25; #
+# (note that the first entry has been read away by now)
+my $max = 25;
my $n = 0;
my $tst = 1;
-my %suspect;
+my %perfect;
my %seen;
while (<PW>) {
chomp;
- next if /^\+/; # ignore NIS includes
my @s = split /:/;
my ($name_s, $passwd_s, $uid_s, $gid_s, $gcos_s, $home_s, $shell_s) = @s;
+ next if /^\+/; # ignore NIS includes
if (@s) {
push @{ $seen{$name_s} }, $.;
} else {
warn "# Your $where line $. is empty.\n";
next;
}
- next if $n == $max;
+ last if $n == $max;
# In principle we could whine if @s != 7 but do we know enough
# of passwd file formats everywhere?
if (@s == 7) {
@@ -58,33 +85,41 @@ while (<PW>) {
($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$home,$shell) = @n;
next if $name_s ne $name;
}
- $suspect{$name_s}++
- if $name ne $name_s or
-# Shadow passwords confuse this.
-# Think about non-crypt(3) encryptions, too, before you do anything rash.
-# $passwd ne $passwd_s or
- $uid ne $uid_s or
- $gid ne $gid_s or
- $gcos ne $gcos_s or
- $home ne $home_s or
- $shell ne $shell_s;
+ $perfect{$name_s}++
+ if $name eq $name_s and
+ $uid eq $uid_s and
+# Do not compare passwords: think shadow passwords.
+ $gid eq $gid_s and
+ $gcos eq $gcos_s and
+ $home eq $home_s and
+ $shell eq $shell_s;
}
$n++;
}
-# Drop the multiply defined users.
-
-foreach (sort keys %seen) {
- my $times = @{ $seen{$_} };
- if ($times > 1) {
- # Multiply defined users are rarely intentional.
- local $" = ", ";
- print "# User '$_' defined multiple times in $where, lines: @{$seen{$_}}.\n";
- delete $suspect{$_};
- }
+if (keys %perfect == 0) {
+ $max++;
+ print <<EOEX;
+#
+# The failure of op/pwent test is not necessarily serious.
+# It may fail due to local password administration conventions.
+# If you are for example using both NIS and local passwords,
+# test failure is possible. Any distributed password scheme
+# can cause such failures.
+#
+# What the pwent test is doing is that it compares the $max first
+# entries of $where
+# with the results of getpwuid() and getpwnam() call. If it finds no
+# matches at all, it suspects something is wrong.
+#
+EOEX
+ print "not ";
+ $not = 1;
+} else {
+ $not = 0;
}
-
-print "not " if keys %suspect;
-print "ok ", $tst++, "\n";
+print "ok ", $tst++;
+print "\t# (not necessarily serious: run t/op/pwent.t by itself)" if $not;
+print "\n";
close(PW);
diff --git a/t/op/subst.t b/t/op/subst.t
index 6b3ce5852f..6776a1e59b 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -6,7 +6,7 @@ BEGIN {
require Config; import Config;
}
-print "1..91\n";
+print "1..93\n";
$x = 'foo';
$_ = "x";
@@ -451,3 +451,9 @@ $a =~ s/\Ga(?{push @res, $_, $`})/x1/e;
print "#'$a' '@res'\nnot " unless "$a @res" eq 'axa aaa a';
print "ok 91\n";
+eval q% s/a/"b"}/e %;
+print ($@ =~ /Bad evalled substitution/ ? "ok 92\n" : "not ok 92\n");
+eval q% ($_ = "x") =~ s/(.)/"$1 "/e %;
+print +($_ eq "x " and !length $@) ? "ok 93\n" : "not ok 93\n# \$_ eq $_, $@\n";
+
+
diff --git a/toke.c b/toke.c
index fca117b047..de6bfda949 100644
--- a/toke.c
+++ b/toke.c
@@ -822,10 +822,15 @@ sublex_done(void)
if (SvCOMPILED(PL_lex_repl)) {
PL_lex_state = LEX_INTERPNORMAL;
PL_lex_starts++;
+ /* we don't clear PL_lex_repl here, so that we can check later
+ whether this is an evalled subst; that means we rely on the
+ logic to ensure sublex_done() is called again only via the
+ branch (in yylex()) that clears PL_lex_repl, else we'll loop */
}
- else
+ else {
PL_lex_state = LEX_INTERPCONCAT;
- PL_lex_repl = Nullsv;
+ PL_lex_repl = Nullsv;
+ }
return ',';
}
else {
@@ -1845,6 +1850,11 @@ int yylex(PERL_YYLEX_PARAM_DECL)
PL_lex_state = LEX_INTERPCONCAT;
return ')';
}
+ if (PL_lex_inwhat == OP_SUBST && PL_lex_repl && SvCOMPILED(PL_lex_repl)) {
+ if (PL_bufptr != PL_bufend)
+ croak("Bad evalled substitution pattern");
+ PL_lex_repl = Nullsv;
+ }
/* FALLTHROUGH */
case LEX_INTERPCONCAT:
#ifdef DEBUGGING
diff --git a/unixish.h b/unixish.h
index 2a6cbcdb88..eab2de1643 100644
--- a/unixish.h
+++ b/unixish.h
@@ -89,7 +89,7 @@
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
# include <signal.h>
#endif
diff --git a/util.c b/util.c
index 2f5fcf819d..77dd842f42 100644
--- a/util.c
+++ b/util.c
@@ -621,6 +621,9 @@ perl_init_i18nl10n(int printwarn)
#ifdef USE_LOCALE_NUMERIC
char *curnum = NULL;
#endif /* USE_LOCALE_NUMERIC */
+#ifdef __GLIBC__
+ char *language = PerlEnv_getenv("LANGUAGE");
+#endif
char *lc_all = PerlEnv_getenv("LC_ALL");
char *lang = PerlEnv_getenv("LANG");
bool setlocale_failure = FALSE;
@@ -724,6 +727,14 @@ perl_init_i18nl10n(int printwarn)
PerlIO_printf(PerlIO_stderr(),
"perl: warning: Please check that your locale settings:\n");
+#ifdef __GLIBC__
+ PerlIO_printf(PerlIO_stderr(),
+ "\tLANGUAGE = %c%s%c,\n",
+ language ? '"' : '(',
+ language ? language : "unset",
+ language ? '"' : ')');
+#endif
+
PerlIO_printf(PerlIO_stderr(),
"\tLC_ALL = %c%s%c,\n",
lc_all ? '"' : '(',
diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index 842ff747dc..f82b5baba8 100644
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -528,7 +528,7 @@ EOF
Environment for perl $]:
EOF
for my $env (sort
- (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR),
+ (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE),
grep /^(?:PERL|LC_)/, keys %ENV)
) {
print OUT " $env",
diff --git a/vms/subconfigure.com b/vms/subconfigure.com
index 5c5dc29562..914f40e61b 100644
--- a/vms/subconfigure.com
+++ b/vms/subconfigure.com
@@ -62,6 +62,14 @@ $ myname = myhostname
$ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE")
$!
$! ##ADD NEW CONSTANTS HERE##
+$ perl_i_sysmount="undef"
+$ perl_d_fstatfs="undef"
+$ perl_d_statfsflags="undef"
+$ perl_i_sysstatvfs="undef"
+$ perl_d_fstatfs="undef"
+$ perl_i_mntent="undef"
+$ perl_d_getmntent="undef"
+$ perl_d_hasmntopt="undef"
$ perl_package="''package'"
$ perl_baserev = "''baserev'"
$ cc_defines=""
@@ -3048,6 +3056,14 @@ $ WC "drand01='" + perl_drand01 + "'"
$ WC "randseedtype='" + perl_randseedtype + "'"
$ WC "seedfunc='" + perl_seedfunc + "'"
$ WC "sig_num_init='" + perl_sig_num_with_commas + "'"
+$ WC "i_sysmount='" + perl_i_sysmount + "'"
+$ WC "d_fstatfs='" + perl_d_fstatfs + "'"
+$ WC "d_statfsflags='" + perl_d_statfsflags + "'"
+$ WC "i_sysstatvfs='" + perl_i_sysstatvfs + "'"
+$ WC "d_fstatfs='" + perl_d_fstatfs + "'"
+$ WC "i_mntent='" + perl_i_mntent + "'"
+$ WC "d_getmntent='" + perl_d_getmntent + "'"
+$ WC "d_hasmntopt='" + perl_d_hasmntopt + "'"
$!
$! ##WRITE NEW CONSTANTS HERE##
$!