# This is a patch for perl5.005_02 to update it to perl5.005_03
#
# To apply this patch:
# STEP 1: Chdir to the source directory.
# STEP 2: Run the 'applypatch' program with this patch file as input.
#
# If you do not have 'applypatch', it is part of the 'makepatch' package
# that you can fetch from the Comprehensive Perl Archive Network:
# http://www.perl.com/CPAN/authors/Johan_Vromans/makepatch-x.y.tar.gz
# In the above URL, 'x' should be 2 or higher.
#
# To apply this patch without the use of 'applypatch':
# STEP 1: Chdir to the source directory.
# If you have a decent Bourne-type shell:
# STEP 2: Run the shell with this file as input.
# If you don't have such a shell, you may need to manually create/delete
# the files/directories as shown below.
# STEP 3: Run the 'patch' program with this file as input.
#
# These are the commands needed to create/delete files/directories:
#
mkdir 'apollo'
chmod 0700 'apollo'
mkdir 'apollo/netinet'
chmod 0700 'apollo/netinet'
mkdir 'ext/DB_File/hints'
chmod 0700 'ext/DB_File/hints'
mkdir 'ext/GDBM_File/hints'
chmod 0700 'ext/GDBM_File/hints'
mkdir 'mint'
chmod 0700 'mint'
mkdir 'mint/sys'
chmod 0700 'mint/sys'
mkdir 'vos'
chmod 0700 'vos'
rm -f 'interp.sym'
touch 'README.apollo'
chmod 0444 'README.apollo'
touch 'README.hpux'
chmod 0444 'README.hpux'
touch 'README.hurd'
chmod 0444 'README.hurd'
touch 'README.mint'
chmod 0444 'README.mint'
touch 'README.vos'
chmod 0444 'README.vos'
touch 'apollo/netinet/in.h'
chmod 0444 'apollo/netinet/in.h'
touch 'ext/DB_File/hints/dynixptx.pl'
chmod 0444 'ext/DB_File/hints/dynixptx.pl'
touch 'ext/DynaLoader/dl_beos.xs'
chmod 0444 'ext/DynaLoader/dl_beos.xs'
touch 'ext/GDBM_File/hints/sco.pl'
chmod 0444 'ext/GDBM_File/hints/sco.pl'
touch 'ext/POSIX/hints/dynixptx.pl'
chmod 0444 'ext/POSIX/hints/dynixptx.pl'
touch 'ext/POSIX/hints/mint.pl'
chmod 0444 'ext/POSIX/hints/mint.pl'
touch 'hints/gnu.sh'
chmod 0444 'hints/gnu.sh'
touch 'hints/mint.sh'
chmod 0444 'hints/mint.sh'
touch 'hints/uwin.sh'
chmod 0444 'hints/uwin.sh'
touch 'lib/Dumpvalue.pm'
chmod 0444 'lib/Dumpvalue.pm'
touch 'mint/Makefile'
chmod 0444 'mint/Makefile'
touch 'mint/README'
chmod 0444 'mint/README'
touch 'mint/errno.h'
chmod 0444 'mint/errno.h'
touch 'mint/pwd.c'
chmod 0444 'mint/pwd.c'
touch 'mint/stdio.h'
chmod 0444 'mint/stdio.h'
touch 'mint/sys/time.h'
chmod 0444 'mint/sys/time.h'
touch 'mint/time.h'
chmod 0444 'mint/time.h'
touch 'pod/perlopentut.pod'
chmod 0444 'pod/perlopentut.pod'
touch 'pod/perlreftut.pod'
chmod 0444 'pod/perlreftut.pod'
touch 'pod/perlthrtut.pod'
chmod 0444 'pod/perlthrtut.pod'
touch 't/lib/fatal.t'
chmod 0555 't/lib/fatal.t'
touch 't/lib/textfill.t'
chmod 0555 't/lib/textfill.t'
touch 't/op/grep.t'
chmod 0555 't/op/grep.t'
touch 't/op/tr.t'
chmod 0555 't/op/tr.t'
touch 'vos/Changes'
chmod 0444 'vos/Changes'
touch 'vos/build.cm'
chmod 0444 'vos/build.cm'
touch 'vos/compile_perl.cm'
chmod 0444 'vos/compile_perl.cm'
touch 'vos/config.h'
chmod 0444 'vos/config.h'
touch 'vos/config_h.SH_orig'
chmod 0555 'vos/config_h.SH_orig'
touch 'vos/perl.bind'
chmod 0444 'vos/perl.bind'
touch 'vos/test_vos_dummies.c'
chmod 0444 'vos/test_vos_dummies.c'
touch 'vos/vos_accept.c'
chmod 0444 'vos/vos_accept.c'
touch 'vos/vos_dummies.c'
chmod 0444 'vos/vos_dummies.c'
touch 'vos/vosish.h'
chmod 0444 'vos/vosish.h'
#
# This command terminates the shell and need not be executed manually.
exit
#
#### End of Preamble ####
#### Patch data follows ####
diff -c 'perl5.005_02/patchlevel.h' 'perl5.005_03/patchlevel.h'
Index: ./patchlevel.h
*** ./patchlevel.h Fri Aug 7 22:44:26 1998
--- ./patchlevel.h Sun Mar 28 10:11:58 1999
***************
*** 1,7 ****
#ifndef __PATCHLEVEL_H_INCLUDED__
#define PATCHLEVEL 5
#undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */
! #define SUBVERSION 2
/*
local_patches -- list of locally applied less-than-subversion patches.
--- 1,7 ----
#ifndef __PATCHLEVEL_H_INCLUDED__
#define PATCHLEVEL 5
#undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */
! #define SUBVERSION 3
/*
local_patches -- list of locally applied less-than-subversion patches.
diff -c 'perl5.005_02/Changes' 'perl5.005_03/Changes'
Index: ./Changes
*** ./Changes Fri Aug 7 22:54:42 1998
--- ./Changes Sun Mar 28 16:33:36 1999
***************
*** 20,26 ****
Abigail <abigail@fnx.com>
Kenneth Albanowski <kjahds@kjahds.com>
Russ Allbery <rra@stanford.edu>
- Graham Barr <gbarr@ti.com>
Spider Boardman <spider@orb.nashua.nh.us>
Tom Christiansen <tchrist@perl.com>
Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
--- 20,25 ----
***************
*** 50,59 ****
And the Keepers of the Patch Pumpkin:
Charles Bailey <bailey@hmivax.humgen.upenn.edu>
Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Tim Bunce <Tim.Bunce@ig.co.uk>
Andy Dougherty <doughera@lafcol.lafayette.edu>
! Gurusamy Sarathy <gsar@engin.umich.edu>
Chip Salzenberg <chip@perl.com>
And, of course, the Author of Perl:
--- 49,59 ----
And the Keepers of the Patch Pumpkin:
Charles Bailey <bailey@hmivax.humgen.upenn.edu>
+ Graham Barr <gbarr@pobox.com>
Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Tim Bunce <Tim.Bunce@ig.co.uk>
Andy Dougherty <doughera@lafcol.lafayette.edu>
! Gurusamy Sarathy <gsar@umich.edu>
Chip Salzenberg <chip@perl.com>
And, of course, the Author of Perl:
***************
*** 72,77 ****
--- 72,3517 ----
+> branched (from elsewhere)
!> merged changes (from elsewhere)
+
+ ----------------
+ Version 5.005_03 Third maintenance release of 5.005
+ ----------------
+
+ ____________________________________________________________________________
+ [ 3198] By: gbarr on 1999/03/28 22:21:49
+ Log: redo #3193 which #3195 undid
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod
+ ____________________________________________________________________________
+ [ 3197] By: gbarr on 1999/03/28 21:04:04
+ Log: Updated CPAN.pm to 1.48
+ Branch: maint-5.005/perl
+ ! lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
+ ____________________________________________________________________________
+ [ 3196] By: gbarr on 1999/03/28 17:21:27
+ Log: AIX hints update from Jarkko
+ Branch: maint-5.005/perl
+ ! hints/aix.sh
+ ____________________________________________________________________________
+ [ 3195] By: jhi on 1999/03/28 16:42:54
+ Log: Update perlhist on 5_03.
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod
+ ____________________________________________________________________________
+ [ 3193] By: gsar on 1999/03/28 09:46:29
+ Log: =end needs matching =begin (or installhtml will croak)
+ Branch: maint-5.005/perl
+ ! pod/perlhist.pod
+ ____________________________________________________________________________
+ [ 3192] By: gsar on 1999/03/28 09:10:15
+ Log: update pod/Makefile
+ Branch: maint-5.005/perl
+ ! pod/Makefile
+ ____________________________________________________________________________
+ [ 3191] By: gsar on 1999/03/28 08:43:47
+ Log: integrate change#3180 from mainline
+
+ fix bogus OPf_REF context for the BLOCK in C<grep BLOCK @foo>
+ (sometimes caused bizarreness in the BLOCK)
+ Branch: maint-5.005/perl
+ +> t/op/grep.t
+ !> MANIFEST op.c
+ ____________________________________________________________________________
+ [ 3190] By: gsar on 1999/03/28 08:29:51
+ Log: integrate change#3147 from mainline
+
+ warn about newfangled vfork() caveats
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 3189] By: gsar on 1999/03/28 08:22:00
+ Log: various pod niggles
+ Branch: maint-5.005/perl
+ ! pod/perl.pod pod/perldebug.pod pod/perldiag.pod
+ ! pod/perlfunc.pod pod/perlhist.pod
+ ____________________________________________________________________________
+ [ 3188] By: gsar on 1999/03/28 07:37:43
+ Log: integrate binary compatible variant of change#3098 from mainline
+ Branch: maint-5.005/perl
+ ! op.c perl.h t/base/lex.t toke.c
+ ____________________________________________________________________________
+ [ 3187] By: gsar on 1999/03/28 07:31:16
+ Log: regularize CAPI declarations (CAPI extensions now build under
+ the Borland compiler)
+ Branch: maint-5.005/perl
+ ! win32/GenCAPI.pl
+ ____________________________________________________________________________
+ [ 3186] By: gsar on 1999/03/28 07:26:33
+ Log: ensure XS_LOCKS stuff happens *before* XSUB is entered under
+ -DPERL_CAPI
+ Branch: maint-5.005/perl
+ ! XSlock.h win32/GenCAPI.pl win32/Makefile win32/makefile.mk
+ ____________________________________________________________________________
+ [ 3185] By: gbarr on 1999/03/28 06:37:41
+ Log: integrate change #2846 from mainline
+
+ a modified version of suggested patch for pack template 'Z'; added docs
+ From: "Valeriy E. Ushakov" <uwe@ptc.spbu.ru>
+ Date: Mon, 16 Jun 1997 03:00:31 +0400 (MSD)
+ Message-ID: <%lOHpzIuGV@snark.ptc.spbu.ru>
+ Subject: lack of pack/unpack letter with useful symmetry for C null delimited strings
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod pod/perlfunc.pod pp.c
+ !> t/op/pack.t
+ ____________________________________________________________________________
+ [ 3184] By: gbarr on 1999/03/28 06:35:50
+ Log: integrate change # 3160 from mainline
+
+ better description of OP_UNSTACK (s/unstack/iteration finalizer/)
+ Branch: maint-5.005/perl
+ ! opcode.h opcode.pl
+ ____________________________________________________________________________
+ [ 3182] By: gbarr on 1999/03/28 03:40:28
+ Log: Integrate changes #3067 and #3106 from mainline
+
+ exempt $foo::a,$foo::b from warnings only if sort() was seen in package foo
+ From: Graham Barr <gbarr@ti.com>
+ Date: Wed, 3 Mar 1999 17:23:56 -0600
+ Message-ID: <19990303172356.F7442@dal.asp.ti.com>
+ Subject: Re: 'use strict' doesn't work for one-letter variables
+
+ change#3067 failed package.t due to needless creation of $a and $b;
+ fixed to do that only for C<sort BLOCK|CODE @foo>, not C<sort(@foo)>
+ Branch: maint-5.005/perl
+ ! gv.c op.c t/pragma/warn-1global
+ ____________________________________________________________________________
+ [ 3179] By: gsar on 1999/03/28 02:14:04
+ Log: fix thread segfault when passing large number of arguments to child
+ a la C<Thread->new($foo, 1..1000)>
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs t/lib/thread.t
+ ____________________________________________________________________________
+ [ 3178] By: gbarr on 1999/03/28 01:39:23
+ Log: fix $Config{'usethreads'} typo in perlthrtut
+
+ From: Ian Maloney <szhmf9@wsblob.ubs.com>
+ Date: Thu, 25 Mar 1999 16:40:14 +0100 (MET)
+ Message-Id: <199903251540.QAA02439@wsblob.>
+ Subject: perlthrtut documentation error
+ Branch: maint-5.005/perl
+ ! pod/perlthrtut.pod
+ ____________________________________________________________________________
+ [ 3177] By: gbarr on 1999/03/28 01:09:59
+ Log: Integrate #2910 from mainline
+
+ slurping an empty file should return '' rather than undef, with
+ commensurate effects on ARGV processing
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod pp_hot.c sv.h
+ !> t/io/argv.t
+ ____________________________________________________________________________
+ [ 3176] By: gbarr on 1999/03/28 00:00:30
+ Log: Integrate relevant doc changes from mainline
+ Branch: maint-5.005/perl
+ !> (integrate 34 files)
+ ____________________________________________________________________________
+ [ 3175] By: gbarr on 1999/03/27 19:20:32
+ Log: Integrated #2352 and #2397 from mainline
+
+ Implement $^C to allow perl access to -c flag - I think this
+ was agreed once...
+
+ Update docs and English.pm for $^C
+ Branch: maint-5.005/perl
+ ! gv.c mg.c
+ !> lib/English.pm
+ ____________________________________________________________________________
+ [ 3174] By: gbarr on 1999/03/27 18:21:01
+ Log: Update Copyright year
+ Branch: maint-5.005/perl
+ ! EXTERN.h INTERN.h README av.c av.h cop.h cv.h deb.c doio.c
+ ! doop.c dump.c form.h gv.c gv.h handy.h hv.c hv.h mg.c mg.h
+ ! op.c op.h perl.h perly.y pp.c pp.h pp_ctl.c pp_hot.c pp_sys.c
+ ! regcomp.c regexec.c run.c scope.c sv.c sv.h toke.c util.c
+ ! util.h
+ ____________________________________________________________________________
+ [ 3173] By: gbarr on 1999/03/27 18:19:47
+ Log: Update Test.pm to VERSION 1.122 from CPAN
+ Branch: maint-5.005/perl
+ ! lib/Test.pm
+ ____________________________________________________________________________
+ [ 3154] By: jhi on 1999/03/24 21:40:51
+ Log: Reword the shared library search path (LD_LIBRARY_PATH) info
+ based on suggestions from Andy Dougherty.
+ Branch: maint-5.005/perl
+ ! INSTALL
+ ____________________________________________________________________________
+ [ 3146] By: jhi on 1999/03/24 09:20:14
+ Log: Bring in changes #2808 and #2812 (from mainline perl)
+ that enhance the perlbug checklist.
+ Branch: maint-5.005/perl
+ ! utils/perlbug.PL
+ ____________________________________________________________________________
+ [ 3130] By: jhi on 1999/03/23 22:02:23
+ Log: Don't use config.msg to remind about the
+ LD_LIBRARY_PATH because Makefile.SH takes
+ care of that.
+
+ Use shrplib in DEC O^W^Digital U^W^WTru64 UNIX.
+ This used to be the default but in some MT or another it
+ was dropped because of some transient error or another.
+ Branch: maint-5.005/perl
+ ! Configure hints/dec_osf.sh
+ ____________________________________________________________________________
+ [ 3122] By: jhi on 1999/03/19 21:12:14
+ Log: Describe the new Benchmark feature in more detail.
+ Branch: cfgperl
+ ! pod/perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 3121] By: jhi on 1999/03/19 08:16:12
+ Log: AVAILABILITY tuning.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 3119] By: jhi on 1999/03/17 14:33:43
+ Log: More Apollo fixes.
+ Branch: maint-5.005/perl
+ ! README.apollo hints/apollo.sh t/lib/io_udp.t
+ ____________________________________________________________________________
+ [ 3118] By: jhi on 1999/03/16 17:23:39
+ Log: Nada.
+ Branch: maint-5.005/perl
+ ! README.apollo
+ ____________________________________________________________________________
+ [ 3117] By: jhi on 1999/03/16 17:18:49
+ Log: Apollo DomainOS AVAILABILITY.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 3116] By: jhi on 1999/03/16 17:14:00
+ Log: Apollo DomainOS patch
+ From: Johann Klasek <jk@auto.tuwien.ac.at>
+ Subject: Re: DomainPerl
+ Date: Tue, 16 Mar 1999 17:46:32 +0100
+ Message-ID: <19990316174632.A19759@euklid.auto.tuwien.ac.at>
+ Branch: maint-5.005/perl
+ + README.apollo apollo/netinet/in.h
+ ! MANIFEST hints/apollo.sh
+ ____________________________________________________________________________
+ [ 3115] By: jhi on 1999/03/16 14:23:54
+ Log: From: Paul Marquess <pmarquess@bfsec.bt.co.uk>
+ To: Gurusamy Sarathy <gsar@activestate.com>,
+ Graham Barr <gbarr@pobox.com>
+ Cc: Perl5 Porters <perl5-porters@perl.org>,
+ "Paul.Marquess" <Paul.Marquess@btinternet.com>
+ Subject: [PATCH 5.005_56 & 5.005_03_T6] Upgrade DB_File to version 1.65
+ Date: Sun, 14 Mar 1999 14:43:57 -0000
+ Message-Id: <199903141841.NAA17040@defender.perl.org>
+ Branch: maint-5.005/perl
+ ! ext/DB_File/Changes ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/typemap
+ ____________________________________________________________________________
+ [ 3114] By: jhi on 1999/03/16 12:42:20
+ Log: Mention Rhapsody in 5.005_5X perldelta,
+ and in Rhapsody and Netware in 5.005_0X and 5.005_5X
+ *planned* AVAILABILITY.
+ Branch: cfgperl
+ ! pod/perl.pod pod/perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 3113] By: jhi on 1999/03/16 10:38:53
+ Log: perldelta niggling.
+ Branch: cfgperl
+ ! pod/perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 3111] By: jhi on 1999/03/16 10:28:10
+ Log: AVAILABILITY update: still mention PowerUX,
+ Novell Netware now has sources available.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 3105] By: jhi on 1999/03/12 15:54:57
+ Log: Recognize the NetBSD packages collection.
+ Branch: maint-5.005/perl
+ ! hints/netbsd.sh
+ ____________________________________________________________________________
+ [ 3104] By: jhi on 1999/03/12 09:07:04
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ To: jhi@iki.fi, perl-mvs@perl.org, perlbug@perl.com
+ Subject: [PATCH MT6,_56] was Re: Not OK: perl 5.00503 +MAINT_TRIAL_6 on os390 06.00 (UNINSTALLED)
+ Date: Thu, 11 Mar 99 14:24:54 PST
+ Message-Id: <9903112224.AA24346@forte.com>
+ Branch: maint-5.005/perl
+ ! README.os390 t/lib/posix.t
+ ____________________________________________________________________________
+ [ 3102] By: jhi on 1999/03/10 11:01:20
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ To: perl5-porters@perl.org
+ Subject: [5.005_03-MT6]Patch: time passes
+ Date: Tue, 9 Mar 99 18:42:17 PST
+ Message-Id: <9903100242.AA29057@forte.com>
+ Branch: maint-5.005/perl
+ ! perl.c
+ ____________________________________________________________________________
+ [ 3101] By: jhi on 1999/03/10 10:30:15
+ Log: From: Mark-Jason Dominus <mjd@plover.com>
+ To: perl5-porters@perl.com
+ Subject: Minor fix to perlfunc.pod
+ Date: Mon, 08 Mar 1999 20:05:53 -0500
+ Message-ID: <19990309010553.13757.qmail@plover.com>
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+ ____________________________________________________________________________
+ [ 3094] By: jhi on 1999/03/06 16:16:15
+ Log: From: Mark Kettenis <kettenis@wins.uva.nl>
+ To: jhi@iki.fi
+ Subject: Oops
+ Date: Sat, 6 Mar 1999 17:15:35 +0100 (CET)
+ Message-Id: <199903061615.RAA00207@delius.kettenis.nl>
+ Branch: maint-5.005/perl
+ ! README.hurd
+ ____________________________________________________________________________
+ [ 3093] By: jhi on 1999/03/06 15:59:46
+ Log: From: Mark Kettenis <kettenis@wins.uva.nl>
+ To: jhi@iki.fi
+ Subject: New Hurd README
+ Date: Sat, 6 Mar 1999 16:46:12 +0100 (CET)
+ Message-Id: <199903061601.RAA00185@delius.kettenis.nl>
+ Branch: maint-5.005/perl
+ ! README.hurd
+ ____________________________________________________________________________
+ [ 3092] By: jhi on 1999/03/06 12:52:06
+ Log: From: Paul_Green@stratus.com
+ To: perl5-porters@perl.org
+ Cc: jhi@iki.fi, Paul_Green@stratus.com
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_6]: platform: vos -- updates to VOS port of Perl5
+ Date: Fri, 5 Mar 1999 18:08:49 -0500
+ Message-ID: <1D1A4EF7AD4DD211A80D00A0C9D7DB665A035A@exna1.stratus.com>
+ Branch: maint-5.005/perl
+ ! vos/config.h vos/config_h.SH_orig
+ ____________________________________________________________________________
+ [ 3091] By: jhi on 1999/03/06 12:42:21
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org, vmsperl@perl.org
+ Subject: [PATCH 5.005_03-MT6]VMS build patch
+ Date: Fri, 05 Mar 1999 12:36:19 -0800
+ Message-Id: <3.0.6.32.19990305123619.02d326a0@ous.edu>
+ Branch: maint-5.005/perl
+ ! vms/subconfigure.com
+ ____________________________________________________________________________
+ [ 3090] By: gsar on 1999/03/06 04:40:03
+ Log: integrate change#3089 from mainline
+
+ tolerate CRs after options
+ Branch: maint-5.005/perl
+ !> perl.c
+ ____________________________________________________________________________
+ [ 3086] By: gbarr on 1999/03/05 01:48:05
+ Log: #3085 was a bit premature, this is MT6 as 2 files were
+ missing from MANIFEST
+ Branch: maint-5.005/perl
+ ! MANIFEST
+ ____________________________________________________________________________
+ [ 3085] By: gbarr on 1999/03/05 01:41:06
+ Log: Trial release 6
+ Branch: maint-5.005/perl
+ ! Changes
+ ____________________________________________________________________________
+ [ 3084] By: gbarr on 1999/03/05 01:34:07
+ Log: Don't process - as a file in Errno_pm.PL
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Thu, 4 Mar 1999 13:29:23 +0200 (EET)
+ Message-ID: <14046.28307.561693.849859@alpha.hut.fi>
+ Subject: Re: maint-5.005
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL
+ ____________________________________________________________________________
+ [ 3081] By: gsar on 1999/03/05 00:14:33
+ Log: protect against doubled backslashes
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL
+ ____________________________________________________________________________
+ [ 3080] By: gsar on 1999/03/04 23:37:20
+ Log: pick up AIX hints from mainline
+ Branch: maint-5.005/perl
+ !> hints/aix.sh
+ ____________________________________________________________________________
+ [ 3079] By: gsar on 1999/03/04 21:09:43
+ Log: tweak cast and crew
+ Branch: maint-5.005/perl
+ ! Changes
+ ____________________________________________________________________________
+ [ 3078] By: gsar on 1999/03/04 21:03:04
+ Log: update patchlevel, Changes
+ Branch: maint-5.005/perl
+ ! Changes README.win32 patchlevel.h
+ !> pod/perlhist.pod
+ ____________________________________________________________________________
+ [ 3075] By: gsar on 1999/03/04 07:36:53
+ Log: integrate changes#3037,3041 from mainline
+
+ fix longstanding bug: searches for lexicals originating within eval''
+ weren't stopping at the subroutine boundary correctly
+ --
+ fix subtle bug in eval'' testsuite
+ Branch: maint-5.005/perl
+ !> op.c proto.h t/op/eval.t
+ ____________________________________________________________________________
+ [ 3074] By: gsar on 1999/03/04 07:32:15
+ Log: integrate change#3048 from mainline
+
+ updated HP-UX notes from Jeff Okamoto <okamoto@xfiles.intercon.hp.com>
+ Branch: maint-5.005/perl
+ !> MANIFEST README.hpux
+ ____________________________________________________________________________
+ [ 3073] By: gsar on 1999/03/04 07:29:43
+ Log: integrate changes#3014,3015,3021,3032,3034,3045 from mainline
+
+ more "correct" utbuf for utime()
+ --
+ avoid modifying readonly values from qw()
+ --
+ ansify perlio.c, fix PerlIO-ish typos
+ --
+ add README.hpux
+ --
+ s/print STDERR/warn/ suggested by abigail@fnx.com; add $VERSION
+ --
+ destroy PL_svref_mutex in perl_destruct()
+ Branch: maint-5.005/perl
+ +> README.hpux
+ !> MANIFEST doio.c ext/DynaLoader/dl_beos.xs
+ !> ext/DynaLoader/dl_cygwin32.xs iperlsys.h
+ !> lib/ExtUtils/MM_Unix.pm lib/Getopt/Std.pm perl.c perlio.c
+ ____________________________________________________________________________
+ [ 3072] By: gsar on 1999/03/04 07:12:15
+ Log: integrate changes#2978,2979 from mainline
+
+ bring '*' prototype closer to how it behaves internally
+ --
+ doc for change#2978
+ Branch: maint-5.005/perl
+ +> t/lib/fatal.t
+ !> MANIFEST lib/Fatal.pm op.c pod/perlsub.pod t/comp/proto.t
+ ____________________________________________________________________________
+ [ 3071] By: gsar on 1999/03/04 07:05:50
+ Log: integrate changes#2919,2920,2921,2928,2932,2933 from mainline
+
+ applied suggested patch, with several language/readability tweaks
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 29 Jan 1999 00:25:02 -0500
+ Message-ID: <19990129002502.C2898@monk.mps.ohio-state.edu>
+ Subject: Re: [PATCH 5.005_*] Better parsing docs
+ --
+ tweak READ() docs to mention $buffer must be altered by reference
+ --
+ use New() et al., rather than safemalloc() et al.
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Fri, 29 Jan 1999 23:27:22 +0100
+ Message-ID: <36bd33f2.51029616@smtp1.ibm.net>
+ Subject: [PATCH _03-MT5] POSIX.xs memory API
+ --
+ allow the Carp routines to pass through exception objects
+ --
+ clarify what a "line" is
+ --
+ From: "J. van Krieken" <John.van.Krieken@ATComputing.nl>
+ Date: Thu, 4 Feb 1999 17:25:25 +0100 (MET)
+ Message-Id: <199902041625.RAA14489@atcmpg.ATComputing.nl>
+ Subject: s2p incorrectly handles hold space commands
+ Branch: maint-5.005/perl
+ !> ext/POSIX/POSIX.xs lib/Carp.pm pod/perlfunc.pod pod/perlop.pod
+ !> pod/perltie.pod pod/perlvar.pod x2p/s2p.PL
+ ____________________________________________________________________________
+ [ 3070] By: gsar on 1999/03/04 06:43:57
+ Log: integrate changes#2748,2753,2754,2819,2824,2855,2866,2867,2869,2885,2888,2889
+ from mainline
+
+ From: "Jonathan I. Kamens" <jik@kamens.brookline.ma.us>
+ Date: Thu, 3 Dec 1998 15:10:17 -0500
+ Message-Id: <199812032010.PAA09692@jik.shore.net>
+ Subject: sample checksum code in "perlfunc" man page is wrong
+ --
+ Todo tweaks
+ --
+ Todo updates from Andy Dougherty <doughera@lafayette.edu>
+ --
+ avoid garbage in db->dirbuf
+ From: Masahiro KAJIURA <masahiro.kajiura@toshiba.co.jp>
+ Date: Sat, 05 Dec 1998 14:14:54 +0900
+ Message-Id: <199812050514.OAA23268@toshiba.co.jp>
+ Subject: SDBM bug
+ --
+ tweak doc on bitwise ops
+ --
+ applied suggested patch; added tests
+ From: Adam Krolnik <adamk@gypsy.cyrix.com>
+ Date: Sat, 12 Dec 98 15:30:18 -0600
+ Message-Id: <9812122130.AA03717@gypsy.eng.cyrix.com>
+ Subject: Range operation doesn't handle IV_MAX
+ --
+ display full pathname of unreadable files
+ --
+ av_extend() doc tweak from Jan Dubois
+ --
+ update win32/pod.mak
+ --
+ note how to find REG_INFTY limit
+ --
+ add note about test-notty target
+ --
+ tweak PERL_STRICT_CR notes
+ Branch: maint-5.005/perl
+ !> Porting/pumpkin.pod README.win32 Todo Todo-5.005
+ !> ext/SDBM_File/sdbm/sdbm.c pod/perldelta.pod pod/perlfunc.pod
+ !> pod/perlguts.pod pod/perlop.pod pod/perlre.pod pp_ctl.c
+ !> t/op/range.t utils/perldoc.PL win32/pod.mak
+ ____________________________________________________________________________
+ [ 3069] By: gsar on 1999/03/04 06:02:29
+ Log: integrate change#2747 from mainline
+
+ typos in Pod/Text.pm
+ Branch: maint-5.005/perl
+ !> lib/Pod/Text.pm
+ ____________________________________________________________________________
+ [ 3059] By: jhi on 1999/03/03 22:46:43
+ Log: Document HP-UX 11 Y2K patch effect, based on
+
+ From: "Richard L. England" <richard_england@mentorg.com>
+ To: perlbug@perl.com
+ CC: "England, Richard" <richard_england@mentorg.com>
+ Subject: test io/fs.t number 18 fails on HPUX 11.0 when Y2K patch installed.
+ Date: Fri, 26 Feb 1999 15:35:49 -0800
+ Message-ID: <36D72FD4.4136C84F@mentorg.com>
+ Branch: maint-5.005/perl
+ ! INSTALL
+ ____________________________________________________________________________
+ [ 3057] By: jhi on 1999/03/03 21:42:22
+ Log: The *symbols patch (for Kurt's h2ph fixes) haunted us in AIX.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 3056] By: jhi on 1999/03/03 21:21:46
+ Log: Fixed the pthreads_created_joinable test messed up
+ by the Mach cthreads change.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 3055] By: jhi on 1999/03/03 18:17:55
+ Log: Configure and make gotchas.
+ Branch: maint-5.005/perl
+ ! INSTALL
+ ____________________________________________________________________________
+ [ 3051] By: jhi on 1999/03/02 08:24:52
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org, vmsperl@perl.org
+ Subject: [PATCH 5.005_0x and 5.005_5x]Minor update to README.VMS
+ Date: Mon, 01 Mar 1999 16:10:57 -0800
+ Message-Id: <3.0.6.32.19990301161057.03b1fc00@ous.edu>
+ Branch: cfgperl
+ ! README.vms
+ Branch: maint-5.005/perl
+ ! README.vms
+ ____________________________________________________________________________
+ [ 3049] By: jhi on 1999/03/02 07:34:21
+ Log: From: Spider Boardman <spider@leggy.zk3.dec.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH] Eliminate (valid) warning in byterun.c
+ Date: Mon, 01 Mar 1999 17:27:59 -0500
+ Message-Id: <199903012227.RAA00181@leggy.zk3.dec.com>
+ Branch: cfgperl
+ ! bytecode.h
+ Branch: maint-5.005/perl
+ ! bytecode.h
+ ____________________________________________________________________________
+ [ 3028] By: jhi on 1999/02/26 14:40:00
+ Log: HP-UX 11 threads.
+
+ From: Jeff Okamoto <okamoto@xfiles.intercon.hp.com>
+ To: perl5-porters@perl.org
+ Cc: jhi@cc.hut.fi
+ Subject: Maint 5 and _54 with threading on HP-UX 11.00
+ Date: Wed, 3 Feb 1999 12:57:18 -0800 (PST)
+ Message-Id: <199902032057.MAA10218@xfiles.intercon.hp.com>
+
+ NOTE from jhi: the hpux hints could still be more robust by
+ disabling gdbm when necessary.
+
+ Currently if there's a libgdbm.sl (gdbm 1.7.3) which is pre-11,
+ linking -lgdbm -lpthread creates an executable that instantly
+ core dumps on a pthreads internal panic:
+
+ ./gdpt
+
+ Pthread internal error: message: __libc_reinit() failed, file: ../pthreads/pthread.c, line: 1096
+ Return Pointer is 0xc082bf33
+ 17639 quit (core dumped) ./gdpt
+
+ You don't have to *use* either gdbm or pthreads in the executable,
+ just linking them together is enough. Workaround is to recompile
+ the GDBM under HP-UX 11, that makes the problem to go away.
+ Branch: maint-5.005/perl
+ ! hints/hpux.sh thread.h
+ ____________________________________________________________________________
+ [ 3027] By: jhi on 1999/02/26 09:04:29
+ Log: From: abigail@fnx.com
+ To: perl5-porters@perl.org (Perl Porters)
+ Subject: [PATCH 5.005_02 Getopt::Std] warn() instead of print STDERR.
+ Date: Thu, 25 Feb 1999 22:08:41 -0500 (EST)
+ Message-ID: <19990226030841.5985.qmail@alexandra.wayne.fnx.com>
+ Branch: maint-5.005/perl
+ ! lib/Getopt/Std.pm
+ ____________________________________________________________________________
+ [ 3026] By: jhi on 1999/02/26 08:18:26
+ Log: full_ar wasn't propagated.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 3013] By: jhi on 1999/02/22 19:27:44
+ Log: Fix MacPerl version, change PowerUX to PowerMAX.
+
+ From: Chris Nandor <pudge@pobox.com>
+ To: jhi@iki.fi
+ Cc: perl5-porters@perl.org
+ Subject: Re: perl current availability as documented by perl.pod
+ Date: Sun, 21 Feb 1999 11:06:03 -0500
+ Message-Id: <v04020a07b2f5df60c9e3@[192.168.0.77]>
+
+ From: Tom Horsley <Tom.Horsley@mail.ccur.com>
+ To: jhi@iki.fi
+ Cc: perl5-porters@perl.org
+ Subject: Re: perl current availability as documented by perl.pod
+ Date: Mon, 22 Feb 1999 13:08:30 GMT
+ Message-Id: <199902221308.NAA19971@cleo.ccur.com>
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 3010] By: jhi on 1999/02/22 10:21:55
+ Log: From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ To: gbarr@pobox.com (Graham Barr)
+ Cc: perl5-porters@perl.org
+ Subject: [PATCH 5.005_03-MT5] DB_File 1.64 patch
+ Date: Mon, 22 Feb 1999 10:12:34 +0000 (GMT)
+ Message-Id: <9902221012.AA17784@claudius.bfsec.bt.co.uk>
+ Branch: maint-5.005/perl
+ ! ext/DB_File/Changes ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/typemap t/lib/db-recno.t
+ ____________________________________________________________________________
+ [ 3005] By: jhi on 1999/02/22 08:35:30
+ Log: Configure/Perl knew how to look for use Mach cthreads
+ but Configure didn't let them to be used ($osname 'next').
+ Branch: cfgperl
+ ! Configure config_h.SH
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 3004] By: jhi on 1999/02/21 15:46:02
+ Log: Update Acorn AVAILABILITY.
+ Branch: cfgperl
+ ! pod/perl.pod
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 3003] By: jhi on 1999/02/21 14:50:42
+ Log: From: rjk@linguist.dartmouth.edu (Ronald J. Kimball)
+ To: perl5-porters@perl.org (Perl 5 Porters)
+ Subject: PATCH: perlref.pod - symbolic ref example
+ Date: Sat, 20 Feb 1999 17:32:11 -0500 (EST)
+ Message-Id: <199902202232.RAA62306@linguist.dartmouth.edu>
+ Branch: cfgperl
+ ! pod/perlref.pod
+ Branch: maint-5.005/perl
+ ! pod/perlref.pod
+ ____________________________________________________________________________
+ [ 3000] By: jhi on 1999/02/21 14:15:31
+ Log: pack s/l for negative numbers was broken on platforms
+ where sizeof(short) != 2 or sizeof(long) != 4 (Alpha, Cray).
+ pack v was broken for sizeof(short) == 8 big-endian platforms
+ (Cray), only zeros were produced.
+ Branch: maint-5.005/perl
+ ! perl.h pod/perlfunc.pod pp.c t/op/pack.t
+ ____________________________________________________________________________
+ [ 2997] By: jhi on 1999/02/20 14:00:26
+ Log: Glossary update.
+ Branch: maint-5.005/perl
+ ! Porting/Glossary
+ ____________________________________________________________________________
+ [ 2995] By: jhi on 1999/02/20 12:25:10
+ Log: Document #2893, Mach cthreads support.
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2986] By: jhi on 1999/02/19 23:26:34
+ Log: Remove the unnecessary osf1 -D__LANGUAGE_C__.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2983] By: jhi on 1999/02/19 20:35:51
+ Log: Mach cthreads:
+ From: brie@corp.home.net (Brian Harrison)
+ Subject: perl5.005_02 patch for mthreads
+ To: perl5-porters@perl.org
+ Date: Fri, 23 Oct 1998 14:20:57 -0700 (PDT)
+ Message-ID: <Pine.GSO.4.04.9810231410220.11111-200000@sulaco.eos.home.net>
+ Branch: maint-5.005/perl
+ ! Configure Porting/Glossary config_h.SH malloc.c perl.h
+ ! thread.h
+ ____________________________________________________________________________
+ [ 2981] By: jhi on 1999/02/19 19:49:03
+ Log: From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ To: Chaim Frenkel <chaimf@pobox.com>,
+ Russ Allbery <rra@stanford.edu>,
+ Jarkko Hietaniemi <jhi@iki.fi>,
+ Gurusamy Sarathy <gsar@activestate.com>,
+ Graham Barr <gbarr@pobox.com>
+ Cc: bdensch@ameritech.net, perlbug@perl.com
+ Subject: [PATCH] Re: Solaris 7 for Intel
+ Message-ID: <19990219124404.A30182@O2.chapin.edu>
+
+ and Glossary update.
+ Branch: maint-5.005/perl
+ ! Configure Makefile.SH Porting/Glossary
+ ____________________________________________________________________________
+ [ 2980] By: gbarr on 1999/02/19 16:06:53
+ Log: Make result of h2xs work when user adds C<use strict>
+ Branch: maint-5.005/perl
+ ! utils/h2xs.PL
+ ____________________________________________________________________________
+ [ 2976] By: gsar on 1999/02/18 21:54:09
+ Log: integrate change#2975 from mainline
+
+ distinguish eval'' from BEGIN|INIT|END CVs (fixes buggy propagation
+ of lexical searches in BEGIN|INIT|END)
+ Branch: maint-5.005/perl
+ !> cop.h cv.h op.c perly.c perly.y pp_ctl.c t/op/misc.t
+ !> vms/perly_c.vms
+ ____________________________________________________________________________
+ [ 2971] By: jhi on 1999/02/18 11:14:24
+ Log: AIX syscalls.exp scan missed explicitly 32/64-bit syscalls.
+
+ From: Joe Buehler <jhpb@hekimian.com>
+ To: perl5-porters@perl.org
+ Subject: setsid not detected by perl 5.005_02 configure under AIX 4.3
+ Date: 12 Feb 1999 11:25:21 -0500
+ Message-ID: <yd3lni3613i.fsf@ganymede.hekimian.com>
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2967] By: jhi on 1999/02/17 23:12:59
+ Log: Make SCO/Unixware scan to work in Unixware, too.
+
+ From: Tom Hughes <thh@cyberscience.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00555 on i386-svr4 [actually Unixware 2.1] (UNINSTALLED)
+ Date: 17 Feb 1999 15:34:15 +0000
+ Message-ID: <yekg185nix4.fsf@elva.cyberscience.com>
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2956] By: jhi on 1999/02/15 21:03:28
+ Log: OpenBSD sparc SHMLBA (like change #2945).
+ Branch: maint-5.005/perl
+ ! ext/IPC/SysV/SysV.xs
+ ____________________________________________________________________________
+ [ 2950] By: jhi on 1999/02/15 13:37:28
+ Log: AVAILABILITY sync.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2906] By: jhi on 1999/02/13 14:55:47
+ Log: AVAILABILITY sync.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2905] By: gsar on 1999/02/13 00:12:53
+ Log: integrate change#2898 from mainline
+
+ support win32_putenv()
+ Branch: maint-5.005/perl
+ !> mg.c util.c win32/GenCAPI.pl win32/makedef.pl win32/perlhost.h
+ !> win32/win32.c win32/win32iop.h
+ ____________________________________________________________________________
+ [ 2904] By: jhi on 1999/02/12 21:23:30
+ Log: Add README.hurd, from Mark Kettenis <kettenis@wins.uva.nl>.
+ Branch: maint-5.005/perl
+ + README.hurd
+ ! MANIFEST
+ ____________________________________________________________________________
+ [ 2900] By: jhi on 1999/02/12 12:07:28
+ Log: SCO ODT/OSR release scanning.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2897] By: jhi on 1999/02/12 11:24:25
+ Log: Undo a big bad paste from change #2884.
+ Branch: maint-5.005/perl
+ ! hints/openbsd.sh
+ ____________________________________________________________________________
+ [ 2896] By: jhi on 1999/02/12 11:19:52
+ Log: Update the error message of db-recno.t to DB version 1.86
+ and the URL to www.sleepycat.com instead of www.bostic.com.
+ Branch: maint-5.005/perl
+ ! t/lib/db-recno.t
+ ____________________________________________________________________________
+ [ 2895] By: gsar on 1999/02/12 11:18:59
+ Log: integrate change#2854 from mainline
+
+ compatibility fix: magic non-propagation in foreach implicit localization
+ Branch: maint-5.005/perl
+ !> pp_ctl.c t/op/local.t
+ ____________________________________________________________________________
+ [ 2884] By: jhi on 1999/02/12 08:36:14
+ Log: OpenBSD pthreads awareness, thanks to
+ David Leonard <david.leonard@csee.uq.edu.au>
+ Branch: maint-5.005/perl
+ ! Configure hints/openbsd.sh
+ ____________________________________________________________________________
+ [ 2883] By: jhi on 1999/02/12 08:29:51
+ Log: AVAILABILITY sync.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2878] By: jhi on 1999/02/11 22:00:50
+ Log: Replace changes #2783, #2784, #2785, with a single tested
+ patch from Francois Desarmenien <desar@club-internet.fr>.
+ Branch: maint-5.005/perl
+ ! MANIFEST ext/GDBM_File/hints/sco.pl ext/IPC/SysV/SysV.xs
+ ! hints/sco.sh
+ ____________________________________________________________________________
+ [ 2876] By: jhi on 1999/02/11 20:43:17
+ Log: From: Chris Nandor <pudge@pobox.com>
+ To: perl5-porters@perl.org
+ Subject: [PATCH] perlport.pod 1.39
+ Date: Thu, 11 Feb 1999 12:28:35 -0500
+ Message-Id: <v04020a2db2e8c3177123@[192.168.0.77]>
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+ ____________________________________________________________________________
+ [ 2875] By: jhi on 1999/02/11 20:35:08
+ Log: The fpsetmask() really is SCO5 only.
+ Branch: maint-5.005/perl
+ ! unixish.h
+ ____________________________________________________________________________
+ [ 2874] By: jhi on 1999/02/11 20:32:06
+ Log: Change #2783 missed these.
+ Branch: maint-5.005/perl
+ ! ext/IPC/SysV/SysV.xs unixish.h
+ ____________________________________________________________________________
+ [ 2873] By: jhi on 1999/02/11 20:27:45
+ Log: Import the change #2810 from cfgperl.
+ Branch: maint-5.005/perl
+ + ext/GDBM_File/hints/sco.pl
+ ! MANIFEST hints/sco.sh unixish.h
+ ____________________________________________________________________________
+ [ 2872] By: jhi on 1999/02/11 19:57:37
+ Log: Sync the current AVAILABILITY.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2871] By: jhi on 1999/02/11 19:42:54
+ Log: Copied the GNU/Hurd hints file over from cfgperl
+ because it works well enough (there are still some
+ rough edges in Hurd), verified via private
+ email from Mark Kettenis <kettenis@wins.uva.nl>
+ Branch: maint-5.005/perl
+ + hints/gnu.sh
+ ____________________________________________________________________________
+ [ 2864] By: jhi on 1999/02/11 08:45:00
+ Log: From: Spider Boardman <spider@zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on RISC-ultrix 4.4 (UNINSTALLED)
+ Date: Wed, 10 Feb 1999 23:33:31 -0500
+ Message-Id: <9902110433.AA12816@abyss.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! doio.c ext/IPC/SysV/SysV.xs hints/ultrix_4.sh
+ ____________________________________________________________________________
+ [ 2863] By: jhi on 1999/02/11 08:35:35
+ Log: AVAILABILITY.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2858] By: gsar on 1999/02/11 07:10:59
+ Log: remove dup hunk
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2857] By: gsar on 1999/02/11 07:09:20
+ Log: sync with parent version of perldelta.pod
+ Branch: maint-5.005/perl
+ !> pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2853] By: gsar on 1999/02/11 00:33:06
+ Log: integrate change#2816 from mainline
+
+ minor bug in dumping blessed subrefs
+ Branch: maint-5.005/perl
+ !> ext/Data/Dumper/Dumper.pm
+ ____________________________________________________________________________
+ [ 2852] By: gsar on 1999/02/10 23:17:49
+ Log: fair warning about -Dusethreads
+ Branch: maint-5.005/perl
+ ! Configure INSTALL README.threads
+ ____________________________________________________________________________
+ [ 2851] By: jhi on 1999/02/10 23:00:39
+ Log: Snapshot of the ongoing AVAILABILITY discussion.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2850] By: jhi on 1999/02/10 16:07:32
+ Log: OS390 and Windows AVAILABILITY entries enhanced.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2849] By: jhi on 1999/02/10 12:39:46
+ Log: AS/400 and Mac were not described right.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2848] By: jhi on 1999/02/10 09:13:49
+ Log: Added AVAILABILITY section.
+ Branch: maint-5.005/perl
+ ! pod/perl.pod
+ ____________________________________________________________________________
+ [ 2837] By: jhi on 1999/02/08 14:51:39
+ Log: Fix typo introduced in change #2836.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2836] By: jhi on 1999/02/08 14:44:31
+ Log: Augment change #2809, the h2ph-*symbols patch.
+ Branch: maint-5.005/perl
+ ! Configure t/lib/h2ph.pht
+ ____________________________________________________________________________
+ [ 2815] By: gsar on 1999/02/05 03:44:50
+ Log: integrate change#2242 from mainline
+
+ fix skipspace() to properly account for newlines in eval''-ed
+ strings (caused bogus line numbers in diagnostics and debugger)
+ Branch: maint-5.005/perl
+ !> toke.c
+ ____________________________________________________________________________
+ [ 2814] By: jhi on 1999/02/04 21:21:39
+ Log: Stratus perlport update.
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+ ____________________________________________________________________________
+ [ 2813] By: jhi on 1999/02/04 21:16:54
+ Log: Stratus VOS update.
+
+ From: Paul_Green@stratus.com
+ To: jhi@iki.fi
+ Subject: RE: VOS changes for Perl5.005_03 are ready!
+ Date: Thu, 4 Feb 1999 14:51:07 -0500
+ Message-ID: <1D1A4EF7AD4DD211A80D00A0C9D7DB665A0168@exna1.stratus.com>
+ Branch: maint-5.005/perl
+ + vos/vos_accept.c
+ ! MANIFEST README.vos perl.c pod/perlport.pod vos/Changes
+ ! vos/build.cm vos/compile_perl.cm vos/config.h
+ ! vos/config_h.SH_orig vos/perl.bind vos/test_vos_dummies.c
+ ! vos/vos_dummies.c vos/vosish.h
+ ____________________________________________________________________________
+ [ 2809] By: jhi on 1999/02/03 19:54:16
+ Log: h2ph fixes + Configure patch to support them.
+
+ From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ To: Graham Barr <gbarr@pobox.com>, Jarkko Hietaniemi <jhi@iki.fi>,
+ Gurusamy Sarathy <gsar@engin.umich.edu>
+ Cc: perl5-porters@perl.org
+ Subject: [PATCH 5.00503_MT5] h2ph.PL
+ Date: Tue, 2 Feb 1999 19:48:06 -0500
+ Message-ID: <19990202194806.E10647@O2.chapin.edu>
+ Branch: maint-5.005/perl
+ ! Configure utils/h2ph.PL
+ ____________________________________________________________________________
+ [ 2802] By: jhi on 1999/02/02 17:41:23
+ Log: From: John Bley <jbb6@acpub.duke.edu>
+ To: perlbug@perl.org
+ Subject: [PATCH]5.005_54 (DOC) fix minor typos
+ Date: Tue, 2 Feb 1999 07:52:52 -0500 (EST)
+ Message-ID: <Pine.SOL.3.91.990202075115.23589A-100000@soc11.acpub.duke.edu>
+ Branch: maint-5.005/perl
+ ! pod/perlre.pod
+ ____________________________________________________________________________
+ [ 2790] By: jhi on 1999/02/02 16:51:45
+ Log: Re-introduce the typo corrections (update to CGI 2.46
+ overran them).
+ Branch: maint-5.005/perl
+ ! lib/CGI.pm
+ ____________________________________________________________________________
+ [ 2781] By: jhi on 1999/02/02 14:27:01
+ Log: Update the MkLinux note.
+ Branch: maint-5.005/perl
+ ! hints/linux.sh
+ ____________________________________________________________________________
+ [ 2775] By: jhi on 1999/02/02 13:13:24
+ Log: Mention lib/Dumpvalue.pm.
+ Branch: maint-5.005/perl
+ ! pod/roffitall
+ ____________________________________________________________________________
+ [ 2767] By: jhi on 1999/02/02 12:29:57
+ Log: Demangle spaces to tab+space.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2758] By: jhi on 1999/02/02 10:51:26
+ Log: Detypo.
+ Branch: maint-5.005/perl
+ ! lib/Math/Trig.pm
+ ____________________________________________________________________________
+ [ 2755] By: jhi on 1999/02/02 09:07:51
+ Log: Make FreeBSD 2.2.7 work with -Duseshrplib -ders.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2752] By: jhi on 1999/02/01 22:15:12
+ Log: Add perlthrtut.pod.
+
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org
+ Subject: perlthrtut.pod
+ Date: Mon, 01 Feb 1999 10:57:11 -0800
+ Message-Id: <3.0.6.32.19990201105711.02e62540@ous.edu>
+ Branch: maint-5.005/perl
+ + pod/perlthrtut.pod
+ ! MANIFEST pod/Makefile pod/buildtoc pod/perldelta.pod
+ ! pod/roffitall
+ ____________________________________________________________________________
+ [ 2741] By: gbarr on 1999/02/01 03:00:42
+ Log: Fix typecasts in #2728
+
+ From: "G. Del Merritt" <del@intranetics.com>
+ Date: Fri, 29 Jan 1999 11:47:25 -0700
+ Message-Id: <199901291847.LAA04828@jhereg.perl.com>
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on MSWin32-x86-object 4.0 (PATCH included)
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+ ____________________________________________________________________________
+ [ 2740] By: gsar on 1999/02/01 02:43:07
+ Log: CAPI inheritance tweak and doc
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+ ____________________________________________________________________________
+ [ 2739] By: jhi on 1999/01/31 18:31:54
+ Log: Undo changes #2730 and #2731 and replace them
+ with an extensively tested patch from
+ Anton Berezin <tobez@plab.ku.dk> (via private email).
+ Branch: maint-5.005/perl
+ ! Makefile.SH hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2738] By: gsar on 1999/01/31 05:04:32
+ Log: fix bogus CAPI inheritance from change#2541
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+ ____________________________________________________________________________
+ [ 2737] By: gsar on 1999/01/31 04:55:06
+ Log: remove the big ugly thing jhi sneezed into INSTALL :-)
+ Branch: maint-5.005/perl
+ ! INSTALL
+ ____________________________________________________________________________
+ [ 2736] By: jhi on 1999/01/30 12:57:06
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ To: perl-mvs@perl.org, perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_5 on os390 05.00 (UNINSTALLED)
+ Date: Fri, 29 Jan 99 19:22:31 PST
+ Message-Id: <9901300322.AA19136@forte.com>
+
+ (slighty edited at the end)
+ Branch: maint-5.005/perl
+ ! README.os390
+ ____________________________________________________________________________
+ [ 2735] By: jhi on 1999/01/30 11:49:54
+ Log: Undo 5.005-devel random, srandom mention.
+ Branch: maint-5.005/perl
+ ! INSTALL
+ ____________________________________________________________________________
+ [ 2734] By: jhi on 1999/01/29 22:22:00
+ Log: Add perlreftut.
+ Branch: maint-5.005/perl
+ + pod/perlreftut.pod
+ ! MANIFEST pod/perl.pod pod/perldelta.pod pod/roffitall
+ ____________________________________________________________________________
+ [ 2732] By: gsar on 1999/01/29 20:09:44
+ Log: integrate change#2720 from mainline
+
+ missing space while munging CCFLAGS for PERL_CAPI
+ Branch: maint-5.005/perl
+ !> lib/ExtUtils/MM_Unix.pm
+ ____________________________________________________________________________
+ [ 2731] By: jhi on 1999/01/29 14:33:12
+ Log: FreeBSD version numbers can be like "2.2.8-release".
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2730] By: jhi on 1999/01/29 12:40:38
+ Log: FreeBSD hints iteration (hopefully convergent).
+ usethreads: require at least FreeBSD 2.2.8.
+ signal type: mirror change #2429 in cfgperl.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2729] By: gbarr on 1999/01/29 05:06:32
+ Log: Trial release 5
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h pod/perlhist.pod
+ ____________________________________________________________________________
+ [ 2728] By: gbarr on 1999/01/29 04:10:37
+ Log: From: Ted Law <tedlaw@cibcwg.com>
+ Date: Wed, 27 Jan 1999 14:54:03 -0500 (EST)
+ Message-Id: <199901271954.OAA07391@dcm2.cibcwg.com>
+ Subject: POSIX::strftime buffer overflow problem
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+ ____________________________________________________________________________
+ [ 2728] By: gbarr on 1999/01/29 04:10:37
+ Log: From: Ted Law <tedlaw@cibcwg.com>
+ Date: Wed, 27 Jan 1999 14:54:03 -0500 (EST)
+ Message-Id: <199901271954.OAA07391@dcm2.cibcwg.com>
+ Subject: POSIX::strftime buffer overflow problem
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+ ____________________________________________________________________________
+ [ 2727] By: gbarr on 1999/01/29 04:09:57
+ Log: From: Tom Spindler <dogcow@isi.net>
+ Date: Thu, 28 Jan 1999 17:15:11 -0800
+ Message-ID: <19990128171510.A11778@isi.net>
+ Subject: [PATCH] BeOS dynamic loading support for perl5.005_03_MT4
+ Branch: maint-5.005/perl
+ + ext/DynaLoader/dl_beos.xs
+ ! Configure MANIFEST Makefile.SH README.beos hints/beos.sh
+ ! lib/ExtUtils/MM_Unix.pm
+ ____________________________________________________________________________
+ [ 2726] By: gbarr on 1999/01/29 03:30:51
+ Log: Remove use of File::Slurp in t/lib/textfill.t
+ Branch: maint-5.005/perl
+ ! t/lib/textfill.t
+ ____________________________________________________________________________
+ [ 2725] By: gbarr on 1999/01/29 03:11:41
+ Log: From: Gurusamy Sarathy <gsar@ActiveState.com>
+ Date: Wed, 27 Jan 1999 23:14:33 -0800
+ Message-Id: <199901280714.XAA10176@activestate.com>
+ Subject: Re: NOT OK: "@INC contains: ." after make install - MAINT_TRIAL_4 - 5.005_03 maintenance trial 4 MSWin32-x86-object
+ Branch: maint-5.005/perl
+ ! win32/Makefile win32/makefile.mk
+ ____________________________________________________________________________
+ [ 2724] By: jhi on 1999/01/28 19:27:15
+ Log: Change jhi@iki.fi to perlbug@perl.com.
+ Cosmetic change in semctl probing messages.
+ Branch: maint-5.005/perl
+ ! Configure hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2723] By: jhi on 1999/01/28 17:27:49
+ Log: Yet another typo in a test program.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2722] By: jhi on 1999/01/28 17:13:52
+ Log: The pthreads_created_joinable test had a typo,
+ by blind luck the default value works almost anywhere.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2721] By: jhi on 1999/01/28 13:04:23
+ Log: MinT support, adapted from change #2594.
+ Branch: maint-5.005/perl
+ + README.mint ext/POSIX/hints/mint.pl hints/mint.sh
+ + mint/Makefile mint/README mint/errno.h mint/pwd.c mint/stdio.h
+ + mint/sys/time.h mint/time.h
+ ! MANIFEST doio.c malloc.c miniperlmain.c perl.c
+ ! pod/perldelta.pod t/io/fs.t t/lib/safe2.t t/op/groups.t
+ ! t/op/mkdir.t t/op/taint.t
+ ____________________________________________________________________________
+ [ 2719] By: jhi on 1999/01/27 19:49:49
+ Log: From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ To: perl5-porters@perl.org
+ Subject: Re: [PATCH] perl5.005_03-MAINT_TRIAL_3: clarify Sv[INU]V versus Sv[INU]VX in perlguts
+ Date: Tue, 26 Jan 1999 22:25:07 +0000
+ Message-Id: <E105Gux-0000Ac-00@taurus.cus.cam.ac.uk>
+ Branch: maint-5.005/perl
+ ! pod/perlguts.pod
+ ____________________________________________________________________________
+ [ 2718] By: jhi on 1999/01/27 19:46:04
+ Log: io/fs.t fails test #18 (sense of tests appears to have been
+ changed incompletely; this patch just skips the test attached,
+ a la test #17 preceding it).
+
+ From: "G. Del Merritt" <del@intranetics.com>
+ To: perlbug@perl.com
+ Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on MSWin32-x86-object (PATCHES included)
+ Date: Tue, 26 Jan 1999 12:09:09 -0700
+ Message-Id: <199901261909.MAA25525@jhereg.perl.com>
+ Branch: maint-5.005/perl
+ ! t/io/fs.t
+ ____________________________________________________________________________
+ [ 2717] By: jhi on 1999/01/27 19:44:46
+ Log: Miniperl fails to build (pp_sys.c was changed and iperlsys.h wasn't)
+
+ From: "G. Del Merritt" <del@intranetics.com>
+ To: perlbug@perl.com
+ Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on MSWin32-x86-object (PATCHES included)
+ Date: Tue, 26 Jan 1999 12:09:09 -0700
+ Message-Id: <199901261909.MAA25525@jhereg.perl.com>
+ Branch: maint-5.005/perl
+ ! iperlsys.h
+ ____________________________________________________________________________
+ [ 2716] By: jhi on 1999/01/27 19:38:36
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perlbug@perl.com, vmsperl@perl.org
+ Subject: NOT OK: perl 5.00503 +MAINT_TRIAL_4 on VMSAXP (Patch included, of course)
+ Date: Tue, 26 Jan 1999 14:40:38 -0800
+ Message-Id: <3.0.6.32.19990126144038.02e5d650@ous.edu>
+
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ To: perl5-porters@perl.org, vmsperl@perl.org
+ Subject: [PATCH 5.005_03-MAILT_TRIAL_4]VMS test patches
+ Date: Tue, 26 Jan 1999 14:55:29 -0800
+ Message-Id: <3.0.6.32.19990126145529.02f22280@ous.edu>
+ Branch: maint-5.005/perl
+ ! t/lib/textfill.t t/lib/textwrap.t vms/ext/Stdio/test.pl
+ ! vms/subconfigure.com
+ ____________________________________________________________________________
+ [ 2715] By: jhi on 1999/01/27 19:34:28
+ Log: From: Mark Bixby <markb@spock.dis.cccd.edu>
+ To: perl5-porters@perl.org
+ Subject: [PATCH perl5.005_03-MAINT_TRIAL_4] MPE port tweaks
+ Date: Tue, 26 Jan 1999 16:32:18 -0800 (PST)
+ Message-Id: <199901270032.QAA13395@spock.dis.cccd.edu>
+ Branch: maint-5.005/perl
+ ! hints/mpeix.sh mpeix/relink
+ ____________________________________________________________________________
+ [ 2714] By: jhi on 1999/01/27 19:32:41
+ Log: NetBSD does not do setruid, setrgid.
+ Branch: maint-5.005/perl
+ ! hints/netbsd.sh
+ ____________________________________________________________________________
+ [ 2713] By: jhi on 1999/01/27 19:28:53
+ Log: FreeBSD usethreads, based on private email with
+ Anton Berezin <tobez@plab.ku.dk>.
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2712] By: jhi on 1999/01/27 19:26:17
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ To: Mailing list Perl5 <perl5-porters@perl.org>
+ Subject: [PATCH 5.005_*] OS/2 threads
+ Date: Tue, 26 Jan 1999 13:39:46 -0500
+ Message-ID: <19990126133946.A11594@monk.mps.ohio-state.edu>
+ Branch: maint-5.005/perl
+ ! os2/os2ish.h
+ ____________________________________________________________________________
+ [ 2711] By: jhi on 1999/01/27 19:24:28
+ Log: "make ok", "make okfile", and "make nok" were broken
+ with -Duseshrplib, because of a shared typo.
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 12:27:15 -0500
+ Message-Id: <199901271727.MAA233455@web.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! Makefile.SH
+ ____________________________________________________________________________
+ [ 2710] By: jhi on 1999/01/27 19:22:23
+ Log: Errno fixes:
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 12:27:15 -0500
+ Message-Id: <199901271727.MAA233455@web.zk3.dec.com>
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: perlbug@perl.com
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 13:31:16 -0500
+ Message-Id: <199901271831.NAA241001@web.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! Configure ext/Errno/Errno_pm.PL
+ ____________________________________________________________________________
+ [ 2709] By: jhi on 1999/01/27 19:17:35
+ Log: Fix Configure installusrbinperl:
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ To: jhi@iki.fi
+ cc: perl5-porters@perl.org
+ Subject: Re: Not OK: perl 5.00503 +MAINT_TRIAL_4 on alpha-dec_osf-thread 5.0 (UNINSTALLED)
+ Date: Wed, 27 Jan 1999 13:03:35 -0500
+ Message-Id: <199901271803.NAA238257@web.zk3.dec.com>
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2708] By: gbarr on 1999/01/26 04:14:42
+ Log: Trial release 4
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h pod/perlhist.pod
+ ____________________________________________________________________________
+ [ 2707] By: gbarr on 1999/01/26 02:06:17
+ Log: Add redef IO::Handle::* for setv?buf()
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.pm
+ ____________________________________________________________________________
+ [ 2706] By: jhi on 1999/01/24 22:26:12
+ Log: Better AIX libc nm scan.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2703] By: jhi on 1999/01/24 14:26:18
+ Log: Minor Configure adjustments.
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2702] By: jhi on 1999/01/24 13:57:33
+ Log: Use usethreads.cbu consistently.
+ Branch: maint-5.005/perl
+ ! Configure hints/aix.sh hints/dec_osf.sh hints/dos_djgpp.sh
+ ! hints/freebsd.sh hints/hpux.sh hints/irix_4.sh hints/irix_5.sh
+ ! hints/irix_6.sh hints/irix_6_0.sh hints/irix_6_1.sh
+ ! hints/linux.sh hints/os2.sh hints/solaris_2.sh
+ ____________________________________________________________________________
+ [ 2701] By: jhi on 1999/01/24 13:55:43
+ Log: Mention year-1900 and month 0..11 also here.
+ Branch: maint-5.005/perl
+ ! lib/Time/Local.pm
+ ____________________________________________________________________________
+ [ 2700] By: jhi on 1999/01/24 13:52:36
+ Log: Document Configure -Uinstallusrbinperl.
+ Branch: maint-5.005/perl
+ ! INSTALL pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2699] By: jhi on 1999/01/24 13:01:57
+ Log: perlopentut was missing.
+ Branch: maint-5.005/perl
+ + pod/perlopentut.pod
+ ! MANIFEST pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2697] By: jhi on 1999/01/24 12:31:33
+ Log: Remove t/op/grent.t (t/op/pwent.t was removed by #2685).
+ Branch: maint-5.005/perl
+ - t/op/grent.t
+ ! MANIFEST
+ ____________________________________________________________________________
+ [ 2696] By: gsar on 1999/01/24 11:39:39
+ Log: integrate changes#2255,2694 from mainline
+
+ another win32 portability fix: make sysread() and syswrite()
+ work on sockets
+
+ better notes on 'make' on win32
+ Branch: maint-5.005/perl
+ ! README.win32 pp_sys.c win32/win32.h
+ ____________________________________________________________________________
+ [ 2693] By: gbarr on 1999/01/24 00:53:31
+ Log: Integrate changes #2646,2647 from cfgperl
+
+ Show LANGUAGE env var when needed. (Augment change #2645).
+
+ SHMLBA strikes back in NetBSD/sparc.
+
+ From: Dave Nelson <David.Nelson@bellcow.com>
+ To: jhi@iki.fi
+ Subject: perl5.005_02 + IPC::SysV + NetBSD/Sparc
+ Date: Mon, 18 Jan 1999 22:07:56 -0600
+ Message-Id: <199901190407.WAA02543@longhorn.bellcow.com>
+ Branch: maint-5.005/perl
+ ! util.c utils/perlbug.PL
+ !> ext/IPC/SysV/SysV.xs
+ ____________________________________________________________________________
+ [ 2692] By: gbarr on 1999/01/24 00:28:52
+ Log: Integrate #2630 from mainline and an errno save fix
+ Branch: maint-5.005/perl
+ !> doio.c
+ ____________________________________________________________________________
+ [ 2691] By: gbarr on 1999/01/24 00:28:37
+ Log: Update CGI modules to 2.46 and Getopt::Long to 2.19
+ Branch: maint-5.005/perl
+ ! lib/CGI.pm lib/CGI/Carp.pm lib/CGI/Cookie.pm lib/CGI/Fast.pm
+ ! lib/CGI/Push.pm lib/Getopt/Long.pm t/lib/cgi-html.t
+ ____________________________________________________________________________
+ [ 2690] By: gbarr on 1999/01/23 23:35:39
+ Log: Integrate #2681 from cfgperl
+
+ Better (I hope) LANGUAGE documentation.
+ Branch: maint-5.005/perl
+ !> pod/perllocale.pod
+ ____________________________________________________________________________
+ [ 2689] By: gbarr on 1999/01/23 23:31:59
+ Log: More nosuid patches
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 22 Jan 1999 12:12:45 +0200 (EET)
+ Message-ID: <13992.20253.269284.841300@alpha.hut.fi>
+ Subject: Re: [PATCH] 5.005*: the "nosuid" problem: v2
+ Branch: maint-5.005/perl
+ ! Configure config_h.SH perl.c perl.h pod/perldelta.pod
+ ! pod/perldiag.pod
+ ____________________________________________________________________________
+ [ 2688] By: gbarr on 1999/01/23 23:03:39
+ Log: From: Anton Berezin <tobez@plab.ku.dk>
+ Date: 21 Jan 1999 17:07:28 +0100
+ Message-ID: <86emood2yn.fsf@lion.plab.ku.dk>
+ Subject: [PATCH 5.005_54] hints/freebsd.sh - reflect the birth of version 4.0
+ Branch: maint-5.005/perl
+ ! hints/freebsd.sh
+ ____________________________________________________________________________
+ [ 2687] By: gbarr on 1999/01/23 22:52:58
+ Log: overload syntax is no longer experimental
+ Branch: maint-5.005/perl
+ ! lib/overload.pm
+ ____________________________________________________________________________
+ [ 2685] By: gbarr on 1999/01/23 22:15:46
+ Log: Remove t/op/pwent.t added from cfgperl, but is not robust.
+ Branch: maint-5.005/perl
+ - t/op/pwent.t
+ ! MANIFEST
+ ____________________________________________________________________________
+ [ 2684] By: gbarr on 1999/01/23 22:13:07
+ Log: More doc typos from Abigail, and undo some in lib/diagnostics.pm
+ from change #2672
+
+ From: abigail@fnx.com
+ Date: Tue, 19 Jan 1999 19:32:42 -0500 (EST)
+ Message-Id: <19990120003242.19938.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/CGI.pm] Typos
+
+ From: abigail@fnx.com
+ Date: Tue, 19 Jan 1999 19:40:41 -0500 (EST)
+ Message-Id: <19990120004041.20052.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/CPAN.pm] Typos
+ Branch: maint-5.005/perl
+ ! lib/CGI.pm lib/CPAN.pm lib/diagnostics.pm
+ ____________________________________________________________________________
+ [ 2677] By: gbarr on 1999/01/22 03:38:07
+ Log: Integrate #2645, #2648 and update patching.pod
+
+ Document the GNU LANGUAGE env var.
+
+ Mention /usr/share/locale.
+
+ From: Daniel Grisinger <dgris@moiraine.dimensional.com>
+ Date: 21 Jan 1999 00:17:35 -0700
+ Message-Id: <m31zkpqels.fsf_-_@moiraine.dimensional.com>
+ Subject: [PATCH] patching.pod, misc fixes (was Re: Which ? What ? Why ? When ?)
+ Branch: maint-5.005/perl
+ ! Porting/patching.pod
+ !> pod/perllocale.pod
+ ____________________________________________________________________________
+ [ 2676] By: gbarr on 1999/01/22 01:54:02
+ Log: Fixup FindBin to use File::Spec
+
+ Message-Id: <19990120185157.D24479@west-tip.transeda.com>
+ Date: Wed, 20 Jan 1999 18:51:57 +0000
+ From: Paul Johnson <pjcj@transeda.com>
+ Subject: Re: [PATCH] 5005_54 Make FindBin work with UNC paths
+ Branch: maint-5.005/perl
+ ! lib/FindBin.pm
+ ____________________________________________________________________________
+ [ 2675] By: gbarr on 1999/01/22 01:38:31
+ Log: Add new config values added for nosuid fix into VMS configure
+
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Wed, 20 Jan 1999 12:05:18 -0800
+ Message-Id: <3.0.6.32.19990120120518.00a98470@ous.edu>
+ Subject: [PATCH 5.005_03MT3]VMS configure tweak
+ Branch: maint-5.005/perl
+ ! vms/subconfigure.com
+ ____________________________________________________________________________
+ [ 2674] By: gbarr on 1999/01/22 01:36:35
+ Log: Fix for buggy compiler optimization on dec for pack("I",...)
+
+ From: Achim Bohnet <ach@mpe.mpg.de>
+ Date: Wed, 20 Jan 1999 20:25:53 +0100
+ Message-Id: <199901201925.UAA16940@o06.xray.mpe.mpg.de>
+ Subject: [PATCH] Not OK: perl 5.00503 +MAINT_TRIAL_3 on alpha-dec_osf 4.0
+ Branch: maint-5.005/perl
+ ! pp.c
+ ____________________________________________________________________________
+ [ 2673] By: gbarr on 1999/01/22 01:29:37
+ Log: OS/2 patches from Ilya
+
+ Date: Thu, 21 Jan 1999 02:08:27 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.00*] makedepend
+ Message-Id: <19990121020827.A25509@monk.mps.ohio-state.edu>
+
+ Date: Thu, 21 Jan 1999 02:46:34 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Errno.pm suffers from \\ too
+ Message-Id: <19990121024634.A25600@monk.mps.ohio-state.edu>
+
+ Date: Thu, 21 Jan 1999 02:50:16 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.005_03] Resend of OS/2 patch
+ Message-Id: <19990121025016.A25612@monk.mps.ohio-state.edu>
+
+ Date: Thu, 21 Jan 1999 03:58:29 -0500
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Subject: [PATCH 5.005_*] OS2::PrfDB was exploiting a bug in U32 XSUBs
+ Message-Id: <19990121035829.A25822@monk.mps.ohio-state.edu>
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL makedepend.SH os2/Changes
+ ! os2/Makefile.SHs os2/OS2/PrfDB/PrfDB.xs os2/os2.c
+ ____________________________________________________________________________
+ [ 2672] By: gbarr on 1999/01/22 01:05:45
+ Log: More doc typo patches from Abigail
+
+ From: abigail@fnx.com
+ Message-Id: <19990120001410.19645.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL 3 lib/AutoLoader.pm] Typos
+ Date: Tue, 19 Jan 1999 19:14:10 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120004312.20152.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Carp.pm] Typo
+ Date: Tue, 19 Jan 1999 19:43:12 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120004429.20190.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Cwd.pm] Typo
+ Date: Tue, 19 Jan 1999 19:44:29 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120005241.20693.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Safe.pm] Typo
+ Date: Tue, 19 Jan 1999 19:52:41 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120005525.20788.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/SelfLoader.pm] Typos
+ Date: Tue, 19 Jan 1999 19:55:25 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120005821.20926.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Symbol.pm] Typo
+ Date: Tue, 19 Jan 1999 19:58:21 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120010002.20973.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/Test.pm] Typo
+ Date: Tue, 19 Jan 1999 20:00:02 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120013823.23015.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/diagnostics.pm] Typos (ignore
+ Date: Tue, 19 Jan 1999 20:38:23 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120013909.23085.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/ops.pm] Typo
+ Date: Tue, 19 Jan 1999 20:39:09 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120015817.24306.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/overload.pm] Typos
+ Date: Tue, 19 Jan 1999 20:58:16 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-Id: <19990120020326.24373.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL3 lib/re.pm] Typos
+ Date: Tue, 19 Jan 1999 21:03:26 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! ext/Opcode/Safe.pm ext/Opcode/ops.pm ext/re/re.pm
+ ! lib/AutoLoader.pm lib/Carp.pm lib/Cwd.pm lib/SelfLoader.pm
+ ! lib/Symbol.pm lib/Test.pm lib/diagnostics.pm lib/overload.pm
+ ____________________________________________________________________________
+ [ 2671] By: gbarr on 1999/01/22 00:40:13
+ Log: Fix win32 for Borland compiler and spaces in paths
+
+ From: Gurusamy Sarathy <gsar@activestate.com>
+ Date: Mon, 18 Jan 1999 20:33:17 -0800
+ Message-Id: <199901190433.UAA03656@activestate.com>
+ Subject: [PATCH] 5.005_03-trial3 win32 issues
+ Branch: maint-5.005/perl
+ ! README.win32 win32/Makefile win32/config_sh.PL
+ ! win32/makefile.mk win32/runperl.c
+ ____________________________________________________________________________
+ [ 2637] By: gbarr on 1999/01/18 02:52:18
+ Log: Update DB_File to 1.63
+
+ From: pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Date: Tue, 29 Dec 1998 16:23:54 +0000 (GMT)
+ Message-Id: <9812291623.AA20884@claudius.bfsec.bt.co.uk>
+ Subject: PATCH DB_File 1.63 for 5.005_54 & 5.005_03
+ Branch: maint-5.005/perl
+ ! ext/DB_File/Changes ext/DB_File/DB_File.pm
+ ! ext/DB_File/DB_File.xs ext/DB_File/dbinfo ext/DB_File/typemap
+ ____________________________________________________________________________
+ [ 2636] By: gbarr on 1999/01/17 18:03:31
+ Log: Trial release 3
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h
+ ____________________________________________________________________________
+ [ 2635] By: gbarr on 1999/01/17 17:32:01
+ Log: Update to CPAN-1.44
+
+ From: Mark-Jason Dominus <mjd@plover.com>
+ Date: Sat, 16 Jan 1999 17:22:06 -0500
+ Message-ID: <19990116222206.3674.qmail@plover.com>
+ Subject: Re: DOC PATCH (5.005_54 perlsub.pod)
+ Branch: maint-5.005/perl
+ ! lib/CPAN.pm lib/CPAN/FirstTime.pm lib/CPAN/Nox.pm
+ ! pod/perlsub.pod
+ ____________________________________________________________________________
+ [ 2634] By: gbarr on 1999/01/17 17:27:12
+ Log: Fix for suidperl when script is on a nosuid filesystem
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Sun, 17 Jan 1999 16:27:06 +0200 (EET)
+ Message-ID: <13985.62266.324824.292401@alpha.hut.fi>
+ Subject: [PATCH] 5.005*: the "nosuid" problem: v2
+ Branch: maint-5.005/perl
+ ! Configure config_h.SH perl.c perl.h pod/perldiag.pod
+ ____________________________________________________________________________
+ [ 2618] By: gbarr on 1999/01/16 19:18:26
+ Log: Added Dumpvalue.pm
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 7 Dec 1998 02:44:25 -0500 (EST)
+ Message-Id: <199812070744.CAA18949@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Dumpvar.pm
+ Branch: maint-5.005/perl
+ + lib/Dumpvalue.pm
+ ! MANIFEST pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2617] By: gbarr on 1999/01/16 19:09:36
+ Log: Minor change to perlxstut and added perlopentut.pod
+
+ From: Nathan Torkington <gnat@frii.com>
+ Date: Sat, 26 Dec 1998 14:28:21 +1300 (NZDT)
+ Message-ID: <13956.15285.933914.320849@localhost.frii.com>
+ Subject: [PATCH] perlxstut.pod fix
+
+ From: Tom Christiansen <tchrist@jhereg.perl.com>
+ Date: Sat, 09 Jan 1999 08:13:18 -0700
+ Message-Id: <199901091513.IAA17512@jhereg.perl.com>
+ Subject: perlopentut.pod
+ Branch: maint-5.005/perl
+ ! MANIFEST pod/perl.pod pod/perldelta.pod pod/perlxstut.pod
+ ! pod/roffitall
+ ____________________________________________________________________________
+ [ 2616] By: gbarr on 1999/01/16 18:59:55
+ Log: Win32 changes from Jan
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Fri, 15 Jan 1999 23:38:35 +0100
+ Message-ID: <36a7c10d.16311905@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03m2] Win32 Makefile patches
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Sat, 16 Jan 1999 13:02:45 +0100
+ Message-ID: <36a07da6.10722337@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03m2] minor tweaks to README.win32
+ Branch: maint-5.005/perl
+ ! README.win32 win32/Makefile win32/makefile.mk
+ ____________________________________________________________________________
+ [ 2615] By: gbarr on 1999/01/16 18:48:48
+ Log: Jumbo patch from Sarathy for PERL_OBJECT & USE_THREADS
+
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Thu, 07 Jan 1999 00:12:00 -0500
+ Message-Id: <199901070512.AAA23568@aatma.engin.umich.edu>
+ Subject: Re: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds
+
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Thu, 14 Jan 1999 19:21:46 -0500
+ Message-Id: <199901150021.TAA01886@aatma.engin.umich.edu>
+ Subject: Re: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds
+ Branch: maint-5.005/perl
+ ! embed.h global.sym lib/ExtUtils/MM_Unix.pm objXSUB.h objpp.h
+ ! op.c perl.c perl.h perly.c perly.y perly_c.diff pp.c proto.h
+ ! sv.c t/io/fs.t toke.c win32/GenCAPI.pl win32/config.bc
+ ! win32/makedef.pl win32/runperl.c win32/win32.c
+ ____________________________________________________________________________
+ [ 2614] By: gbarr on 1999/01/16 16:48:38
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 15 Jan 1999 17:28:34 +0200 (EET)
+ Message-Id: <199901151528.RAA08785@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: NetBSD patches
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 15 Jan 1999 18:44:19 +0200 (EET)
+ Message-Id: <199901151644.SAA08184@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: allow skipping the "install also as /usr/bin/perl" question of installperl
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 15 Jan 1999 18:52:29 +0200 (EET)
+ Message-Id: <199901151652.SAA11259@alpha.hut.fi>
+ Subject: the promised "installusrbinperl + NetBSD" fix
+ Branch: maint-5.005/perl
+ ! Configure Makefile.SH hints/netbsd.sh installperl
+ ! makedepend.SH unixish.h
+ ____________________________________________________________________________
+ [ 2613] By: gbarr on 1999/01/16 16:28:40
+ Log: From: Laszlo Molnar <ml1050@freemail.c3.hu>
+ Date: Thu, 14 Jan 1999 22:37:26 +0100
+ Message-ID: <19990114223726.A177@beeblebrox>
+ Subject: [PATCH for 5.005_03-MAINT_TRIAL_2] dos-djgpp update
+ Branch: maint-5.005/perl
+ ! djgpp/config.over djgpp/djgpp.c
+ ____________________________________________________________________________
+ [ 2612] By: gbarr on 1999/01/16 16:27:25
+ Log: Hints for sco.sh to automatically support dynamic linking
+
+ From: Peter Wolfe <wolfe@teloseng.com>
+ Date: Mon, 11 Jan 1999 11:50:20 -0800 (PST)
+ Message-Id: <199901111950.LAA01703@titan.teloseng.com>
+ Subject: SCO 3.2v5 patch for perl5.005_03-MAINT_TRIAL_1
+ Branch: maint-5.005/perl
+ ! hints/sco.sh
+ ____________________________________________________________________________
+ [ 2610] By: gbarr on 1999/01/14 03:07:33
+ Log: Fix login in installperl for pods
+
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Mon, 4 Jan 1999 13:50:10 GMT
+ Message-Id: <199901041350.NAA19665@cyclone.cise.npl.co.uk>
+ Subject: PATCH to installperl
+ Branch: maint-5.005/perl
+ ! installperl
+ ____________________________________________________________________________
+ [ 2609] By: gbarr on 1999/01/14 03:04:37
+ Log: Fix incorrect "used only once" warnings
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 8 Jan 1999 04:37:10 -0500
+ Message-ID: <19990108043710.A14390@monk.mps.ohio-state.edu>
+ Subject: Re: change#965 flakiness
+ Branch: maint-5.005/perl
+ ! gv.c
+ ____________________________________________________________________________
+ [ 2608] By: gbarr on 1999/01/14 02:56:46
+ Log: Fixed double GLOB de-reference
+
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Sat, 09 Jan 1999 23:40:24 -0500
+ Message-Id: <199901100440.XAA12360@aatma.engin.umich.edu>
+ Subject: Re: IO::Pipe with perl -d (on HPUX)
+ Branch: maint-5.005/perl
+ ! ext/IO/lib/IO/Pipe.pm
+ ____________________________________________________________________________
+ [ 2607] By: gbarr on 1999/01/14 02:53:40
+ Log: Added Carp::cluck to perldelta.pod
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2606] By: gbarr on 1999/01/14 02:44:04
+ Log: New perlfaq*.pod from Tom (private mail)
+ Branch: maint-5.005/perl
+ ! pod/perlfaq.pod pod/perlfaq1.pod pod/perlfaq2.pod
+ ! pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ ! pod/perlfaq6.pod pod/perlfaq7.pod pod/perlfaq8.pod
+ ! pod/perlfaq9.pod
+ ____________________________________________________________________________
+ [ 2584] By: gbarr on 1999/01/08 04:50:56
+ Log: implemented Ilya's suggested fix, and added a testcase
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 5 Jan 1999 00:56:01 -0500 (EST)
+ Message-Id: <199901050556.AAA02597@monk.mps.ohio-state.edu>
+ Subject: Re: Text::ParseWords: regex fix
+ Branch: maint-5.005/perl
+ ! lib/Text/ParseWords.pm t/lib/parsewords.t
+ ____________________________________________________________________________
+ [ 2583] By: gbarr on 1999/01/08 04:50:03
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Thu, 7 Jan 1999 12:47:38 +0200 (EET)
+ Message-Id: <199901071047.MAA24100@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: ext/Errno_pm.PL: understand wrapper cppstdins
+ Branch: maint-5.005/perl
+ ! ext/Errno/Errno_pm.PL
+ ____________________________________________________________________________
+ [ 2582] By: gbarr on 1999/01/08 03:37:55
+ Log: More doc changes from Abigail, and included change #2575 from cfgperl
+
+ From: abigail@fnx.com
+ Message-ID: <19990107041434.22326.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Time/gmtime.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:14:34 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107041746.22376.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Time/localtime.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:17:46 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107042105.22527.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/User/grent.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:21:05 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107042254.22624.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/User/pwent.pw] Typo fix
+ Date: Wed, 6 Jan 1999 23:22:54 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! lib/Math/Trig.pm lib/Time/gmtime.pm lib/Time/localtime.pm
+ ! lib/User/grent.pm lib/User/pwent.pm
+ ____________________________________________________________________________
+ [ 2578] By: gbarr on 1999/01/07 04:30:26
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Wed, 06 Jan 1999 13:47:34 -0800
+ Message-Id: <3.0.6.32.19990106134734.0334d260@ous.edu>
+ Subject: [PATCH 5.005_02-MT2, 5.005_5x]VMS.C tweak for occasional system() error
+ Branch: maint-5.005/perl
+ ! vms/vms.c
+ ____________________________________________________________________________
+ [ 2577] By: gbarr on 1999/01/07 04:26:28
+ Log: Another set of doc patches from Abigail
+
+ From: abigail@fnx.com
+ Message-ID: <19990107032132.20124.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/Net/hostent.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:21:32 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107032445.20178.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Net/netent.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:24:45 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107032834.20362.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/Term/Complete.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:28:34 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107033136.20440.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/Term/ReadLine.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:31:36 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107033351.20540.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/CGI/Apache.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:33:51 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107033933.20707.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/CGI/Push.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:39:33 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107034548.20936.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/File/Copy.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 22:45:48 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107034856.21056.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/File/Spec.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:48:56 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107035113.21174.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/File/Spec/Mac.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 22:51:13 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107035612.21522.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Math/BigFloat.pm] Typo fix
+ Date: Wed, 6 Jan 1999 22:56:12 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107035842.21585.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Math/BigInt.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 22:58:41 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107040644.22009.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Text/Wrap.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 23:06:44 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107040955.22087.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Tie/Array.pm] Typo fixes
+ Date: Wed, 6 Jan 1999 23:09:55 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990107041136.22174.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/Tie/Hash.pm] Typo fix
+ Date: Wed, 6 Jan 1999 23:11:36 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! lib/CGI/Apache.pm lib/CGI/Push.pm lib/File/Copy.pm
+ ! lib/File/Spec.pm lib/File/Spec/Mac.pm lib/Math/BigFloat.pm
+ ! lib/Math/BigInt.pm lib/Net/hostent.pm lib/Net/netent.pm
+ ! lib/Term/Complete.pm lib/Term/ReadLine.pm lib/Text/Wrap.pm
+ ! lib/Tie/Array.pm lib/Tie/Hash.pm
+ ____________________________________________________________________________
+ [ 2568] By: gbarr on 1999/01/06 03:13:15
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 06 Jan 1999 01:24:09 +0100
+ Message-ID: <3696aa85.18259325@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL2] fixes for PERL_OBJECT and USE_THREADS builds
+ Branch: maint-5.005/perl
+ ! embed.h global.sym objXSUB.h objpp.h perl.c proto.h
+ ! win32/GenCAPI.pl win32/makedef.pl
+ ____________________________________________________________________________
+ [ 2567] By: gbarr on 1999/01/06 02:31:28
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Tue, 05 Jan 1999 16:47:31 -0800
+ Message-Id: <3.0.6.32.19990105164731.00b5b2d0@ous.edu>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_2]taint.c fix for VMS
+ Branch: maint-5.005/perl
+ ! taint.c
+ ____________________________________________________________________________
+ [ 2566] By: gbarr on 1999/01/06 02:29:05
+ Log: From: "W. Phillip Moore" <wpm@ms.com>
+ Date: Tue, 5 Jan 1999 12:40:27 -0500 (EST)
+ Message-ID: <13970.20107.190314.549471@zappa>
+ Subject: [PATCH] POSIX getpgrp is not -w clean
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.pm
+ ____________________________________________________________________________
+ [ 2565] By: gbarr on 1999/01/06 02:19:00
+ Log: From: Slaven Rezic <eserte@cs.tu-berlin.de>
+ Date: Mon, 4 Jan 1999 23:01:46 +0100 (CET)
+ Message-Id: <199901042201.XAA01875@cabulja.herceg.de>
+ Subject: FindBin.pm on Win32 systems
+ Branch: maint-5.005/perl
+ ! lib/FindBin.pm
+ ____________________________________________________________________________
+ [ 2564] By: gbarr on 1999/01/06 02:13:23
+ Log: From: Mark Bixby <markb@spock.dis.cccd.edu>
+ Date: Mon, 4 Jan 1999 13:34:58 -0800 (PST)
+ Message-Id: <199901042134.NAA18852@spock.dis.cccd.edu>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_2] t/op/sysio.t for MPE/iX
+ Branch: maint-5.005/perl
+ ! t/op/sysio.t
+ ____________________________________________________________________________
+ [ 2563] By: gbarr on 1999/01/06 02:03:44
+ Log: From: Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Date: Mon, 4 Jan 1999 19:25:03 +0200 (EET)
+ Message-Id: <199901041725.TAA30462@alpha.hut.fi>
+ Subject: [PATCH] 5.005_03-MAINT_TRIAL_2: undo untrue HP-UX 64-bitness (mostly harmless but misleading)
+ Branch: maint-5.005/perl
+ ! hints/hpux.sh
+ ____________________________________________________________________________
+ [ 2562] By: gbarr on 1999/01/06 02:02:18
+ Log: Jumbo doc patch from Abigail
+
+ From: abigail@fnx.com
+ Message-ID: <19990105170142.4889.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03-TRIAL2 lib/ExtUtils/Liblist.pm] pod fixes
+ Date: Tue, 5 Jan 1999 12:01:42 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105172855.5115.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 MAINT2 lib/ExtUtils/Commands.pm] Typo fix.
+ Date: Tue, 5 Jan 1999 12:28:55 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105173808.5260.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH perl5.005_03 MAINT3 lib/ExtUtils/Embed.pm] Typo fix
+ Date: Tue, 5 Jan 1999 12:38:08 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105174859.5533.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 MAINT2 lib/ExtUtils/Install.pm] Typo fix
+ Date: Tue, 5 Jan 1999 12:48:59 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105174947.5547.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 lib/ExtUtils/MM_Unix.pm] Typo fixes
+ Date: Tue, 5 Jan 1999 12:49:46 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105182301.5966.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 lib/ExtUtils/MakeMaker.pm] Typos fixes.
+ Date: Tue, 5 Jan 1999 13:23:00 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105183344.6065.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/ExtUtils/Manifest.pm] Typo fixes
+ Date: Tue, 5 Jan 1999 13:33:44 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990105184028.6220.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/ExtUtils/Mksymlists.pm] Typo fix
+ Date: Tue, 5 Jan 1999 13:40:28 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990106012015.9451.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/IO/Pipe.pm] Typo fixes.
+ Date: Tue, 5 Jan 1999 20:20:15 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990106012047.9459.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRAIL2 lib/IO/Seekable.pm] Typo fixes
+ Date: Tue, 5 Jan 1999 20:20:47 -0500 (EST)
+
+ From: abigail@fnx.com
+ Message-ID: <19990106012338.9536.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_03 TRIAL2 lib/IO/Socket.pm] Typo fix
+ Date: Tue, 5 Jan 1999 20:23:38 -0500 (EST)
+ Branch: maint-5.005/perl
+ ! ext/IO/lib/IO/Pipe.pm ext/IO/lib/IO/Seekable.pm
+ ! ext/IO/lib/IO/Socket.pm lib/ExtUtils/Command.pm
+ ! lib/ExtUtils/Embed.pm lib/ExtUtils/Install.pm
+ ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MM_Unix.pm
+ ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Manifest.pm
+ ! lib/ExtUtils/Mksymlists.pm
+ ____________________________________________________________________________
+ [ 2560] By: gbarr on 1999/01/03 16:59:01
+ Log: Trial release 2
+ Branch: maint-5.005/perl
+ ! Changes patchlevel.h
+ ____________________________________________________________________________
+ [ 2559] By: gbarr on 1999/01/02 15:37:35
+ Log: From: Blair Zajac <bzajac@geostaff.com>
+ Date: Wed, 23 Dec 1998 17:13:32 -0800
+ Message-ID: <3681953C.8B6A90AA@geostaff.com>
+ Subject: Tie::SubstrHash patch
+ Branch: maint-5.005/perl
+ ! lib/Tie/SubstrHash.pm
+ ____________________________________________________________________________
+ [ 2558] By: gbarr on 1999/01/02 15:30:01
+ Log: integrate change #2544
+
+ From: Tim Bunce <Tim.Bunce@ig.co.uk>
+ Subject: bug in pod2man search for perl binary [5.005_5x]
+ Date: Sat, 12 Dec 1998 23:08:51 +0000
+ Message-ID: <19981212230851.A20578@ig.co.uk>
+ Branch: maint-5.005/perl
+ !> pod/pod2man.PL
+ ____________________________________________________________________________
+ [ 2557] By: gbarr on 1999/01/02 15:20:42
+ Log: integrate change #2548
+
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ To: perl5-porters@perl.org
+ cc: hv@crypt0.demon.co.uk
+ Subject: [bug 5.004_54] duplicate error message
+ Date: Thu, 31 Dec 1998 04:05:25 +0000
+ Message-Id: <199812310405.EAA00386@crypt.compulink.co.uk>
+
+ Message-ID: <13963.60672.134591.383377@alias-2.pr.mcs.net>
+ From: Stephen McCamant <smccam@uclink4.berkeley.edu>
+ To: hv@crypt0.demon.co.uk
+ Cc: perl5-porters@perl.org
+ Subject: [PATCH _54] Re: duplicate error message
+ Date: Thu, 31 Dec 1998 16:10:13 -0600 (CST)
+
+ Message-Id: <199901010732.HAA02926@crypt.compulink.co.uk>
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ To: Stephen McCamant <smccam@uclink4.berkeley.edu>
+ cc: hv@crypt0.demon.co.uk, perl5-porters@perl.org
+ Subject: [TEST PATCH _54] Re: duplicate error message
+ Date: Fri, 01 Jan 1999 07:32:14 +0000
+ Branch: maint-5.005/perl
+ ! op.c t/pragma/warn-1global taint.c
+ ____________________________________________________________________________
+ [ 2556] By: gbarr on 1999/01/02 15:18:58
+ Log: From: abigail@fnx.com
+ Date: Mon, 28 Dec 1998 14:16:12 -0500 (EST)
+ Message-ID: <19981228191612.8380.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_02; lib/fields.pm] Typos in pod.
+ Branch: maint-5.005/perl
+ ! lib/fields.pm
+ ____________________________________________________________________________
+ [ 2555] By: gbarr on 1999/01/02 15:11:45
+ Log: intregrate change #2547
+
+ From: Chris Nandor <pudge@pobox.com>
+ Subject: Re: [PATCH] perlport.pod 1.38
+ Date: Thu, 31 Dec 1998 09:06:48 -0500
+ Message-Id: <v04020a1db2b1352ec92a@[192.168.0.77]>
+ Branch: maint-5.005/perl
+ !> pod/perlport.pod
+ ____________________________________________________________________________
+ [ 2543] By: gbarr on 1998/12/31 06:17:13
+ Log: integrated relevant parts og changes #2385 & #2387 from mainline
+
+ various fixes for race conditions under threads: mutex locks based
+ on PL_threadnum were seriously flawed, since it means more than one
+ thread could enter the critical region; PL_na was global instead of
+ thread-local; child thread could finish and free thr structures
+ before Thread->new() got around to creating the Thread object;
+ cv_clone() needed locking, as it mucks with PL_comppad and other
+ global data; new_struct_thread() needed to lock template-thread's
+ mutex while copying its data
+
+ another threads reliability fix: serialize writes to thr->threadsv
+ avoid most uses of PL_na (which is much more inefficient than a
+ simple local); update docs to suit; PL_na now being thr->Tna may
+ be a minor compatibility issue for extensions--will require dTHR
+ outside of XSUBs (those get automatic dTHR)
+ Branch: maint-5.005/perl
+ ! XSUB.h djgpp/djgpp.c doio.c doop.c dump.c embedvar.h
+ ! ext/DynaLoader/dl_next.xs ext/IO/IO.xs ext/Opcode/Opcode.xs
+ ! ext/POSIX/POSIX.xs ext/Thread/Thread.xs ext/attrs/attrs.xs
+ ! gv.c malloc.c mg.c objXSUB.h op.c os2/OS2/REXX/REXX.xs
+ ! os2/os2.c perl.c perlvars.h perly.c perly.y pod/perlcall.pod
+ ! pod/perlembed.pod pod/perlguts.pod pod/perlxs.pod pp.c pp.h
+ ! pp_ctl.c pp_hot.c pp_sys.c run.c sv.c taint.c thread.h toke.c
+ ! universal.c util.c vms/ext/Stdio/Stdio.xs vms/perly_c.vms
+ ! vms/vms.c win32/win32.c win32/win32thread.c
+ ____________________________________________________________________________
+ [ 2542] By: gbarr on 1998/12/30 14:46:40
+ Log: doc updates
+
+ From: abigail@fnx.com
+ Date: Wed, 23 Dec 1998 22:32:07 -0500 (EST)
+ Message-ID: <19981224033207.16751.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_02] Typo in documentation of pod2html.
+
+ From: abigail@fnx.com
+ Date: Wed, 23 Dec 1998 22:59:59 -0500 (EST)
+ Message-ID: <19981224035959.16994.qmail@alexandra.wayne.fnx.com>
+ Subject: [PATCH 5.005_02] Re: m// doc is buggy (was Re: m'$foo' is undocumented)
+
+ pod/perldelta.pod from:
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Thu, 17 Dec 1998 16:13:34 +0200 (EET)
+ Message-ID: <13945.4494.140163.973953@alpha.hut.fi>
+ Subject: Re: important UNDOC issues for 5.005_54
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod pod/perlop.pod pod/pod2html.PL
+ ____________________________________________________________________________
+ [ 2541] By: gbarr on 1998/12/30 14:37:14
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 23 Dec 1998 21:26:38 +0100
+ Message-ID: <36895086.8849224@smtp1.ibm.net>
+ Subject: [PATCH 5.005_03m1] subdirectory Makefiles should inherit CAPI setting from command line
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+ ____________________________________________________________________________
+ [ 2538] By: gbarr on 1998/12/29 14:41:29
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 22 Dec 1998 10:57:48 +0200 (EET)
+ Message-ID: <13951.24332.932827.831376@alpha.hut.fi>
+ Subject: Re: x operator broken in DEC Alpha for 8-bit characters (Re: Digest-MD5-2.00 test fails on DEC Alpha - a patch)
+ Branch: maint-5.005/perl
+ ! t/op/repeat.t util.c
+ ____________________________________________________________________________
+ [ 2535] By: gbarr on 1998/12/29 14:27:56
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Fri, 18 Dec 1998 16:39:27 +0200 (EET)
+ Message-ID: <13946.26911.140905.387070@alpha.hut.fi>
+ Subject: Math::Trig, Math::Complex, Fcntl, addressed (Re: Undocumentation Issues for 5.005)
+ Branch: maint-5.005/perl
+ ! pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2534] By: gbarr on 1998/12/29 14:23:02
+ Log: From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Tue, 15 Dec 1998 17:52:32 +0200 (EET)
+ Message-ID: <13942.34240.66558.169330@alpha.hut.fi>
+ Subject: some doc link fixes
+ Branch: maint-5.005/perl
+ ! pod/perlcall.pod pod/perldata.pod pod/perldiag.pod
+ ! pod/perlfaq5.pod pod/perlfaq7.pod pod/perlfunc.pod
+ ! pod/perlguts.pod pod/perllocale.pod pod/perlobj.pod
+ ! pod/perlsub.pod pod/perlvar.pod
+ ____________________________________________________________________________
+ [ 2533] By: gbarr on 1998/12/29 14:23:00
+ Log: From: Chris Nandor <pudge@pobox.com>
+ Date: Sat, 19 Dec 1998 12:54:34 -0500
+ Message-Id: <v04020a03b2a194aaa676@[192.168.0.77]>
+ Subject: [PATCH] perlport.pod v1.37
+ Branch: maint-5.005/perl
+ ! pod/perlport.pod
+ ____________________________________________________________________________
+ [ 2531] By: gbarr on 1998/12/29 14:12:25
+ Log: change in_pod pattern to /^=\w/ from /^=/
+ From: Frank Ridderbusch <Frank.Ridderbusch@pdb.siemens.de>
+ Date: Tue, 15 Dec 1998 16:23:12 +0100 (MET)
+ Message-ID: <13942.32480.700000.640927@utensil>
+ Subject: Minor Bug in AutoSplit.qm in 5.005 and 5.004
+ Branch: maint-5.005/perl
+ ! lib/AutoSplit.pm
+ ____________________________________________________________________________
+ [ 2530] By: gbarr on 1998/12/29 14:09:51
+ Log: undo the "perlsyn intrusion" into perlfunc
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+ ____________________________________________________________________________
+ [ 2529] By: gbarr on 1998/12/29 14:04:35
+ Log: From: Jarkko Hietaniemi <hietanie@koah.research.nokia.com>
+ Date: Sun, 13 Dec 1998 14:54:56 +0200 (EET)
+ Message-Id: <199812131254.OAA24494@koah.research.nokia.com>
+ Subject: ignore_versioned_libs isn't used anywhere (it became ignore_versioned_solibs)
+ Branch: maint-5.005/perl
+ ! hints/linux.sh
+ ____________________________________________________________________________
+ [ 2528] By: gbarr on 1998/12/29 13:59:49
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 28 Oct 1998 01:20:33 -0500 (EST)
+ Message-Id: <199810280620.BAA06893@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.00552] Make sort respect overloading
+ Branch: maint-5.005/perl
+ ! pp_ctl.c t/pragma/overload.t
+ ____________________________________________________________________________
+ [ 2527] By: gbarr on 1998/12/29 13:58:56
+ Log: doc update, quads only work on 64-but platforms
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+ ____________________________________________________________________________
+ [ 2526] By: gbarr on 1998/12/29 13:49:55
+ Log: From: Andy Dougherty <doughera@lafayette.edu>
+ Date: Tue, 1 Dec 1998 12:50:27 -0500 (EST)
+ Message-Id: <Pine.SUN.3.96.981201124929.4288H-100000@newton.phys>
+ Subject: [PATCH 5.005_xx] erroneous 'none' in lddlflags
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2512] By: gbarr on 1998/12/28 14:56:36
+ Log: change t/op/pwent.t to ignore NIS includes
+ From: achampio@lehman.com (Alan Champion)
+ Date: Tue, 1 Dec 1998 15:18:03 GMT
+ Message-Id: <9812011518.AA00005@lonhpov1.lehman.com>
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_1 on sun4-solaris 2.3 (UNINSTALLED)
+
+ From: pvhp@forte.com (Peter Prymmer)
+ Date: Fri, 4 Dec 98 17:11:41 PST
+ Message-Id: <9812050111.AA16778@forte.com>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_1 && 5.005_54]dumper and searchdict ebcdic style
+ Branch: maint-5.005/perl
+ ! t/lib/dumper.t t/lib/searchdict.t t/op/pwent.t
+ ____________________________________________________________________________
+ [ 2511] By: gbarr on 1998/12/28 14:55:28
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Tue, 01 Dec 1998 00:07:33 +0100
+ Message-ID: <366921b5.14512598@smtp1.ibm.net>
+ Subject: Re: 5.005_03-MAINT-TRIAL1, [PATCH] to compile on Win32
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 02 Dec 1998 00:24:54 +0100
+ Message-ID: <366a77bb.19498126@smtp1.ibm.net>
+ Subject: Re: 5.005_03-MAINT-TRIAL1, [PATCH] spaces in filenames support
+ Branch: maint-5.005/perl
+ ! perl.h proto.h taint.c win32/GenCAPI.pl win32/Makefile
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ! win32/config_sh.PL win32/makedef.pl
+ ____________________________________________________________________________
+ [ 2510] By: gbarr on 1998/12/28 14:37:35
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 1 Dec 1998 00:34:08 -0500 (EST)
+ Message-Id: <199812010534.AAA21371@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Debugger 'v' command
+ Branch: maint-5.005/perl
+ ! lib/perl5db.pl
+ ____________________________________________________________________________
+ [ 2478] By: gbarr on 1998/12/13 16:02:24
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ Date: Mon, 30 Nov 98 21:08:36 PST
+ Message-Id: <9812010508.AA07791@forte.com>
+ Subject: [PATCH 5.005_03t1 && 5.005_54]dll linkage side decks for OS/390
+ Branch: maint-5.005/perl
+ ! hints/os390.sh
+ ____________________________________________________________________________
+ [ 2477] By: gbarr on 1998/12/13 16:00:23
+ Log: From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Mon, 30 Nov 1998 17:08:12 -0800
+ Message-Id: <3.0.6.32.19981130170812.00b12b70@ous.edu>
+ Subject: [PATCH 5.005_03]Minor VMS patches needed to build
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_VMS.pm vms/subconfigure.com
+ ____________________________________________________________________________
+ [ 2476] By: gbarr on 1998/12/13 15:30:58
+ Log: From: pvhp@forte.com (Peter Prymmer)
+ Date: Fri, 4 Dec 98 00:37:32 PST
+ Message-Id: <9812040837.AA10908@forte.com>
+ Subject: Re: [PATCH 5.005_03-MAINT-TRIAL1] some tweaks to the build process for OS/390
+ Branch: maint-5.005/perl
+ ! Makefile.SH regcomp.c
+ ____________________________________________________________________________
+ [ 2472] By: gbarr on 1998/12/12 17:12:28
+ Log: undo changes to Exporter.pm from #2312
+ Branch: maint-5.005/perl
+ ! lib/Exporter.pm
+ ____________________________________________________________________________
+ [ 2471] By: gbarr on 1998/12/12 17:09:39
+ Log: integrate change#2459 from cfgperl
+
+ enclose case want_vtbl_collxfrm with #ifdef USE_LOCALE_COLLATE
+
+ From: hansm@icgroup.nl
+ Subject: Not OK: perl 5.00503 +MAINT_TRIAL_1 on OPENSTEP-Mach 4_1 (UNINSTALLED)
+ Date: Sun, 6 Dec 98 22:19:54 +0100
+ Message-Id: <9812062116.AA26445@icgned.icgroup.nl>
+ Branch: maint-5.005/perl
+ ! util.c
+ ____________________________________________________________________________
+ [ 2470] By: gbarr on 1998/12/12 16:46:03
+ Log: re-sync'd Text::Wrap with new version from CPAN
+ Branch: maint-5.005/perl
+ +> t/lib/textfill.t
+ ! MANIFEST
+ !> lib/Text/Wrap.pm t/lib/textwrap.t
+ ____________________________________________________________________________
+ [ 2469] By: gbarr on 1998/12/12 15:58:43
+ Log: integrate changes#2435,2436 from cfgperl
+
+ Pod::Html and Pod::Text were not locale-savvy:
+ for example in =head1 all non-ASCII-\w-runs were
+ turned into underscores in NAME tags. This could
+ result in several NAME tags becoming identical.
+ Reported by:
+
+ From: Fyodor Krasnov <fyodor@aha.ru>
+ Subject: pod2html vs Russian Characters
+ To: Tom.Christiansen@snn.aha.ru, tchrist@perl.com
+ Date: Tue, 24 Nov 1998 19:00:36 +0300 (MSK)
+ Message-Id: <199811241600.TAA05149@stat.aha.ru>
+
+ One paste too many in #2435.
+ Branch: maint-5.005/perl
+ !> lib/Pod/Html.pm lib/Pod/Text.pm
+ ____________________________________________________________________________
+ [ 2468] By: gbarr on 1998/12/12 15:01:58
+ Log: redirect trail program to error msg file in Configure
+
+ From: Andy Dougherty <doughera@lafayette.edu>
+ Date: Tue, 1 Dec 1998 13:40:12 -0500 (EST)
+ Message-Id: <Pine.SUN.3.96.981201133546.4288K-100000@newton.phys>
+ Subject: [PATCH 5.005_xx] Missing redirection of simple test program
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2467] By: gbarr on 1998/12/12 14:52:24
+ Log: Change reall_srchlen back to an int from a #define
+
+ From: Graham Barr <gbarr@ti.com>
+ Date: Mon, 30 Nov 1998 14:29:14 -0600
+ Message-ID: <19981130142914.X1504@asic.sc.ti.com>
+ Subject: [PATCH 5.005_03-MT!] Re: one compilation warning from 5_03-MT1
+ Branch: maint-5.005/perl
+ ! malloc.c
+ ____________________________________________________________________________
+ [ 2466] By: gbarr on 1998/12/12 14:40:56
+ Log: s/SCM_CREDENTIALSS/SCM_CREDENTIALs/ in Socket.xs
+
+ From: Andy Dougherty <doughera@lafayette.edu>
+ Date: Thu, 3 Dec 1998 11:26:25 -0500 (EST)
+ Message-Id: <Pine.SUN.3.96.981203112330.8800H-100000@newton.phys>
+ Subject: [PATCH 5.005_03-MAINT_TRIAL_1] Trivial grammar patch
+ Branch: maint-5.005/perl
+ ! Porting/Glossary
+ !> ext/Socket/Socket.xs
+ ____________________________________________________________________________
+ [ 2456] By: gsar on 1998/12/06 13:49:02
+ Log: branch perldelta.pod
+ Branch: maint-5.005/perl
+ +> pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2455] By: gsar on 1998/12/06 13:47:21
+ Log: clobber perldelta.pod to reestablish branch from perl5005delta.pod
+ Branch: maint-5.005/perl
+ - pod/perldelta.pod
+ ____________________________________________________________________________
+ [ 2415] By: gbarr on 1998/11/30 02:31:15
+ Log: Chnages,patchlevel.h etc...
+ Branch: maint-5.005/perl
+ ! Changes MANIFEST patchlevel.h t/op/tr.t win32/Makefile
+ ! win32/config_H.bc win32/config_H.gc win32/config_H.vc
+ ! win32/makefile.mk
+ ____________________________________________________________________________
+ [ 2411] By: gbarr on 1998/11/30 01:31:22
+ Log: integrated changes#2323,2353,2369
+
+ From: maeda@src.ricoh.co.jp
+ Date: Tue, 24 Nov 1998 10:37:45 +0900
+ Message-Id: <199811240137.KAA05867@luna.src.ricoh.co.jp>
+ Subject: format "..." bug
+
+ Locale collation, ctype, and numeric, were initialized wrong
+ (if LC_ALL or LANG were unset, so were the collation/ctype/numeric),
+ as reported by
+
+ From: Ilya.Sandler@etak.com (Ilya Sandler)
+ Subject: a bug in locale handling: LC_COLLATE ignored sometimes
+ Date: 25 Nov 1998 04:53:52 +0200
+ Message-ID: <MLIST_199811250226.SAA12590@axi001.etak.sw>
+
+ allow final period in a file (not followed by a newline) to
+ terminate format spec
+ Branch: maint-5.005/perl
+ ! pp_ctl.c toke.c util.c
+ !> t/op/write.t
+ ____________________________________________________________________________
+ [ 2408] By: gbarr on 1998/11/30 01:29:19
+ Log: integrated ext/B/... changes from mainline
+ Branch: maint-5.005/perl
+ !> ext/B/B.pm ext/B/B.xs ext/B/B/Assembler.pm ext/B/B/C.pm
+ !> ext/B/B/Disassembler.pm
+ ____________________________________________________________________________
+ [ 2404] By: gbarr on 1998/11/30 00:26:36
+ Log: integrate some of change#2318 from mainline
+ Branch: maint-5.005/perl
+ +> t/op/grent.t t/op/pwent.t
+ !> ext/DB_File/Changes ext/DB_File/DB_File.pm
+ !> ext/DB_File/DB_File.xs ext/POSIX/hints/dynixptx.pl
+ !> ext/Socket/Socket.pm ext/Socket/Socket.xs lib/Benchmark.pm
+ !> pod/perldata.pod t/op/sort.t
+ ____________________________________________________________________________
+ [ 2398] By: gbarr on 1998/11/29 22:11:16
+ Log: integrate changes#2254,2259,2335,2345,2348,2361,2368,2380 from mainline
+
+ win32_recvfrom() compatibility fix
+
+ From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ Subject: Re: [PATCH] Re: pod2man bug in date generated line
+ To: Albert Dvornik <bert@genscan.com>, "Larry W. Virden" <lvirden@cas.org>
+ Cc: perlbug@perl.com
+ Date: 20 Nov 1998 21:30:17 +0200
+ Message-ID: <MLIST_19981120131523.A464@O2.chapin.edu>
+
+ make $1 et al readonly under threads; make C<undef $1> fail like
+ C<$1 = undef> does
+
+ fix typo in pp_defined() causing C<defined %tied> to fail
+
+ more conservative version of changes#2345,2346,2347; those break
+ C<defined(@{"foo::ISA"})> which seems to be extensively used in
+ the libs :-(
+
+ fix uninitialized warnings
+ From: Brian Callaghan <callagh@itginc.com>
+ Date: Thu, 19 Nov 1998 17:49:10 -0800
+ Message-Id: <3654CA96.B64FCAEB@itginc.com>
+ Subject: Complete.pm patch (version 1.1)
+
+ Liblist tweak suggested by Swen Thuemmler <Swen.Thuemmler@paderlinx.de>;
+ add C<$Config{installarchlib}/CORE> to the default locations searched
+ on win32
+
+ prefer IO::Handle for IO if FileHandle:: is empty (as suggested by
+ Tim Bunce)
+ Branch: maint-5.005/perl
+ ! gv.c op.c pp.c
+ !> lib/ExtUtils/Liblist.pm lib/Term/Complete.pm pod/perlfaq4.pod
+ !> pod/pod2man.PL t/op/undef.t win32/win32sck.c
+ ____________________________________________________________________________
+ [ 2315] By: gbarr on 1998/11/27 05:16:50
+ Log: integrate change#2246 from mainline, while still allowing
+ C<sort $globref @foo>
+
+ allow C<sort $coderef @foo>
+ Branch: maint-5.005/perl
+ ! op.c sv.c
+ !> t/op/sort.t
+ ____________________________________________________________________________
+ [ 2314] By: gbarr on 1998/11/27 04:03:58
+ Log: integrate change#2159 from mainline
+
+ Data::Dumper update
+ Branch: maint-5.005/perl
+ !> ext/Data/Dumper/Changes ext/Data/Dumper/Dumper.pm
+ !> ext/Data/Dumper/Dumper.xs ext/Data/Dumper/Todo t/lib/dumper.t
+ ____________________________________________________________________________
+ [ 2313] By: gbarr on 1998/11/27 03:04:21
+ Log: Fix typo in change#2312
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs
+ ____________________________________________________________________________
+ [ 2312] By: gbarr on 1998/11/27 03:03:03
+ Log: integrate change#1837,1967,1986,2060,2068,2146,2214,2224,2300,2301 from mainline
+
+ (via private mail)
+ From: Charles Bailey <BAILEY@newman.upenn.edu>
+ Date: Sat, 05 Sep 1998 01:23:58 -0400 (EDT)
+ Message-id: <01J1FH7R43NS002F14@cor.newman.upenn.edu>
+ Subject: [Patch 5.005_02] Miscellaneous VMS cleanup
+
+ correct bugs exposed in MM_Unix.pm by commenting out Selfloader
+ (MAN3PODS cannot be set to ' '; stray stricture violation)
+
+ qualify names of builtins
+
+ handle '::' in section names properly
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 12:57:54 -0500
+ Message-ID: <19981017125754.C510@pobox.com>
+ Subject: Re: pod2html
+
+ From: Zachary Miller <zcmiller@simon.er.usgs.gov>
+ Date: Tue, 20 Oct 1998 20:52:20 -0500
+ Message-Id: <199810210152.UAA07792@simon.er.usgs.gov>
+ Subject: Exporter.pm's export_to_level() argument handling buggy
+
+ hand-apply whitespace-mutiliated patch
+ From: "vishal bhatia" <vishalb@hotmail.com>
+ Date: Wed, 28 Oct 1998 23:45:32 PST
+ Message-ID: <19981029074534.2334.qmail@hotmail.com>
+ Subject: [PATCH 5.005_52]Compiling modules,more bugfixes for B
+
+ typo in newHVhv()
+
+ avoid endless loops in Text::Wrap (from a suggestion by Lupe
+ Christoph <lupe@alanya.m.isar.de>)
+
+ properly free temporaries created by threads
+
+ fix PL_defoutgv leak under threads
+ Branch: maint-5.005/perl
+ !> (integrate 31 files)
+ ____________________________________________________________________________
+ [ 2311] By: gbarr on 1998/11/27 01:31:36
+ Log: integrate change#2210 from mainline
+
+ fix AvREALISH bogusness
+ Branch: maint-5.005/perl
+ ! av.c
+ !> t/op/array.t
+ ____________________________________________________________________________
+ [ 2310] By: gbarr on 1998/11/27 00:20:21
+ Log: integrate changes#2235,2299,2300 from mainline
+
+ catch a neophyte trap: open(<FH>), close(<FH>) etc.
+
+ fix C<if (...) { package Foo; ... }> misoptimization that fails
+ to set the package for the block properly
+
+ properly free temporaries created by threads
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs op.c perl.h util.c
+ !> t/comp/package.t
+ ____________________________________________________________________________
+ [ 2309] By: gbarr on 1998/11/27 00:16:36
+ Log: integrate change#2298 from mainline
+ Branch: maint-5.005/perl
+ !> universal.c
+ ____________________________________________________________________________
+ [ 2308] By: gbarr on 1998/11/27 00:11:44
+ Log: Updates for MPE/iX DynaLoader and installperl, via private mail
+ forwarded by Jarkko Hietaniemi from Mark Bixby
+ Branch: maint-5.005/perl
+ ! ext/DynaLoader/dl_mpeix.xs installperl
+ ____________________________________________________________________________
+ [ 2307] By: gbarr on 1998/11/27 00:07:27
+ Log: Remove docs for feature not in _0*
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+ ____________________________________________________________________________
+ [ 2306] By: gbarr on 1998/11/26 23:44:47
+ Log: Allow PL_FILES to have multiple targets from one source by allowing
+ an array ref as the value in the hash
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm
+ ! lib/ExtUtils/MakeMaker.pm
+ ____________________________________________________________________________
+ [ 2305] By: gbarr on 1998/11/26 23:38:06
+ Log: fix unsigned variables to use SvUV and sv_setuv
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/typemap
+ ____________________________________________________________________________
+ [ 2304] By: gbarr on 1998/11/26 23:36:17
+ Log: Fix embeded \n in ABSTRACT and <> in AUTHOR
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MM_Unix.pm
+ ____________________________________________________________________________
+ [ 2302] By: gbarr on 1998/11/26 15:27:03
+ Log: integrate changes#2177,2189,2228,2229 from cfgperl
+
+ 0**0 = 1, from
+
+ From: d-lewart@uiuc.edu (Daniel S. Lewart)
+ Subject: Math::Complex 0**0 patches
+ Date: Sun, 1 Nov 1998 19:21:48 -0600 (CST)
+ Message-Id: <199811020121.TAA28310@staff2.cso.uiuc.edu>
+
+ sysio.t failure: fix undefined order of evaluation, from
+
+ From: Spider Boardman <spider@web.zk3.dec.com>
+ Subject: Not OK: perl 5.00553 on alpha-thread 5.0 [PATCH]
+ Date: 4 Nov 1998 01:22:30 +0200
+ Message-ID: <MLIST_199811032227.RAA143892@web.zk3.dec.com>
+
+ From: "Martin J. Bligh" <mbligh@sequent.com>
+ Message-ID: <187803647.910720870@w-186d219.rhe.sequent.com>
+ Subject: Re: Making Perl work on DYNIX/ptx
+ Date: Tue, 10 Nov 1998 18:01:10 -0800
+
+ From: "Martin J. Bligh" <mbligh@sequent.com>
+ Subject: Re: Making Perl work on DYNIX/ptx
+ Date: Tue, 10 Nov 1998 16:24:26 -0800
+ Message-ID: <181999655.910715066@w-186d219.rhe.sequent.com>
+ Branch: maint-5.005/perl
+ +> ext/DB_File/hints/dynixptx.pl ext/POSIX/hints/dynixptx.pl
+ ! pp_sys.c
+ !> hints/dynixptx.sh lib/Math/Complex.pm t/lib/complex.t
+ ____________________________________________________________________________
+ [ 2297] By: gbarr on 1998/11/24 02:32:38
+ Log: integrate change#2266 from cfgperl
+ From: John Tobey <jtobey@channel1.com>
+ Subject: [PATCH] perlfaq typos
+ To: perl5-porters@perl.com
+ Date: 22 Nov 1998 04:25:15 +0200
+ Message-ID: <MLIST_m0zhPeF-000FOgC@feynman.localnet>
+ Branch: maint-5.005/perl
+ !> pod/perlfaq3.pod pod/perlfaq4.pod pod/perlfaq5.pod
+ !> pod/perlfaq7.pod pod/perlfaq8.pod
+ ____________________________________________________________________________
+ [ 2296] By: gbarr on 1998/11/24 01:39:18
+ Log: integrated changes#2011,2092,2106,2108,2143 from cfgperl
+
+ More robust yacc/bison failure output handling.
+
+ More robustness.
+
+ Bison says 'parse error', not 'parser error'.
+
+ The "parse error" must be converted to "syntax error",
+ just matching it aint' enough.
+
+ There can be multiple yacc/bison errors.
+ Branch: maint-5.005/perl
+ !> t/comp/require.t t/op/misc.t t/pragma/subs.t
+ !> t/pragma/warning.t
+ ____________________________________________________________________________
+ [ 2295] By: gbarr on 1998/11/24 00:49:28
+ Log: integrate change#1823 from mainline
+ From: Joe Buehler <jhpb@hekimian.com>
+ Date: 29 Aug 1998 17:13:28 -0400
+ Message-ID: <yd37lzro5jb.fsf@pandora.hekimian.com>
+ Subject: patches for perl 5.005_51 under U/WIN
+ Branch: maint-5.005/perl
+ +> hints/uwin.sh
+ ! Configure
+ !> installman makedepend.SH t/lib/posix.t
+ ____________________________________________________________________________
+ [ 2258] By: gbarr on 1998/11/21 20:48:02
+ Log: Another Configure patch from Jarkko
+ Branch: maint-5.005/perl
+ ! Configure
+ ____________________________________________________________________________
+ [ 2257] By: gbarr on 1998/11/21 17:23:13
+ Log: Big Configure patch from Jarkko Hietaniemi <jhi@iki.fi> via
+ private mail
+ Branch: maint-5.005/perl
+ ! Configure Makefile.SH config_h.SH hints/dec_osf.sh
+ ! hints/freebsd.sh hints/irix_6.sh hints/linux.sh
+ ! hints/next_3.sh hints/os390.sh pp_sys.c
+ ____________________________________________________________________________
+ [ 2239] By: gbarr on 1998/11/14 03:59:58
+ Log: more doc changes from mainline
+ Branch: maint-5.005/perl
+ ! pod/perldiag.pod pod/perlfunc.pod pod/perlre.pod
+ !> INSTALL README.vms vms/ext/Stdio/Stdio.pm
+ ____________________________________________________________________________
+ [ 2238] By: gbarr on 1998/11/14 02:51:51
+ Log: integrate doc changes from mainline, including
+ changes#1796,1811,1830,1831,1844,1846,1876,1905,2149,2152
+ Branch: maint-5.005/perl
+ !> README.os390 pod/perl.pod pod/perldelta.pod pod/perlfaq1.pod
+ !> pod/perlform.pod pod/perlfunc.pod pod/perlguts.pod
+ !> pod/perlipc.pod pod/perllocale.pod pod/perlport.pod
+ !> pod/perlref.pod pod/perlrun.pod pod/perlvar.pod pod/perlxs.pod
+ !> pod/pod2man.PL
+ ____________________________________________________________________________
+ [ 2237] By: gbarr on 1998/11/14 02:51:49
+ Log: integrate change#1847 from mainline
+ From: Roderick Schertler <roderick@argon.org>
+ Date: Wed, 09 Sep 1998 23:52:48 -0400
+ Message-ID: <20567.905399568@eeyore.ibcinc.com>
+ Subject: seed srand from /dev/urandom when possible
+ Branch: maint-5.005/perl
+ ! pp.c
+ ____________________________________________________________________________
+ [ 2232] By: gbarr on 1998/11/13 03:12:37
+ Log: integrate change#2215 from mainline
+ set close-on-exec bit on pipe() FDs
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod pod/perlvar.pod pp_sys.c
+ ____________________________________________________________________________
+ [ 2231] By: gbarr on 1998/11/13 02:16:03
+ Log: integrate change#2188 from mainline
+ fix return value of win32_pclose()
+ Branch: maint-5.005/perl
+ !> win32/win32.c
+ ____________________________________________________________________________
+ [ 2218] By: gbarr on 1998/11/08 16:48:44
+ Log: From: Graham Barr <gbarr@ti.com>
+ Date: Mon, 2 Nov 1998 07:38:52 -0600
+ Message-ID: <19981102073852.A12751@asic.sc.ti.com>
+ Subject: [PATCH 5.005_*] Re: IPC::Msg 1.03
+ Branch: maint-5.005/perl
+ ! ext/IPC/SysV/Msg.pm
+ ____________________________________________________________________________
+ [ 2217] By: gbarr on 1998/11/08 05:22:39
+ Log: fix changes in 2213 not to break binary compat
+ Branch: maint-5.005/perl
+ ! pp_ctl.c proto.h
+ ____________________________________________________________________________
+ [ 2216] By: gbarr on 1998/11/08 04:21:01
+ Log: integrate change#2192 from mainline
+ indeterminate order-of-evaluation fixes
+ Branch: maint-5.005/perl
+ ! mg.c
+ ____________________________________________________________________________
+ [ 2213] By: gbarr on 1998/11/08 00:39:44
+ Log: integrate change#2051 from mainline
+ properly restore PL_rsfp_filters after require
+ Branch: maint-5.005/perl
+ ! embed.h global.sym objXSUB.h objpp.h pp_ctl.c proto.h scope.c
+ ! scope.h
+ ____________________________________________________________________________
+ [ 2212] By: gbarr on 1998/11/07 23:13:29
+ Log: integrate changes#1914,1925,1926,1945,1956,1987 from mainline
+
+ normalize tm struct passed to strftime() with mktime()
+ From: Spider Boardman <spider@orb.nashua.nh.us>
+ Date: Wed, 30 Sep 1998 15:12:09 -0400
+ Message-Id: <199809301912.PAA26119@Orb.Nashua.NH.US>
+ Subject: [PATCH 5.005_52] Re: POSIX::strftime returns incorrect date
+
+ disable USE_THREADS when PERL_OBJECT is enabled
+
+ From: Mark-Jason Dominus <mjd@plover.com>
+ Date: Sun, 04 Oct 1998 14:48:11 -0400
+ Message-ID: <19981004184811.16048.qmail@plover.com>
+ Subject: PATCH: perldoc -f does not locate -e, -r, -x, etc.
+
+ defer "deep recursion" warnings until CXt_SUB context is properly
+ set up
+
+ Mutexen should be initialized only once.
+
+ perldoc pod update
+ From: Daniel Grisinger <dgris@perrin.dimensional.com>
+ Date: 06 Oct 1998 23:56:51 -0600
+ Message-ID: <m3g1d0kj8c.fsf@perrin.dimensional.com>
+ Subject: [PATCH _02 and _52] perldoc
+ Branch: maint-5.005/perl
+ ! gv.c op.c pp_hot.c
+ !> ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs utils/perldoc.PL
+ !> win32/Makefile win32/makefile.mk
+ ____________________________________________________________________________
+ [ 2207] By: gbarr on 1998/11/06 01:36:17
+ Log: integrate changes#1912,1948 from mainline
+ change warning about glob process failure
+ Branch: maint-5.005/perl
+ ! pod/perldiag.pod pp_hot.c
+ ____________________________________________________________________________
+ [ 2200] By: gbarr on 1998/11/05 04:26:26
+ Log: integrate changes#1840,1855,1860,1882,1884,1891,1900,1907 from mainline
+ pl2bat tweak from Tye McQueen <tye@metronet.com>
+
+ reset errno after C<require> search (as suggested by Larry)
+
+ upgrade to CPAN-1.40
+
+ missing file in last submit (1881)
+
+ temporarily disable perl malloc for a2p until we clean up
+ conflicting malloc() declarations everywhere
+
+ Fixed apostrophe problem from Mark Knutsen.
+
+ use SETERRNO() to reset errno (suggested by Charles Bailey)
+
+ applied patches, but retained old behavior for win32 (where compilers
+ can't read from stdin at all)
+ From: Graham Barr <gbarr@ti.com>
+ Date: Mon, 28 Sep 1998 09:41:49 -0500
+ Message-ID: <19980928094149.B26576@asic.sc.ti.com>
+ Subject: Re: 5.005_51 Errno invokes cpprun incorrectly
+ --
+ Date: Tue, 29 Sep 1998 12:35:43 -0500
+ Message-ID: <19980929123543.Z26576@asic.sc.ti.com>
+ Subject: Re: 5.005_51 Errno invokes cpprun incorrectly
+
+ and ext/Errno/Errno_pm.PL from change#2050
+ Branch: maint-5.005/perl
+ ! perl.h pp_ctl.c proto.h sv.h
+ !> ext/Errno/Errno_pm.PL lib/CPAN.pm lib/CPAN/FirstTime.pm
+ !> win32/bin/pl2bat.pl x2p/Makefile.SH
+ ____________________________________________________________________________
+ [ 2199] By: gbarr on 1998/11/05 03:35:00
+ Log: integrate changes#1817,1856,1869,1909 from mainline
+ updated usethreads hints for hpux 10.X
+ From: Matthew T Harden <mthard@mthard1.monsanto.com>
+ Date: Fri, 28 Aug 1998 14:10:42 GMT
+ Message-Id: <199808281410.AA11058@mthard1.monsanto.com>
+ Subject: Re: OK: perl 5.00502 on PA-RISC1.1-thread 10.20 (UNINSTALLED)
+
+ update hints for OPENSTEP 4.2 on i386
+ From: Gerben Wierda <Gerben_Wierda@RnA.nl>
+ Date: Sun, 20 Sep 1998 01:03:18 +0200
+ Message-Id: <9809192303.AA29190@Spike>
+ Subject: Perl 5.005_02 compilation problems
+
+ use STRICT_ALIGNMENT on IRIX to allow usemymalloc=y again
+ From: Scott Henry <scotth@sgi.com>
+ Date: 13 Aug 1998 09:52:15 PDT
+ Message-Id: <yd8pve46czk.fsf@hoshi.engr.sgi.com>
+ Subject: [PATCH] Irix USE_LONG_LONG/malloc.c incompatibility (was...)
+
+ update SCO hints for dynamic loading
+ From: Andy Dougherty <doughera@lafcol.lafayette.edu>
+ Date: Mon, 28 Sep 1998 16:50:38 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980928164648.8130E-100000@newton.phys>
+ Subject: [PATCH 5.004_04-MAINT_TRIAL_5 and 5.005_xx] Re: Perl on SCO_SV
+ --
+ Date: Tue, 29 Sep 1998 16:48:55 -0400 (EDT)
+ Message-Id: <Pine.SUN.3.96.980929164612.8634A-100000@newton.phys>
+ Subject: Re: [PATCH 5.004_04-MAINT_TRIAL_5 and 5.005_xx] Re: Perl on SCO_SV
+ Branch: maint-5.005/perl
+ !> hints/hpux.sh hints/irix_6.sh hints/next_4.sh hints/sco.sh
+ ____________________________________________________________________________
+ [ 2198] By: gbarr on 1998/11/05 03:00:51
+ Log: integrate OS2 changes from mainline, change#1836,1930,1996,2063
+ and os2/os2,c from #2145
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 5 Sep 1998 00:14:51 -0400 (EDT)
+ Message-Id: <199809050414.AAA19801@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] OS/2 spawning typos
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Message-Id: <199810050637.CAA07781@monk.mps.ohio-state.edu>
+ Date: Mon, 5 Oct 1998 02:37:43 -0400 (EDT)
+ Subject: [PATCH 5.005_52] Cumulative OS/2-related patch
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 13 Oct 1998 04:46:00 -0400 (EDT)
+ Message-Id: <199810130846.EAA00769@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_52] Memory overrun in os2.c
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sun, 18 Oct 1998 23:20:57 -0400 (EDT)
+ Message-Id: <199810190320.XAA28249@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Improve sbrk() on OS/2
+
+ remaining PL_foo stragglers
+ Branch: maint-5.005/perl
+ ! mg.c perl_exp.SH util.c
+ !> hints/os2.sh os2/Changes os2/Makefile.SHs os2/os2.c
+ ____________________________________________________________________________
+ [ 2197] By: gbarr on 1998/11/05 02:15:53
+ Log: integrate changes#1826,1862 from mainline
+
+ From: Jarkko Hietaniemi <jhi@iki.fi>
+ Date: Wed, 12 Aug 1998 22:41:37 +0300 (EET DST)
+ Message-Id: <199808121941.WAA06263@alpha.hut.fi>
+ Subject: [PATCH] 5.004_50 or 5.005_02: get rid of interp.sym because not even AIX needs it
+
+ remove bogus warn()
+ Branch: maint-5.005/perl
+ - interp.sym
+ ! MANIFEST Makefile.SH embed.pl perl_exp.SH
+ ____________________________________________________________________________
+ [ 2194] By: gbarr on 1998/11/05 01:26:46
+ Log: integarte malloc.c changes from mainline change#1807,2112,2133
+ Branch: maint-5.005/perl
+ !> malloc.c
+ ____________________________________________________________________________
+ [ 2193] By: gbarr on 1998/11/05 01:25:31
+ Log: integrate changes#1763,1778,1801,1804 from mainline
+
+ From: Stephen McCamant <alias@mcs.com>
+ Date: Sun, 2 Aug 1998 16:33:18 -0500 (CDT)
+ Message-ID: <13764.55116.921952.837027@alias-2.pr.mcs.net>
+ Subject: [PATCH] Eliminate superfluous RV2p[AH]Vs in oops[AH]V()
+
+ Implicit require during compile reset line numbering
+
+ silence redefined warning for XS(INIT) {}
+
+ From: Laszlo Molnar <molnarl@cdata.tvnet.hu>
+ Date: Sun, 9 Aug 1998 22:38:23 +0200
+ Message-ID: <19980809223823.A215@cdata.tvnet.hu>
+ Subject: [PATCH 5.5002] dos-djgpp update
+ Branch: maint-5.005/perl
+ ! op.c pp_ctl.c
+ !> t/io/fs.t
+ ____________________________________________________________________________
+ [ 2176] By: gbarr on 1998/11/02 04:51:48
+ Log: integrate change#2030 from mainline
+
+ fix handling of mayhaps-extended @_ in goto &sub
+ Branch: maint-5.005/perl
+ ! av.c pp_ctl.c
+ !> t/op/goto.t
+ ____________________________________________________________________________
+ [ 2175] By: gbarr on 1998/11/02 04:32:02
+ Log: integrate chnage#1934,1935 from mainline
+ fix USE_THREADS coredump due to uninitialized PL_hv_fetch_ent_mh
+ add test for previous fix
+ Branch: maint-5.005/perl
+ ! util.c
+ !> ext/Thread/create.t
+ ____________________________________________________________________________
+ [ 2174] By: gbarr on 1998/11/02 04:22:20
+ Log: integrate change#1863,1881 from mainline
+
+ provide locked access to string table for USE_THREADS
+
+ serial access to PL_x[inpr]v_root for USE_THREADS
+ Branch: maint-5.005/perl
+ ! embedvar.h objXSUB.h perl.c proto.h sv.c
+ !> hv.c intrpvar.h thread.h
+ ____________________________________________________________________________
+ [ 2173] By: gbarr on 1998/11/02 04:10:46
+ Log: integrate change#1990 from mainline
+
+ provide option to enable optimization with VC (suggested by Jan
+ Dubois)
+ Branch: maint-5.005/perl
+ !> win32/Makefile win32/makefile.mk
+ ____________________________________________________________________________
+ [ 2172] By: gbarr on 1998/11/02 02:52:29
+ Log: integrate changes#1944,1948,1966 from mainline
+
+ change#1614 merely disabled earlier fix (doh!); undo it and properly
+ fixup the cop_seq value that must be seen by lexical lookups that
+ emanate within eval''
+
+ tweak to make fix in change#1944 behave correctly for closures
+ created within eval''
+ Branch: maint-5.005/perl
+ ! op.c pp_ctl.c pp_hot.c scope.c
+ !> cop.h t/op/eval.t
+ ____________________________________________________________________________
+ [ 2171] By: gbarr on 1998/11/01 03:59:39
+ Log: integrate changes 1835,2003,2067 and File::Find change in 1938
+ warn on C<my($foo,$foo)>
+
+ silence -w noises (suggested by Greg Bacon) Term::Complete
+
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Wed, 21 Oct 1998 00:55:51 +0200
+ Message-ID: <36380269.55370608@smtp1.ibm.net>
+ Subject: Make _really_ sure Dynaloader.xs code is initialized only once
+ Branch: maint-5.005/perl
+ ! op.c pod/perldiag.pod
+ !> ext/DynaLoader/DynaLoader_pm.PL lib/File/Find.pm
+ !> lib/Term/Complete.pm
+ ____________________________________________________________________________
+ [ 2170] By: gbarr on 1998/11/01 03:48:38
+ Log: integrate change 1992 from mainline
+
+ applied suggested patch with small doc tweak
+ From: Gisle Aas <gisle@aas.no>
+ Date: 11 Oct 1998 12:53:13 +0200
+ Message-ID: <m3u31bfjza.fsf@furu.g.aas.no>
+ Subject: Re: [PATCH 5.005_52] Optional syswrite LENGTH argument
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod pp_sys.c
+ !> opcode.h opcode.pl t/op/sysio.t t/op/tiehandle.t
+ ____________________________________________________________________________
+ [ 2168] By: gbarr on 1998/11/01 01:58:58
+ Log: From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Fri, 09 Oct 1998 23:28:31 +0200
+ Message-ID: <36217b7f.3193091@smtp1.ibm.net>
+ Subject: [PATCH 5.005_02] Allow XS access to vtbl_*s when compiled with PERL_OBJECT
+ Branch: maint-5.005/perl
+ ! XSUB.h
+ ____________________________________________________________________________
+ [ 2167] By: gbarr on 1998/11/01 01:22:41
+ Log: integrate change#2029 from mainline
+ restore sanity to "constant" references
+ Branch: maint-5.005/perl
+ ! op.c pod/perldiag.pod
+ !> lib/constant.pm t/pragma/constant.t
+ ____________________________________________________________________________
+ [ 2166] By: gbarr on 1998/11/01 01:04:24
+ Log: integrate changes#1895,1896,2066,2147,2148 from mainline
+ fix win32_stat() to do the right thing for share names
+
+ small tweak on last change
+
+ recognize '%' as a shell metachar for win32
+ From: jan.dubois@ibm.net (Jan Dubois)
+ Date: Tue, 20 Oct 1998 21:57:35 +0200
+ Message-ID: <3636ea31.49170453@smtp1.ibm.net>
+ Subject: [PATCH 5.005_02, Win32] Re: %ENV% not expanded in backquotes?
+
+ tweaked version of suggested patch
+ From: Anton Berezin <tobez@plab.ku.dk>
+ Date: 29 Oct 1998 14:48:54 +0100
+ Message-ID: <86yapzv5q1.fsf@lion.plab.ku.dk>
+ Subject: [PATCH 5.005_52] One more problem with win32_stat and MSVC
+
+ From: Anton Berezin <tobez@plab.ku.dk>
+ Date: 29 Oct 1998 17:06:25 +0100
+ Message-ID: <86pvbbuzcu.fsf@lion.plab.ku.dk>
+ Subject: [PATCH 5.005_52] win32_opendir() fails on empty drives
+ Branch: maint-5.005/perl
+ !> win32/win32.c
+ ____________________________________________________________________________
+ [ 2165] By: gbarr on 1998/11/01 00:10:15
+ Log: integrated changes#1941,1942,1943,1975,2061,2111,2151 from mainline
+
+ don't longjmp() in pp_goto() (regressive bug from old single-stack
+ implementation)
+
+ force copy of substrings when matching against temporaries
+
+ ensure recursive attempts to findlex()icals know enough about where
+ the last eval'' context was encountered
+
+ propagate typeness of lexicals while cloning them
+
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 22:22:02 -0500
+ Message-ID: <19981017222202.J510@pobox.com>
+ Subject: Re: '*' prototype does not allow bareword with strict
+
+ smarter C<$SIG{FOO} = BAREWORD;> warning
+
+ From: Mark-Jason Dominus <mjd@plover.com>
+ Date: Fri, 30 Oct 1998 14:24:23 EST
+ Message-Id: <19981030192423.27276.qmail@plover.com>
+ Subject: PATCH: (5.005_02) a2p should use `chomp' instead of `chop'
+ Branch: maint-5.005/perl
+ ! op.c pp_ctl.c pp_hot.c t/op/pat.t toke.c
+ !> t/op/eval.t t/op/runlevel.t x2p/walk.c
+ ____________________________________________________________________________
+ [ 2158] By: gbarr on 1998/10/31 05:03:02
+ Log: integrate changes#1821 & 1857 from mainline
+
+ s/runops/CALLRUNOPS/
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 22 Sep 1998 17:30:16 -0400 (EDT)
+ Message-Id: <199809222130.RAA17034@monk.mps.ohio-state.edu>
+ Subject: More verbose Test::Harness [PATCH]
+ Branch: maint-5.005/perl
+ !> cc_runtime.h lib/Test/Harness.pm
+ ____________________________________________________________________________
+ [ 2157] By: gbarr on 1998/10/31 02:35:07
+ Log: integrate change#1839 from mainline
+ From: Drago Goricanec <drago@raptor.otsd.ts.fujitsu.co.jp>
+ Date: Mon, 7 Sep 1998 17:36:09 +0900
+ Message-Id: <199809070836.RAA14631@raptor.otsd.ts.fujitsu.co.jp>
+ Subject: Thread::cond_wait bug in 5.005.51 causes deadlock
+ Branch: maint-5.005/perl
+ ! ext/Thread/Thread.xs
+ ____________________________________________________________________________
+ [ 2156] By: gbarr on 1998/10/31 02:22:11
+ Log: integrate change#1829 from mainline
+ fix problematic typecast in filter_del()
+ From: Mark P Lutz <tecmpl1@triton.ca.boeing.com>
+ Date: Mon, 31 Aug 1998 21:13:11 GMT
+ Message-Id: <199808312113.VAA53356@triton.ca.boeing.com>
+ Subject: perl5.005_02 does not build on Cray T90
+ Branch: maint-5.005/perl
+ ! toke.c
+ ____________________________________________________________________________
+ [ 2155] By: gbarr on 1998/10/31 01:59:08
+ Log: integrate chnages#1824,2118 from mainline
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Sat, 29 Aug 1998 17:38:30 -0400 (EDT)
+ Message-Id: <199808292138.RAA18359@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Protect debugger from nonlocal exits
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Wed, 28 Oct 1998 01:23:27 -0500 (EST)
+ Message-Id: <199810280623.BAA06968@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.00552] Minor debugger tweaks
+ Branch: maint-5.005/perl
+ !> lib/perl5db.pl
+ ____________________________________________________________________________
+ [ 2154] By: gbarr on 1998/10/31 01:06:35
+ Log: integrate all lib/ExtUtils/... changes from mainline
+ Branch: maint-5.005/perl
+ !> lib/ExtUtils/MM_OS2.pm lib/ExtUtils/MM_Unix.pm
+ !> lib/ExtUtils/MM_VMS.pm lib/ExtUtils/MM_Win32.pm
+ !> lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Mkbootstrap.pm
+ !> lib/ExtUtils/Mksymlists.pm lib/ExtUtils/xsubpp
+ ____________________________________________________________________________
+ [ 2139] By: gbarr on 1998/10/30 04:17:53
+ Log: apply chnage#2071 from mainline
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 20:42:41 -0500
+ Message-ID: <19981017204241.G510@pobox.com>
+ Subject: Re: taint checking for: use lib "$ENV{'EVIL'}"
+ Branch: maint-5.005/perl
+ ! pp_ctl.c
+ ____________________________________________________________________________
+ [ 2138] By: gbarr on 1998/10/30 04:14:35
+ Log: apply change#2077 from mainline
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 24 Oct 1998 21:45:50 -0500
+ Message-ID: <19981024214550.C508@pobox.com>
+ Subject: Re: die with a reference should use overload "" operator
+ Branch: maint-5.005/perl
+ ! pp_ctl.c
+ ____________________________________________________________________________
+ [ 2137] By: gbarr on 1998/10/30 04:01:06
+ Log: integrate change#1937 from mainline
+ fix $/ init for USE_THREADS
+ Branch: maint-5.005/perl
+ ! perl.c
+ ____________________________________________________________________________
+ [ 2136] By: gbarr on 1998/10/30 03:40:55
+ Log: apply change#2076 from mainline
+ From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 24 Oct 1998 12:45:21 -0500
+ Message-ID: <19981024124521.C512@pobox.com>
+ Subject: [PATCH 5.005_02] Re: Auto-incrementing tied scalar causes SEGV
+ Branch: maint-5.005/perl
+ ! sv.c
+ ____________________________________________________________________________
+ [ 2135] By: gbarr on 1998/10/30 03:28:29
+ Log: integrate change#1873 from mainline
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 25 Aug 1998 04:29:49 -0400 (EDT)
+ Message-Id: <199808250829.EAA02470@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_*] Extraneous warning for (?()A|B)
+ Branch: maint-5.005/perl
+ ! regcomp.c
+ ____________________________________________________________________________
+ [ 2134] By: gbarr on 1998/10/30 03:15:12
+ Log: integrate change#1816 from mainline
+ don't create empty directories in installperl
+ From: Robin Barker <rmb1@cise.npl.co.uk>
+ Date: Fri, 21 Aug 1998 11:29:24 +0100 (BST)
+ Message-Id: <199808211029.LAA00551@cyclone.cise.npl.co.uk>
+ Subject: [PATCH 5.005_02] install: empty dirs
+ Branch: maint-5.005/perl
+ !> installperl
+ ____________________________________________________________________________
+ [ 2132] By: gbarr on 1998/10/30 01:39:00
+ Log: integrate changes#1815 & 1828 from mainline
+ make behavior of /(a{3})+/ like /(aaa)+/ w.r.t where it matches
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 21 Aug 1998 05:41:02 -0400 (EDT)
+ Message-Id: <199808210941.FAA16467@monk.mps.ohio-state.edu>
+ Subject: Re: your mail
+
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Mon, 31 Aug 1998 14:52:10 -0400 (EDT)
+ Message-Id: <199808311852.OAA24676@monk.mps.ohio-state.edu>
+ Subject: [PATCH 5.005_5*] (?>) broken in RE
+ Branch: maint-5.005/perl
+ ! regexec.c
+ !> t/op/re_tests
+ ____________________________________________________________________________
+ [ 2131] By: gbarr on 1998/10/30 01:09:19
+ Log: integrate change#1947 from mainline
+ let docatch() pass the buck when restartop turns out to be null,
+ making exceptions in BEGIN{} propagate as expected
+ Branch: maint-5.005/perl
+ ! pp_ctl.c
+ !> t/op/misc.t
+ ____________________________________________________________________________
+ [ 2129] By: gbarr on 1998/10/29 14:53:11
+ Log: integrate change#1810 from mainline
+ fix bogus integerization of pop()'s return value
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Sat, 15 Aug 1998 23:27:54 -0400
+ Message-Id: <199808160327.XAA05186@aatma.engin.umich.edu>
+ Subject: Re: Complex expression does integer arithmetic
+ Branch: maint-5.005/perl
+ !> opcode.h opcode.pl
+ ____________________________________________________________________________
+ [ 2128] By: gbarr on 1998/10/29 14:28:13
+ Log: integrate change#1870 from mainline
+ From: Dan Sugalski <sugalskd@osshe.edu>
+ Date: Fri, 14 Aug 1998 09:20:16 PDT
+ Message-Id: <3.0.5.32.19980814092016.00b37dc0@ous.edu>
+ Subject: [PATCH 5.005_02] (and _5x I expect) VMS config procedure patch
+ Branch: maint-5.005/perl
+ !> configure.com
+ ____________________________________________________________________________
+ [ 2127] By: gbarr on 1998/10/29 13:36:29
+ Log: Integrate change#1789 from mainline
+ delay freeing itervar so C<for $i (@a) { return($i) }> works
+ Branch: maint-5.005/perl
+ !> cop.h t/cmd/for.t
+ ____________________________________________________________________________
+ [ 2123] By: gbarr on 1998/10/29 02:43:01
+ Log: Apply change#2075 from mainline
+ fix C<print $n += 5;> etc.
+ Branch: maint-5.005/perl
+ ! toke.c
+ ____________________________________________________________________________
+ [ 2122] By: gbarr on 1998/10/29 02:40:31
+ Log: Apply change#2070 from mainline
+ avoid bogus line number in XSUB redefined warnings
+ Branch: maint-5.005/perl
+ ! op.c
+ ____________________________________________________________________________
+ [ 2121] By: gbarr on 1998/10/29 02:38:59
+ Log: Apply change#2052 from mainline
+ avoid the circular refcnt logic in magic_mutexfree()
+ Branch: maint-5.005/perl
+ ! mg.c pp.c pp_hot.c
+ ____________________________________________________________________________
+ [ 2120] By: gbarr on 1998/10/29 02:36:23
+ Log: Remove "5.005" hard-coded and expose vtbl_* from the perl DLL
+ From: "Douglas Lankshear" <dougl@ActiveState.com>
+ Date: Mon, 28 Sep 1998 08:49:13 -0700
+ Message-ID: <000001bdeaf7$8a189350$a32fa8c0@tau.Active>
+ Subject: PATCH [5.005_02] update
+ Branch: maint-5.005/perl
+ ! embed.h global.sym objXSUB.h objpp.h perl.h proto.h util.c
+ ! win32/win32.c
+ ____________________________________________________________________________
+ [ 2084] By: gbarr on 1998/10/25 19:09:11
+ Log: Integrate change#2069 from mainline
+ From: Martijn Koster <mak@excitecorp.com>
+ Date: Wed, 21 Oct 1998 13:12:03 +0100
+ Message-ID: <19981021131203.A15661@excitecorp.com>
+ Subject: File::Path::mkpath reports the wrong error
+ Branch: maint-5.005/perl
+ !> lib/File/Path.pm
+ ____________________________________________________________________________
+ [ 2083] By: gbarr on 1998/10/25 18:48:39
+ Log: Integrate change#1965 from mainline
+ use better numbers for exitstatus test
+ Branch: maint-5.005/perl
+ !> t/op/die_exit.t
+ ____________________________________________________________________________
+ [ 2082] By: gbarr on 1998/10/25 18:22:54
+ Log: Apply change 2054 from mainline
+ disallow 'x' in hex numbers (except leading '0x')
+ From: Gisle Aas <gisle@aas.no>
+ Date: 16 Oct 1998 16:33:12 +0200
+ Message-ID: <m3n26wtw47.fsf@furu.g.aas.no>
+ Subject: Re: [PATCH 5.005_52] 'x' is not a legal hex digit
+ Branch: maint-5.005/perl
+ ! perlvars.h util.c
+ !> t/op/oct.t
+ ____________________________________________________________________________
+ [ 2081] By: gbarr on 1998/10/25 17:58:04
+ Log: Apply change #1998 from mainline
+ skip readonly vars and unref references when doing a reset()
+ Branch: maint-5.005/perl
+ ! sv.c
+ ____________________________________________________________________________
+ [ 2080] By: gbarr on 1998/10/25 16:06:35
+ Log: Integrate changes #2072 & #1993 from mainline
+ fix bug in B::CC::pp_sassign()
+ From: "vishal bhatia" <vishalb@hotmail.com>
+ Date: Sun, 11 Oct 1998 18:41:38 PDT
+ Message-ID: <19981012014139.19614.qmail@hotmail.com>
+ Subject: B::CC problems with pp_sassign routine
+ implement C<goto &func> and other fixes (via private mail)
+ From: "vishal bhatia" <vishalb@hotmail.com>
+ Date: Wed, 21 Oct 1998 22:59:03 PDT
+ Message-Id: <19981022055904.20083.qmail@hotmail.com>
+ Subject: [PATCH 5.005_52] More fixes for B
+ Branch: maint-5.005/perl
+ !> ext/B/B.pm ext/B/B.xs ext/B/B/C.pm ext/B/B/CC.pm
+ ____________________________________________________________________________
+ [ 2079] By: gbarr on 1998/10/25 14:08:00
+ Log: integrate from mainline more FSF address changes
+ Branch: maint-5.005/perl
+ !> Copying ext/B/README lib/Getopt/Long.pm
+ ____________________________________________________________________________
+ [ 2053] By: gbarr on 1998/10/25 04:56:47
+ Log: From: Graham Barr <gbarr@pobox.com>
+ Date: Sat, 17 Oct 1998 23:05:18 -0500
+ Message-ID: <19981017230518.K510@pobox.com>
+ Subject: Re: redo LOOP not restoring $` $' $&
+ Branch: maint-5.005/perl
+ ! cop.h t/cmd/while.t
+ ____________________________________________________________________________
+ [ 2048] By: gbarr on 1998/10/24 04:20:10
+ Log: Change Free Software Foundation address in README
+ Branch: maint-5.005/perl
+ !> README
+ ____________________________________________________________________________
+ [ 2047] By: gbarr on 1998/10/24 04:02:20
+ Log: Remove #ifdef DEBUGGING around SvTEMP_off
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Mon, 28 Sep 1998 15:23:39 -0400
+ Message-Id: <199809281923.PAA10303@aatma.engin.umich.edu>
+ Subject: Re: [PATCH] Re: 5.005_52: the miniperl coredump: touch magic and you're toast
+ Branch: maint-5.005/perl
+ ! scope.c
+ ____________________________________________________________________________
+ [ 2046] By: gbarr on 1998/10/24 04:00:54
+ Log: use cpp symbols instead of hardwired constants
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Mon, 05 Oct 1998 09:23:33 +0100
+ Message-Id: <199810050823.JAA00891@crypt.compulink.co.uk>
+ Subject: [PATCH 5.005_52] By the numbers (resend)
+ Branch: maint-5.005/perl
+ ! op.c
+ ____________________________________________________________________________
+ [ 2045] By: gbarr on 1998/10/24 03:50:25
+ Log: squelch undef warnings
+ From: Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Date: Fri, 02 Oct 1998 11:01:14 +0100
+ Message-Id: <199810021001.LAA19214@crypt.compulink.co.uk>
+ Subject: [PATCH] Re: Apparent bug in Math::BigInt
+ Branch: maint-5.005/perl
+ !> lib/Math/BigInt.pm
+ ____________________________________________________________________________
+ [ 2044] By: gbarr on 1998/10/24 03:47:24
+ Log: Add note to INSTALL about ANSI C
+ Branch: maint-5.005/perl
+ ! INSTALL
+ ____________________________________________________________________________
+ [ 2043] By: gbarr on 1998/10/24 02:38:12
+ Log: make C<goto &sub> AUTOLOAD-aware (autouse now works for modules
+ that are autoloaded)
+ From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Thu, 24 Sep 1998 03:01:01 -0400
+ Message-Id: <199809240701.DAA16223@aatma.engin.umich.edu>
+ Subject: Re: autouse and Getopt::Long don't work together anymore
+ Branch: maint-5.005/perl
+ ! pp_ctl.c t/op/goto.t
+ ____________________________________________________________________________
+ [ 2042] By: gbarr on 1998/10/24 02:16:26
+ Log: From: jarkko.hietaniemi@research.nokia.com (Jarkko Hietaniemi)
+ Date: Wed, 12 Aug 1998 15:42:35 +0300
+ Message-Id: <199808121242.PAA29761@comanche.spices>
+ Subject: [PATCH] 5.004_02 or 5.005_51: fix regexp and tr character ranges in non-ASCII lands
+ Branch: maint-5.005/perl
+ + t/op/tr.t
+ ! MANIFEST perl.h pod/perllocale.pod pod/perlop.pod
+ ! pod/perlre.pod regcomp.c t/pragma/locale.t toke.c
+ ____________________________________________________________________________
+ [ 2021] By: gbarr on 1998/10/20 01:25:23
+ Log: From: Chip Salzenberg <chip@perlsupport.com>
+ Date: Tue, 6 Oct 1998 13:33:05 -0400
+ Message-ID: <19981006133305.A2348@perlsupport.com>
+ Subject: [PATCH] 5.005_02: Eliminate leak on self-ties
+ Branch: maint-5.005/perl
+ ! av.c doop.c hv.c mg.c mg.h pp.c pp_hot.c pp_sys.c scope.c
+ ! t/op/tie.t
+ ____________________________________________________________________________
+ [ 2015] By: gbarr on 1998/10/17 21:49:56
+ Log: make h2xs generate ANSI prototypes
+ Branch: maint-5.005/perl
+ !> utils/h2xs.PL
+ ____________________________________________________________________________
+ [ 2014] By: gbarr on 1998/10/17 20:31:42
+ Log: Fix POSIX::sigprocmask not to check type of $old parameter
+ as it is output only
+ Branch: maint-5.005/perl
+ ! ext/POSIX/POSIX.xs
+ ____________________________________________________________________________
+ [ 2013] By: gbarr on 1998/10/17 17:51:16
+ Log: From: "Kurt D. Starsinic" <kstar@chapin.edu>
+ Date: Thu, 20 Aug 1998 20:59:03 -0400
+ Message-ID: <19980820205903.A12908@O2.chapin.edu>
+ Subject: [PATCH] h2ph misquotes #error directives
+
+ fix h2ph handling of C<#error "foo">
+ From: SAKAI Kiyotaka <ksakai@netwk.ntt-at.co.jp>
+ Date: Thu, 10 Sep 1998 09:59:33 +0900
+ Message-Id: <19980910095933N.ksakai@netwk.ntt-at.co.jp>
+ Subject: [5.005_02] h2ph problem
+ Branch: maint-5.005/perl
+ !> t/lib/h2ph.pht utils/h2ph.PL
+ ____________________________________________________________________________
+ [ 1985] By: gbarr on 1998/10/17 00:41:40
+ Log: s/last/first/ typo in append_list()
+ Branch: maint-5.005/perl
+ ! op.c
+ ____________________________________________________________________________
+ [ 1984] By: gbarr on 1998/10/17 00:36:51
+ Log: From: "Green, Paul" <pgreen@seussnt.stratus.com>
+ Date: Thu, 10 Sep 1998 00:02:07 -0400
+ Message-ID: <646CD0392810D211B04A00A024BF26FB1022EB@terminator.sw.stratus.com>
+ Subject: RE: [PATCH] 5.005_02 and 5.005_51: Stratus VOS port
+ Branch: maint-5.005/perl
+ + README.vos vos/Changes vos/build.cm vos/compile_perl.cm
+ + vos/config.h vos/config_h.SH_orig vos/perl.bind
+ + vos/test_vos_dummies.c vos/vos_dummies.c vos/vosish.h
+ ! MANIFEST perl.c perl.h pod/perlport.pod
+ ____________________________________________________________________________
+ [ 1983] By: gbarr on 1998/10/17 00:23:31
+ Log: define PUT_svindex(), PUT_opindex()
+ Branch: maint-5.005/perl
+ !> ext/B/B/Assembler.pm
+ ____________________________________________________________________________
+ [ 1982] By: gbarr on 1998/10/17 00:20:57
+ Log: From: Jochen Wiedmann <joe@ispsoft.de>
+ Date: Thu, 17 Sep 1998 17:16:06 +0200
+ Message-ID: <360127B6.E44564A@ispsoft.de>
+ Subject: [PATCH] ExtUtils::MakeMaker::prompt cannot return 0
+ Branch: maint-5.005/perl
+ ! lib/ExtUtils/MakeMaker.pm
+ ____________________________________________________________________________
+ [ 1981] By: gbarr on 1998/10/16 02:58:10
+ Log: better CR-handling on shebang line and in formats (fixed variant of
+ patch suggested by Igor Sysoev <igor@nitek.ru>)
+ Branch: maint-5.005/perl
+ ! perl.c toke.c
+ ____________________________________________________________________________
+ [ 1980] By: gbarr on 1998/10/16 02:21:57
+ Log: From: Roderick Schertler <roderick@argon.org>
+ Date: 11 Sep 1998 16:19:21 -0400
+ Message-ID: <pzyarqpfli.fsf@eeyore.ibcinc.com>
+ Subject: Re: Open2 and memory leaks
+ Branch: maint-5.005/perl
+ !> lib/IPC/Open3.pm
+ ____________________________________________________________________________
+ [ 1979] By: gbarr on 1998/10/16 02:15:54
+ Log: integrate change #1908 from mainline
+ Branch: maint-5.005/perl
+ !> lib/File/Find.pm
+ ____________________________________________________________________________
+ [ 1977] By: gbarr on 1998/10/16 01:52:46
+ Log: tests missing from change #1794
+ Branch: maint-5.005/perl
+ ! t/op/re_tests
+ ____________________________________________________________________________
+ [ 1794] By: gbarr on 1998/09/20 15:59:20
+ Log: From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Tue, 11 Aug 1998 18:43:29 -0400 (EDT)
+ Message-Id: <199808112243.SAA14243@monk.mps.ohio-state.edu>
+ Subject: Re: Segmentation fault for /a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz/
+ Branch: maint-5.005/perl
+ ! regcomp.c t/op/re_tests
+ ____________________________________________________________________________
+ [ 1793] By: gbarr on 1998/09/20 15:39:41
+ Log: From: Peter Prymmer <pvhp@forte.com>
+ Date: Mon, 10 Aug 98 16:58:22 PDT
+ Message-Id: <9808102358.AA10616@forte.com>
+ Subject: fix for unpack('u') failures on OS/390
+ Branch: maint-5.005/perl
+ ! pp.c
+ ____________________________________________________________________________
+ [ 1792] By: gbarr on 1998/09/20 15:11:33
+ Log: From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Date: Sun, 9 Aug 1998 15:51:48 +0100
+ Message-Id: <E0z5Wp2-00071p-00@taurus.cus.cam.ac.uk>
+ Subject: Fix typo, change "an array" to "a hash"
+ Branch: maint-5.005/perl
+ ! pod/perlfunc.pod
+ ____________________________________________________________________________
+ [ 1791] By: gbarr on 1998/09/20 14:49:26
+ Log: From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Wed, 16 Sep 1998 22:13:17 -0400
+ Message-Id: <199809170213.WAA10546@aatma.engin.umich.edu>
+ Subject: fill gaps in sig_* entries in win32/config.?c
+ and resync win32/config.?c with Porting/config.sh to pick up apiversion
+ Branch: maint-5.005/perl
+ ! win32/config.bc win32/config.gc win32/config.vc
+ ____________________________________________________________________________
+ [ 1790] By: gbarr on 1998/09/20 14:40:56
+ Log: From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Sun, 06 Sep 1998 15:35:11 -0400
+ Message-Id: <199809061935.PAA21531@aatma.engin.umich.edu>
+ Subject: suppress bogus warning on C<sub x {} x()>
+ Branch: maint-5.005/perl
+ ! toke.c
+ ____________________________________________________________________________
+ [ 1784] By: nick on 1998/09/12 09:53:36
+ Log: Two tweaks to allow quiet compile qith egcs-1.1
+ Branch: maint-5.005/perl
+ ! win32/win32.h
+ ____________________________________________________________________________
+ [ 1783] By: gbarr on 1998/09/07 20:33:11
+ Log: Subject: index() applied BM optimization to wrong argument
+ From: larry@wall.org (Larry Wall)
+ Date: Thu, 3 Sep 1998 12:49:13 -0700
+ Message-Id: <199809031949.MAA29566@wall.org>, <199809060004.RAA23792@wall.org>
+ Branch: maint-5.005/perl
+ ! op.c util.c
+ ____________________________________________________________________________
+ [ 1782] By: gbarr on 1998/09/07 18:54:49
+ Log: From: Gurusamy Sarathy <gsar@engin.umich.edu>
+ Date: Fri, 28 Aug 1998 00:33:15 -0400
+ Mssage-Id: <199808280433.AAA06767@aatma.engin.umich.edu>
+ Subject: socket problems on NT
+ Branch: maint-5.005/perl
+ ! objXSUB.h
+ ____________________________________________________________________________
+ [ 1759] By: gsar on 1998/08/08 20:57:47
+ Log: pending submit of 5.005_02
+ Branch: maint-5.005/perl
+ ! Changes
----------------
Version 5.005_02 Second maintenance release of 5.005
diff -c 'perl5.005_02/Configure' 'perl5.005_03/Configure'
Index: ./Configure
Prereq: 3.0.1.9
*** ./Configure Fri Aug 7 16:38:53 1998
--- ./Configure Sun Mar 28 10:12:57 1999
***************
*** 21,27 ****
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
# Generated on Tue Jul 7 10:10:21 EDT 1998 [metaconfig 3.0 PL70]
! # (with additional metaconfig patches by doughera@lafayette.edu)
cat >/tmp/c1$$ <<EOF
ARGGGHHHH!!!!!
--- 21,27 ----
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
# Generated on Tue Jul 7 10:10:21 EDT 1998 [metaconfig 3.0 PL70]
! # (with additional metaconfig patches by jhi@iki.fi)
cat >/tmp/c1$$ <<EOF
ARGGGHHHH!!!!!
***************
*** 56,88 ****
;;
esac
- : the newline for tr
- if test X"$trnl" = X; then
- case "`echo foo|tr '\n' x 2>/dev/null`" in
- foox)
- trnl='\n'
- ;;
- esac
- fi
- if test X"$trnl" = X; then
- case "`echo foo|tr '\012' x 2>/dev/null`" in
- foox)
- trnl='\012'
- ;;
- esac
- fi
- if test -n "$DJGPP"; then
- trnl='\012'
- fi
- if test X"$trnl" = X; then
- cat <<EOM >&2
-
- $me: Fatal Error: cannot figure out how to translate newlines with 'tr'.
-
- EOM
- exit 1
- fi
-
: Proper separator for the PATH environment variable
p_=:
: On OS/2 this directory should exist if this is not floppy only system :-]
--- 56,61 ----
***************
*** 193,198 ****
--- 166,172 ----
eunicefix=''
Mcc=''
ar=''
+ full_ar=''
awk=''
bash=''
bison=''
***************
*** 359,364 ****
--- 333,346 ----
d_flock=''
d_fork=''
d_fsetpos=''
+ i_sysmount=''
+ d_fstatfs=''
+ d_statfsflags=''
+ i_sysstatvfs=''
+ d_fstatvfs=''
+ i_mntent=''
+ d_getmntent=''
+ d_hasmntopt=''
d_ftime=''
d_gettimeod=''
d_Gconvert=''
***************
*** 391,397 ****
d_getsbyname=''
d_getsbyport=''
d_gnulibc=''
- i_arpainet=''
d_htonl=''
d_inetaton=''
d_isascii=''
--- 373,378 ----
***************
*** 431,436 ****
--- 412,419 ----
d_pthread_yield=''
d_sched_yield=''
d_pthreads_created_joinable=''
+ i_pthread=''
+ i_machcthreads=''
d_readdir=''
d_rewinddir=''
d_seekdir=''
***************
*** 540,545 ****
--- 523,529 ----
ld=''
lddlflags=''
usedl=''
+ ebcdic=''
doublesize=''
fpostype=''
gidtype=''
***************
*** 548,553 ****
--- 532,538 ----
h_sysfile=''
db_hashtype=''
db_prefixtype=''
+ i_arpainet=''
i_db=''
i_dbm=''
i_rpcsvcdbm=''
***************
*** 633,638 ****
--- 618,624 ----
loclibpth=''
plibpth=''
xlibpth=''
+ ignore_versioned_solibs=''
libs=''
lns=''
lseektype=''
***************
*** 697,707 ****
--- 683,695 ----
installscript=''
scriptdir=''
scriptdirexp=''
+ selectminbits=''
selecttype=''
sh=''
sig_name=''
sig_name_init=''
sig_num=''
+ sig_num_init=''
installsitearch=''
sitearch=''
sitearchexp=''
***************
*** 719,724 ****
--- 707,713 ----
startsh=''
stdchar=''
sysman=''
+ trnl=''
uidtype=''
nm_opt=''
nm_so_opt=''
***************
*** 733,739 ****
usrinc=''
defvoidused=''
voidflags=''
- ebcdic=''
CONFIG=''
define='define'
--- 722,727 ----
***************
*** 741,746 ****
--- 729,740 ----
smallmach='pdp11 i8086 z8000 i80286 iAPX286'
rmlist=''
+ installusrbinperl=''
+
+ ccsymbols=''
+ cppsymbols=''
+ cppccsymbols=''
+
: We must find out about Eunice early
eunicefix=':'
if test -f /etc/unixtovms; then
***************
*** 836,841 ****
--- 830,837 ----
: default library list
libswanted=''
+ : some systems want only to use the non-versioned libso:s
+ ignore_versioned_solibs=''
: Possible local include directories to search.
: Set locincpth to "" in a hint file to defeat local include searches.
locincpth="/usr/local/include /opt/local/include /usr/gnu/include"
***************
*** 904,911 ****
$me: Fatal Error: I can't find a Bourne Shell anywhere.
Usually it's in /bin/sh. How did you even get this far?
! Please contact me (Andy Dougherty) at doughera@lafayette.edu and
! we'll try to straighten this all out.
EOM
exit 1
;;
--- 900,906 ----
$me: Fatal Error: I can't find a Bourne Shell anywhere.
Usually it's in /bin/sh. How did you even get this far?
! Please contact perlbug@perl.com and we'll try to straighten this all out.
EOM
exit 1
;;
***************
*** 1240,1246 ****
CONFIG=true
echo "Doing variable substitutions on .SH files..."
if test -f $src/MANIFEST; then
! set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH'`
else
echo "(Looking for .SH files under the source directory.)"
set x `(cd $src; find . -name "*.SH" -print)`
--- 1235,1241 ----
CONFIG=true
echo "Doing variable substitutions on .SH files..."
if test -f $src/MANIFEST; then
! set x `awk '{print $1}' <$src/MANIFEST | grep '\.SH$'`
else
echo "(Looking for .SH files under the source directory.)"
set x `(cd $src; find . -name "*.SH" -print)`
***************
*** 1373,1379 ****
You have the option of continuing the configuration process, despite the
distinct possibility that your kit is damaged, by typing 'y'es. If you
do, don't blame me if something goes wrong. I advise you to type 'n'o
! and contact the author (doughera@lafayette.edu).
EOM
echo $n "Continue? [n] $c" >&4
--- 1368,1374 ----
You have the option of continuing the configuration process, despite the
distinct possibility that your kit is damaged, by typing 'y'es. If you
do, don't blame me if something goes wrong. I advise you to type 'n'o
! and then contact perlbug@perl.com.
EOM
echo $n "Continue? [n] $c" >&4
***************
*** 1396,1401 ****
--- 1391,1420 ----
fi
rm -f missing x??
+ echo " "
+ : Find the appropriate value for a newline for tr
+ if test -n "$DJGPP"; then
+ trnl='\012'
+ fi
+ if test X"$trnl" = X; then
+ case "`echo foo|tr '\n' x 2>/dev/null`" in
+ foox) trnl='\n' ;;
+ esac
+ fi
+ if test X"$trnl" = X; then
+ case "`echo foo|tr '\012' x 2>/dev/null`" in
+ foox) trnl='\012' ;;
+ esac
+ fi
+ if test X"$trnl" = X; then
+ cat <<EOM >&2
+
+ $me: Fatal Error: cannot figure out how to translate newlines with 'tr'.
+
+ EOM
+ exit 1
+ fi
+
: compute the number of columns on the terminal for proper question formatting
case "$COLUMNS" in
'') COLUMNS='80';;
***************
*** 1574,1580 ****
Unix system. If despite that it blows up on yours, your best bet is to edit
Configure and run it again. If you can't run Configure for some reason,
you'll have to generate a config.sh file by hand. Whatever problems you
! have, let me (doughera@lafayette.edu) know how I blew it.
This installation script affects things in two ways:
--- 1593,1599 ----
Unix system. If despite that it blows up on yours, your best bet is to edit
Configure and run it again. If you can't run Configure for some reason,
you'll have to generate a config.sh file by hand. Whatever problems you
! have, let perlbug@perl.com know how I blew it.
This installation script affects things in two ways:
***************
*** 1841,1854 ****
*C9D1*|*c9d1*)
echo "Hey, this might be EBCDIC." >&4
if test "X$up" = X -o "X$low" = X; then
! case "`echo IJ | tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in
ij) up='[A-IJ-RS-Z]'
low='[a-ij-rs-z]'
;;
esac
fi
if test "X$up" = X -o "X$low" = X; then
! case "`echo IJ | tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in
ij) up='A-IJ-RS-Z'
low='a-ij-rs-z'
;;
--- 1860,1873 ----
*C9D1*|*c9d1*)
echo "Hey, this might be EBCDIC." >&4
if test "X$up" = X -o "X$low" = X; then
! case "`echo IJ | $tr '[A-IJ-RS-Z]' '[a-ij-rs-z]' 2>/dev/null`" in
ij) up='[A-IJ-RS-Z]'
low='[a-ij-rs-z]'
;;
esac
fi
if test "X$up" = X -o "X$low" = X; then
! case "`echo IJ | $tr A-IJ-RS-Z a-ij-rs-z 2>/dev/null`" in
ij) up='A-IJ-RS-Z'
low='a-ij-rs-z'
;;
***************
*** 1941,1947 ****
(cd $src/hints; ls -C *.sh) | $sed 's/\.sh/ /g' >&4
dflt=''
: Half the following guesses are probably wrong... If you have better
! : tests or hints, please send them to doughera@lafayette.edu
: The metaconfig authors would also appreciate a copy...
$test -f /irix && osname=irix
$test -f /xenix && osname=sco_xenix
--- 1960,1966 ----
(cd $src/hints; ls -C *.sh) | $sed 's/\.sh/ /g' >&4
dflt=''
: Half the following guesses are probably wrong... If you have better
! : tests or hints, please send them to perlbug@perl.com
: The metaconfig authors would also appreciate a copy...
$test -f /irix && osname=irix
$test -f /xenix && osname=sco_xenix
***************
*** 1968,1973 ****
--- 1987,1998 ----
osvers="$2.$3"
fi
fi
+ $test -f /sys/posix.dll &&
+ $test -f /usr/bin/what &&
+ set X `/usr/bin/what /sys/posix.dll` &&
+ $test "$3" = UWIN &&
+ osname=uwin &&
+ osvers="$5"
if $test -f $uname; then
set X $myuname
shift
***************
*** 1982,1988 ****
[23]100) osname=mips ;;
next*) osname=next ;;
i386*)
! if $test -f /etc/kconfig; then
osname=isc
if test "$lns" = "ln -s"; then
osvers=4
--- 2007,2017 ----
[23]100) osname=mips ;;
next*) osname=next ;;
i386*)
! tmp=`/bin/uname -X 2>/dev/null|awk '/3\.2v[45]/{ print $(NF) }'`
! if $test "$tmp" != "" -a "$3" = "3.2" -a -f '/etc/systemid'; then
! osname='sco'
! osvers=$tmp
! elif $test -f /etc/kconfig; then
osname=isc
if test "$lns" = "ln -s"; then
osvers=4
***************
*** 1992,1997 ****
--- 2021,2027 ----
osvers=2
fi
fi
+ unset tmp
;;
pc*)
if test -n "$DJGPP"; then
***************
*** 2025,2031 ****
osvers="$3"
;;
dynixptx*) osname=dynixptx
! osvers="$3"
;;
freebsd) osname=freebsd
osvers="$3" ;;
--- 2055,2061 ----
osvers="$3"
;;
dynixptx*) osname=dynixptx
! osvers=`echo "$4" | $sed 's/^v//'`
;;
freebsd) osname=freebsd
osvers="$3" ;;
***************
*** 2386,2411 ****
Perl can be built to take advantage of threads, on some systems.
To do so, Configure must be run with -Dusethreads.
! (See README.threads for details.)
EOM
case "$usethreads" in
! $define|true|[yY]*) dflt='y';;
*) dflt='n';;
esac
rp='Build a threading Perl?'
. ./myread
case "$ans" in
! y|Y) val="$define" ;;
*) val="$undef" ;;
esac
set usethreads
eval $setvar
! : Look for a hint-file generated 'call-back-unit'. Now that the
! : user has specified if 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 "$d_oldpthreads" in
'') : Configure tests would be welcome here. For now, assume undef.
val="$undef" ;;
--- 2416,2441 ----
Perl can be built to take advantage of threads, on some systems.
To do so, Configure must be run with -Dusethreads.
!
! Note that threading is a highly experimental feature, and
! some known race conditions still remain. If you choose to try
! it, be very sure to not actually deploy it for production
! purposes. README.threads has more details, and is required
! reading if you enable threads.
EOM
case "$usethreads" in
! $define|true|[yY]*) dflt='y';;
*) dflt='n';;
esac
rp='Build a threading Perl?'
. ./myread
case "$ans" in
! y|Y) val="$define" ;;
*) val="$undef" ;;
esac
set usethreads
eval $setvar
!
case "$d_oldpthreads" in
'') : Configure tests would be welcome here. For now, assume undef.
val="$undef" ;;
***************
*** 2414,2419 ****
--- 2444,2475 ----
set d_oldpthreads
eval $setvar
+
+ case "$usethreads" in
+ "$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|next|openbsd|os2|solaris|vmesa)
+ # Known thread-capable platforms.
+ ;;
+ *)
+ cat >&4 <<EOM
+ $osname is not known to support threads.
+ Please let perlbug@perl.com know how to do that.
+
+ Cannot continue, aborting.
+ EOM
+ exit 1
+ ;;
+ esac # $osname
+ ;;
+ esac # $usethreads
+
: determine the architecture name
echo " "
if xxx=`./loc arch blurfl $pth`; $test -f "$xxx"; then
***************
*** 3157,3163 ****
case "$models" in
'')
$cat >pdp11.c <<'EOP'
! main() {
#ifdef pdp11
exit(0);
#else
--- 3213,3219 ----
case "$models" in
'')
$cat >pdp11.c <<'EOP'
! int main() {
#ifdef pdp11
exit(0);
#else
***************
*** 3442,3448 ****
--- 3498,3508 ----
ABC.XYZ
EOT
cd ..
+ if test ! -f cppstdin; then
echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin
+ else
+ echo "Keeping your $hint cppstdin wrapper."
+ fi
chmod 755 cppstdin
wrapper=`pwd`/cppstdin
ok='false'
***************
*** 3566,3572 ****
esac
case "$cppstdin" in
! "$wrapper") ;;
*) $rm -f $wrapper;;
esac
$rm -f testcpp.c testcpp.out
--- 3626,3632 ----
esac
case "$cppstdin" in
! "$wrapper"|'cppstdin') ;;
*) $rm -f $wrapper;;
esac
$rm -f testcpp.c testcpp.out
***************
*** 3693,3699 ****
esac
for thislib in $libswanted; do
! if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; $test -f "$xxx"; then
echo "Found -l$thislib (shared)."
case " $dflt " in
*"-l$thislib "*);;
--- 3753,3760 ----
esac
for thislib in $libswanted; do
! if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`;
! $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then
echo "Found -l$thislib (shared)."
case " $dflt " in
*"-l$thislib "*);;
***************
*** 3838,3848 ****
esac;
fi'
! if ./osf1; then
! set signal.h __LANGUAGE_C__; eval $inctest
! else
! set signal.h LANGUAGE_C; eval $inctest
! fi
case "$hint" in
none|recommended) dflt="$ccflags $dflt" ;;
--- 3899,3905 ----
esac;
fi'
! set signal.h LANGUAGE_C; eval $inctest
case "$hint" in
none|recommended) dflt="$ccflags $dflt" ;;
***************
*** 3980,3989 ****
: coherency check
echo " "
echo "Checking your choice of C compiler and flags for coherency..." >&4
set X $cc $optimize $ccflags -o try $ldflags try.c $libs
shift
! $cat >try.msg <<EOM
! I've tried to compile and run a simple program with:
$*
./try
--- 4037,4057 ----
: coherency check
echo " "
echo "Checking your choice of C compiler and flags for coherency..." >&4
+ $cat > try.c <<'EOF'
+ #include <stdio.h>
+ int main() { printf("Ok\n"); exit(0); }
+ EOF
set X $cc $optimize $ccflags -o try $ldflags try.c $libs
shift
! $cat >try.msg <<'EOM'
! I've tried to compile and run the following simple program:
!
! EOM
! $cat try.c >> try.msg
!
! $cat >> try.msg <<EOM
!
! I used the command:
$*
./try
***************
*** 3991,4000 ****
and I got the following output:
EOM
- $cat > try.c <<'EOF'
- #include <stdio.h>
- main() { printf("Ok\n"); exit(0); }
- EOF
dflt=y
if sh -c "$cc $optimize $ccflags -o try $ldflags try.c $libs" >>try.msg 2>&1; then
if sh -c './try' >>try.msg 2>&1; then
--- 4059,4064 ----
***************
*** 4031,4037 ****
$cat try.msg >&4
case "$knowitall" in
'')
! echo "(The supplied flags might be incorrect with this C compiler.)"
;;
*) dflt=n;;
esac
--- 4095,4101 ----
$cat try.msg >&4
case "$knowitall" in
'')
! echo "(The supplied flags or libraries might be incorrect.)"
;;
*) dflt=n;;
esac
***************
*** 4149,4157 ****
: determine which malloc to compile in
echo " "
case "$usemymalloc" in
! ''|y*|true) dflt='y' ;;
! n*|false) dflt='n' ;;
! *) dflt="$usemymalloc" ;;
esac
rp="Do you wish to attempt to use the malloc that comes with $package?"
. ./myread
--- 4213,4220 ----
: determine which malloc to compile in
echo " "
case "$usemymalloc" in
! ''|[yY]*|true|$define) dflt='y' ;;
! *) dflt='n' ;;
esac
rp="Do you wish to attempt to use the malloc that comes with $package?"
. ./myread
***************
*** 4227,4233 ****
echo " "
echo "Checking out function prototypes..." >&4
$cat >prototype.c <<'EOCP'
! main(int argc, char *argv[]) {
exit(0);}
EOCP
if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then
--- 4290,4296 ----
echo " "
echo "Checking out function prototypes..." >&4
$cat >prototype.c <<'EOCP'
! int main(int argc, char *argv[]) {
exit(0);}
EOCP
if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then
***************
*** 4253,4259 ****
$cc $ccflags
doesn't seem to understand them. Sorry about that.
! If GNU cc is avaiable for your system, perhaps you could try that instead.
Eventually, we hope to support building Perl with pre-ANSI compilers.
If you would like to help in that effort, please contact <perlbug@perl.org>.
--- 4316,4322 ----
$cc $ccflags
doesn't seem to understand them. Sorry about that.
! If GNU cc is available for your system, perhaps you could try that instead.
Eventually, we hope to support building Perl with pre-ANSI compilers.
If you would like to help in that effort, please contact <perlbug@perl.org>.
***************
*** 4296,4301 ****
--- 4359,4387 ----
installbin="$binexp"
fi
+ echo " "
+ 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
+ case "$installusrbinperl" in
+ "$undef"|[nN]*) dflt='n';;
+ *) dflt='y';;
+ esac
+ rp="Do you want to install perl as /usr/bin/perl?"
+ . ./myread
+ case "$ans" in
+ [yY]*) val="$define";;
+ *) val="$undef" ;;
+ esac
+ else
+ val="$undef"
+ fi
+ set installusrbinperl
+ eval $setvar
+
: define a shorthand compile call
compile='
mc_file=$1;
***************
*** 4308,4344 ****
$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;'
echo " "
- echo "Determining whether or not we are on an EBCDIC system..." >&4
- cat >tebcdic.c <<EOM
- int main()
- {
- if ('M'==0xd4) return 0;
- return 1;
- }
- EOM
- val=$undef
- set tebcdic
- if eval $compile_ok; then
- if ./tebcdic; then
- echo "You have EBCDIC." >&4
- val="$define"
- else
- echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4
- fi
- else
- echo "I'm unable to compile the test program." >&4
- echo "I'll asuume ASCII or some ISO Latin." >&4
- fi
- $rm -f tebcdic.c tebcdic
- set ebcdic
- eval $setvar
-
- echo " "
echo "Checking for GNU C Library..." >&4
cat >gnulibc.c <<EOM
#include <stdio.h>
! int
! main()
{
#ifdef __GLIBC__
exit(0);
--- 4394,4403 ----
$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;'
echo " "
echo "Checking for GNU C Library..." >&4
cat >gnulibc.c <<EOM
#include <stdio.h>
! int main()
{
#ifdef __GLIBC__
exit(0);
***************
*** 4664,4669 ****
--- 4723,4732 ----
eval $xscan;\
$contains '^fprintf$' libc.list >/dev/null 2>&1; then
eval $xrun
+ elif com="sed -n -e 's/^__.*//' -e 's/[ ]*D[ ]*[0-9]*.*//p'";\
+ eval $xscan;\
+ $contains '^fprintf$' libc.list >/dev/null 2>&1; then
+ eval $xrun
else
$nm -p $* 2>/dev/null >libc.tmp
$grep fprintf libc.tmp > libc.ptf
***************
*** 4719,4725 ****
if $test -f /lib/syscalls.exp; then
echo " "
echo "Also extracting names from /lib/syscalls.exp for good ole AIX..." >&4
! $sed -n 's/^\([^ ]*\)[ ]*syscall$/\1/p' /lib/syscalls.exp >>libc.list
fi
;;
esac
--- 4782,4788 ----
if $test -f /lib/syscalls.exp; then
echo " "
echo "Also extracting names from /lib/syscalls.exp for good ole AIX..." >&4
! $sed -n 's/^\([^ ]*\)[ ]*syscall[0-9]*$/\1/p' /lib/syscalls.exp >>libc.list
fi
;;
esac
***************
*** 4750,4756 ****
else tval=false;
fi;;
*)
! echo "main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c;
if $cc $optimize $ccflags $ldflags -o t t.c $libs >/dev/null 2>&1;
then tval=true;
else tval=false;
--- 4813,4819 ----
else tval=false;
fi;;
*)
! echo "int main() { extern short $1$tdc; printf(\"%hd\", $1$tc); }" > t.c;
if $cc $optimize $ccflags $ldflags -o t t.c $libs >/dev/null 2>&1;
then tval=true;
else tval=false;
***************
*** 4899,4905 ****
/* Test for whether ELF binaries are produced */
#include <fcntl.h>
#include <stdlib.h>
! main() {
char b[4];
int i = open("a.out",O_RDONLY);
if(i == -1)
--- 4962,4968 ----
/* Test for whether ELF binaries are produced */
#include <fcntl.h>
#include <stdlib.h>
! int main() {
char b[4];
int i = open("a.out",O_RDONLY);
if(i == -1)
***************
*** 4944,4949 ****
--- 5007,5013 ----
linux|irix*) dflt='-shared' ;;
next) dflt='none' ;;
solaris) dflt='-G' ;;
+ beos) dflt='-nostart' ;;
sunos) dflt='-assert nodefinitions' ;;
svr4*|esix*) dflt="-G $ldflags" ;;
*) dflt='none' ;;
***************
*** 4953,4958 ****
--- 5017,5026 ----
esac
: Try to guess additional flags to pick up local libraries.
+ : Be careful not to append to a plain 'none'
+ case "$dflt" in
+ none) dflt='' ;;
+ esac
for thisflag in $ldflags; do
case "$thisflag" in
-L*)
***************
*** 5016,5022 ****
;;
*) case "$useshrplib" in
'') case "$osname" in
! svr4*|dgux|dynixptx|esix|powerux)
dflt=y
also='Building a shared libperl is required for dynamic loading to work on your system.'
;;
--- 5084,5090 ----
;;
*) case "$useshrplib" in
'') case "$osname" in
! svr4*|dgux|dynixptx|esix|powerux|beos)
dflt=y
also='Building a shared libperl is required for dynamic loading to work on your system.'
;;
***************
*** 5061,5081 ****
case "${osname}${osvers}" in
next4*) xxx='DYLD_LIBRARY_PATH' ;;
os2*) xxx='' ;; # Nothing special needed.
*) xxx='LD_LIBRARY_PATH' ;;
esac
- if test X"$xxx" != "X"; then
- $cat <<EOM | $tee -a ../config.msg >&4
-
- To build perl, you must add the current working directory to your
- $xxx environment variable before running make. You can do
- this with
- $xxx=\`pwd\`; export $xxx
- for Bourne-style shells, or
- setenv $xxx \`pwd\`
- for Csh-style shells. You *MUST* do this before running make.
-
- EOM
- fi
;;
*) useshrplib='false' ;;
esac
--- 5129,5137 ----
case "${osname}${osvers}" in
next4*) xxx='DYLD_LIBRARY_PATH' ;;
os2*) xxx='' ;; # Nothing special needed.
+ beos*) xxx='' ;;
*) xxx='LD_LIBRARY_PATH' ;;
esac
;;
*) useshrplib='false' ;;
esac
***************
*** 5147,5153 ****
*) $cat >&4 <<EOM
WARNING: Use of the shrpdir variable for the installation location of
the shared $libperl is not supported. It was never documented and
! will not work in this version. Let me (doughera@lafayette.edu)
know of any problems this may cause.
EOM
--- 5203,5209 ----
*) $cat >&4 <<EOM
WARNING: Use of the shrpdir variable for the installation location of
the shared $libperl is not supported. It was never documented and
! will not work in this version. Let perlbug@perl.com
know of any problems this may cause.
EOM
***************
*** 5193,5198 ****
--- 5249,5257 ----
next)
# next doesn't like the default...
;;
+ beos)
+ # beos doesn't like the default, either.
+ ;;
*)
tmp_shrpenv="env LD_RUN_PATH=$shrpdir"
;;
***************
*** 6034,6041 ****
}
}
! int
! main()
{
char buf[64];
buf[63] = '\0';
--- 6093,6099 ----
}
}
! int main()
{
char buf[64];
buf[63] = '\0';
***************
*** 6121,6127 ****
#ifdef I_UNISTD
#include <unistd.h>
#endif
! main() {
exit(R_OK);
}
EOCP
--- 6179,6185 ----
#ifdef I_UNISTD
#include <unistd.h>
#endif
! int main() {
exit(R_OK);
}
EOCP
***************
*** 6197,6203 ****
#ifdef I_UNISTD
# include <unistd.h>
#endif
! main()
{
if (getuid() == 0) {
printf("(I see you are running Configure as super-user...)\n");
--- 6255,6261 ----
#ifdef I_UNISTD
# include <unistd.h>
#endif
! int main()
{
if (getuid() == 0) {
printf("(I see you are running Configure as super-user...)\n");
***************
*** 6259,6265 ****
#ifdef I_UNISTD
# include <unistd.h>
#endif
! main()
{
if (getuid() == 0) {
printf("(I see you are running Configure as super-user...)\n");
--- 6317,6323 ----
#ifdef I_UNISTD
# include <unistd.h>
#endif
! int main()
{
if (getuid() == 0) {
printf("(I see you are running Configure as super-user...)\n");
***************
*** 6317,6323 ****
echo "Checking to see how big your integers are..." >&4
$cat >intsize.c <<'EOCP'
#include <stdio.h>
! main()
{
printf("intsize=%d;\n", sizeof(int));
printf("longsize=%d;\n", sizeof(long));
--- 6375,6381 ----
echo "Checking to see how big your integers are..." >&4
$cat >intsize.c <<'EOCP'
#include <stdio.h>
! int main()
{
printf("intsize=%d;\n", sizeof(int));
printf("longsize=%d;\n", sizeof(long));
***************
*** 6413,6419 ****
#include <sys/types.h>
#include <signal.h>
$signal_t blech(s) int s; { exit(3); }
! main()
{
$xxx i32;
double f, g;
--- 6471,6477 ----
#include <sys/types.h>
#include <signal.h>
$signal_t blech(s) int s; { exit(3); }
! int main()
{
$xxx i32;
double f, g;
***************
*** 6471,6477 ****
unsigned long dummy_long(p) unsigned long p; { return p; }
unsigned int dummy_int(p) unsigned int p; { return p; }
unsigned short dummy_short(p) unsigned short p; { return p; }
! main()
{
double f;
unsigned long along;
--- 6529,6535 ----
unsigned long dummy_long(p) unsigned long p; { return p; }
unsigned int dummy_int(p) unsigned int p; { return p; }
unsigned short dummy_short(p) unsigned short p; { return p; }
! int main()
{
double f;
unsigned long along;
***************
*** 6563,6569 ****
$cat >vprintf.c <<'EOF'
#include <varargs.h>
! main() { xxx("foo"); }
xxx(va_alist)
va_dcl
--- 6621,6627 ----
$cat >vprintf.c <<'EOF'
#include <varargs.h>
! int main() { xxx("foo"); }
xxx(va_alist)
va_dcl
***************
*** 6611,6617 ****
echo 'Checking to see if your C compiler knows about "const"...' >&4
$cat >const.c <<'EOCP'
typedef struct spug { int drokk; } spug;
! main()
{
const char *foo;
const spug y;
--- 6669,6675 ----
echo 'Checking to see if your C compiler knows about "const"...' >&4
$cat >const.c <<'EOCP'
typedef struct spug { int drokk; } spug;
! int main()
{
const char *foo;
const spug y;
***************
*** 6703,6708 ****
--- 6761,6770 ----
set difftime d_difftime
eval $inlibc
+ : see if sys/stat.h is available
+ set sys/stat.h i_sysstat
+ eval $inhdr
+
: see if this is a dirent system
echo " "
if xinc=`./findhdr dirent.h`; $test "$xinc"; then
***************
*** 6771,6776 ****
--- 6833,6855 ----
eval $setvar
$rm -f try.c
+ hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift;
+ while $test $# -ge 2; do
+ case "$1" in
+ $define) echo "#include <$2>";;
+ esac ;
+ shift 2;
+ done > try.c;
+ echo "int main () { struct $struct foo; foo.$field = 0; }" >> try.c;
+ if eval $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then
+ val="$define";
+ else
+ val="$undef";
+ fi;
+ set $varname;
+ eval $setvar;
+ $rm -f try.c try.o'
+
: see if dlerror exists
xxx_runnm="$runnm"
runnm=false
***************
*** 6829,6835 ****
extern int fred() ;
! main()
{
void * handle ;
void * symbol ;
--- 6908,6914 ----
extern int fred() ;
! int main()
{
void * handle ;
void * symbol ;
***************
*** 6917,6923 ****
#ifdef I_SYS_FILE
#include <sys/file.h>
#endif
! main() {
if(O_RDONLY);
#ifdef O_TRUNC
exit(0);
--- 6996,7002 ----
#ifdef I_SYS_FILE
#include <sys/file.h>
#endif
! int main() {
if(O_RDONLY);
#ifdef O_TRUNC
exit(0);
***************
*** 6973,6979 ****
'')
$cat head.c > try.c
$cat >>try.c <<'EOCP'
! main() {
#ifdef O_NONBLOCK
printf("O_NONBLOCK\n");
exit(0);
--- 7052,7058 ----
'')
$cat head.c > try.c
$cat >>try.c <<'EOCP'
! int main() {
#ifdef O_NONBLOCK
printf("O_NONBLOCK\n");
exit(0);
***************
*** 7020,7026 ****
$signal_t blech(x) int x; { exit(3); }
EOCP
$cat >> try.c <<'EOCP'
! main()
{
int pd[2];
int pu[2];
--- 7099,7105 ----
$signal_t blech(x) int x; { exit(3); }
EOCP
$cat >> try.c <<'EOCP'
! int main()
{
int pd[2];
int pu[2];
***************
*** 7178,7183 ****
--- 7257,7287 ----
set gethostbyname d_gethbyname
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 fstatfs exists
+ set fstatfs d_fstatfs
+ eval $inlibc
+
+ : see if statfs knows about mount flags
+ echo " "
+ set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h
+ eval $hasfield
+
+ : see if this is a sysstatvfs.h system
+ set sys/statvfs.h i_sysstatvfs
+ eval $inhdr
+
+ : see if fstatvfs exists
+ set fstatvfs d_fstatvfs
+ eval $inlibc
+
: see if gethostent exists
set gethostent d_gethent
eval $inlibc
***************
*** 7244,7249 ****
--- 7348,7365 ----
set getprotoent d_getpent
eval $inlibc
+ : see if this is a mntent.h system
+ set mntent.h i_mntent
+ eval $inhdr
+
+ : see if getmntent exists
+ set getmntent d_getmntent
+ eval $inlibc
+
+ : see if hasmntopt exists
+ set hasmntopt d_hasmntopt
+ eval $inlibc
+
: see if getpgid exists
set getpgid d_getpgid
eval $inlibc
***************
*** 7305,7311 ****
set netinet/in.h i_niin sys/in.h i_sysin
eval $inhdr
! : see if this is an arpa/inet.h
set arpa/inet.h i_arpainet
eval $inhdr
--- 7421,7427 ----
set netinet/in.h i_niin sys/in.h i_sysin
eval $inhdr
! : see if arpa/inet.h has to be included
set arpa/inet.h i_arpainet
eval $inhdr
***************
*** 7411,7417 ****
$cat >isascii.c <<'EOCP'
#include <stdio.h>
#include <ctype.h>
! main() {
int c = 'A';
if (isascii(c))
exit(0);
--- 7527,7533 ----
$cat >isascii.c <<'EOCP'
#include <stdio.h>
#include <ctype.h>
! int main() {
int c = 'A';
if (isascii(c))
exit(0);
***************
*** 7501,7507 ****
$echo $n "Checking to see how big your long doubles are...$c" >&4
$cat >try.c <<'EOCP'
#include <stdio.h>
! main()
{
printf("%d\n", sizeof(long double));
}
--- 7617,7623 ----
$echo $n "Checking to see how big your long doubles are...$c" >&4
$cat >try.c <<'EOCP'
#include <stdio.h>
! int main()
{
printf("%d\n", sizeof(long double));
}
***************
*** 7518,7523 ****
--- 7634,7642 ----
. ./myread
longdblsize="$ans"
fi
+ if $test "X$doublesize" = "X$longdblsize"; then
+ echo "(That isn't any different from an ordinary double.)"
+ fi
;;
esac
$rm -f try.c try
***************
*** 7544,7550 ****
$echo $n "Checking to see how big your long longs are...$c" >&4
$cat >try.c <<'EOCP'
#include <stdio.h>
! main()
{
printf("%d\n", sizeof(long long));
}
--- 7663,7669 ----
$echo $n "Checking to see how big your long longs are...$c" >&4
$cat >try.c <<'EOCP'
#include <stdio.h>
! int main()
{
printf("%d\n", sizeof(long long));
}
***************
*** 7561,7566 ****
--- 7680,7688 ----
. ./myread
longlongsize="$ans"
fi
+ if $test "X$longsize" = "X$longlongsize"; then
+ echo "(That isn't any different from an ordinary long.)"
+ fi
;;
esac
$rm -f try.c try
***************
*** 7635,7641 ****
freebsd)
case "`ipcs 2>&1`" in
"SVID messages"*"not configured"*)
! echo "But your FreeBSD kernel does not have the msg*(2) configured." >&4
h_msg=false
val="$undef"
set msgctl d_msgctl
--- 7757,7763 ----
freebsd)
case "`ipcs 2>&1`" in
"SVID messages"*"not configured"*)
! echo "Your $osname does not have the msg*(2) configured." >&4
h_msg=false
val="$undef"
set msgctl d_msgctl
***************
*** 7678,7687 ****
eval $inlibc
! : see whether the various POSIXish _yields exist within given cccmd
$cat >try.c <<EOP
#include <pthread.h>
! main() {
YIELD();
exit(0);
}
--- 7800,7809 ----
eval $inlibc
! : see whether the various POSIXish _yields exist
$cat >try.c <<EOP
#include <pthread.h>
! int main() {
YIELD();
exit(0);
}
***************
*** 7713,7722 ****
eval $setvar
$rm -f try try.*
: test whether pthreads are created in joinable -- aka undetached -- state
! if test "X$usethreads" = "X$define"; then
echo $n "Checking whether pthreads are created joinable. $c" >&4
! $cat >try.c <<'EOCP'
#include <pthread.h>
#include <stdio.h>
int main() {
--- 7835,7852 ----
eval $setvar
$rm -f try try.*
+ : see if this is a pthread.h system
+ set pthread.h i_pthread
+ eval $inhdr
+
+ : see if this is a mach/cthreads.h system
+ set mach/cthreads.h i_machcthreads
+ eval $inhdr
+
: test whether pthreads are created in joinable -- aka undetached -- state
! if test "X$usethreads" = "X$define" -a "X$i_pthread" = "X$define"; then
echo $n "Checking whether pthreads are created joinable. $c" >&4
! $cat >try.c <<EOCP
#include <pthread.h>
#include <stdio.h>
int main() {
***************
*** 7930,7936 ****
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
! main()
{
char buf[128], abc[128];
char *b;
--- 8060,8066 ----
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
! int main()
{
char buf[128], abc[128];
char *b;
***************
*** 8006,8012 ****
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
! main()
{
char buf[128], abc[128];
char *b;
--- 8136,8142 ----
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
! int main()
{
char buf[128], abc[128];
char *b;
***************
*** 8084,8090 ****
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
! main()
{
char a = -1;
char b = 0;
--- 8214,8220 ----
#ifdef I_UNISTD
# include <unistd.h> /* Needed for NetBSD */
#endif
! int main()
{
char a = -1;
char b = 0;
***************
*** 8136,8142 ****
freebsd)
case "`ipcs 2>&1`" in
"SVID messages"*"not configured"*)
! echo "But your FreeBSD kernel does not have the sem*(2) configured." >&4
h_sem=false
val="$undef"
set semctl d_semctl
--- 8266,8272 ----
freebsd)
case "`ipcs 2>&1`" in
"SVID messages"*"not configured"*)
! echo "Your $osname does not have the sem*(2) configured." >&4
h_sem=false
val="$undef"
set semctl d_semctl
***************
*** 8185,8190 ****
--- 8315,8345 ----
$define)
: see whether semctl IPC_STAT can use union semun
echo " "
+ $cat > try.h <<END
+ #ifndef S_IRUSR
+ # ifdef S_IREAD
+ # define S_IRUSR S_IREAD
+ # define S_IWUSR S_IWRITE
+ # define S_IXUSR S_IEXEC
+ # else
+ # define S_IRUSR 0400
+ # define S_IWUSR 0200
+ # define S_IXUSR 0100
+ # endif
+ # define S_IRGRP (S_IRUSR>>3)
+ # define S_IWGRP (S_IWUSR>>3)
+ # define S_IXGRP (S_IXUSR>>3)
+ # define S_IROTH (S_IRUSR>>6)
+ # define S_IWOTH (S_IWUSR>>6)
+ # define S_IXOTH (S_IXUSR>>6)
+ #endif
+ #ifndef S_IRWXU
+ # define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
+ # define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
+ # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
+ #endif
+ END
+
$cat > try.c <<END
#include <sys/types.h>
#include <sys/ipc.h>
***************
*** 8244,8250 ****
case "$d_semctl_semun" in
$define)
echo "You can use union semun for semctl IPC_STAT." >&4
! also='also'
;;
*) echo "You cannot use union semun for semctl IPC_STAT." >&4
also=''
--- 8399,8405 ----
case "$d_semctl_semun" in
$define)
echo "You can use union semun for semctl IPC_STAT." >&4
! also='also '
;;
*) echo "You cannot use union semun for semctl IPC_STAT." >&4
also=''
***************
*** 8259,8264 ****
--- 8414,8420 ----
#include <sys/stat.h>
#include <stdio.h>
#include <errno.h>
+ #include "try.h"
#ifndef errno
extern int errno;
#endif
***************
*** 8300,8310 ****
eval $setvar
case "$d_semctl_semid_ds" in
$define)
! echo "You can $also use struct semid_ds * for semctl IPC_STAT." >&4
;;
! *) echo "You cannot use struct semid_ds * for semctl IPC_STAT." >&4
;;
esac
;;
*) val="$undef"
--- 8456,8467 ----
eval $setvar
case "$d_semctl_semid_ds" in
$define)
! echo "You can ${also}use struct semid_ds* for semctl IPC_STAT." >&4
;;
! *) echo "You cannot use struct semid_ds* for semctl IPC_STAT." >&4
;;
esac
+ $rm -f try.h
;;
*) val="$undef"
***************
*** 8499,8505 ****
freebsd)
case "`ipcs 2>&1`" in
"SVID shared memory"*"not configured"*)
! echo "But your FreeBSD kernel does not have the shm*(2) configured." >&4
h_shm=false
val="$undef"
set shmctl d_shmctl
--- 8656,8662 ----
freebsd)
case "`ipcs 2>&1`" in
"SVID shared memory"*"not configured"*)
! echo "But your $osname does not have the shm*(2) configured." >&4
h_shm=false
val="$undef"
set shmctl d_shmctl
***************
*** 8533,8539 ****
#include <stdio.h>
#include <sys/types.h>
#include <signal.h>
! main()
{
struct sigaction act, oact;
}
--- 8690,8696 ----
#include <stdio.h>
#include <sys/types.h>
#include <signal.h>
! int main()
{
struct sigaction act, oact;
}
***************
*** 8560,8566 ****
#include <setjmp.h>
sigjmp_buf env;
int set = 1;
! main()
{
if (sigsetjmp(env,1))
exit(set);
--- 8717,8723 ----
#include <setjmp.h>
sigjmp_buf env;
int set = 1;
! int main()
{
if (sigsetjmp(env,1))
exit(set);
***************
*** 8619,8644 ****
d_oldsock="$undef"
else
echo "You don't have Berkeley networking in libc$_a..." >&4
! if test -f /usr/lib/libnet$_a; then
! ( ($nm $nm_opt /usr/lib/libnet$_a | eval $nm_extract) || \
! $ar t /usr/lib/libnet$_a) 2>/dev/null >> libc.list
! if $contains socket libc.list >/dev/null 2>&1; then
! echo "...but the Wollongong group seems to have hacked it in." >&4
! socketlib="-lnet"
! sockethdr="-I/usr/netinclude"
! d_socket="$define"
! if $contains setsockopt libc.list >/dev/null 2>&1; then
! d_oldsock="$undef"
! else
! echo "...using the old 4.1c interface, rather than 4.2" >&4
! d_oldsock="$define"
fi
- else
- echo "or even in libnet$_a, which is peculiar." >&4
- d_socket="$undef"
- d_oldsock="$undef"
fi
! else
echo "or anywhere else I see." >&4
d_socket="$undef"
d_oldsock="$undef"
--- 8776,8807 ----
d_oldsock="$undef"
else
echo "You don't have Berkeley networking in libc$_a..." >&4
! for net in net socket
! do
! if test -f /usr/lib/lib$net$_a; then
! ( ($nm $nm_opt /usr/lib/lib$net$_a | eval $nm_extract) || \
! $ar t /usr/lib/lib$net$_a) 2>/dev/null >> libc.list
! if $contains socket libc.list >/dev/null 2>&1; then
! d_socket="$define"
! case "$net" in
! net)
! echo "...but the Wollongong group seems to have hacked it in." >&4
! socketlib="-lnet"
! sockethdr="-I/usr/netinclude"
! ;;
! esac
! echo "Found Berkeley sockets interface in lib$net." >& 4
! if $contains setsockopt libc.list >/dev/null 2>&1; then
! d_oldsock="$undef"
! else
! echo "...using the old 4.1c interface, rather than 4.2" >&4
! d_oldsock="$define"
! fi
! break
fi
fi
! done
! if test "X$d_socket" != "X$define"; then
echo "or anywhere else I see." >&4
d_socket="$undef"
d_oldsock="$undef"
***************
*** 8652,8672 ****
: see if stat knows about block sizes
echo " "
! xxx=`./findhdr sys/stat.h`
! if $contains 'st_blocks;' "$xxx" >/dev/null 2>&1 ; then
! if $contains 'st_blksize;' "$xxx" >/dev/null 2>&1 ; then
! echo "Your stat() knows about block sizes." >&4
! val="$define"
! else
! echo "Your stat() doesn't know about block sizes." >&4
! val="$undef"
! fi
! else
! echo "Your stat() doesn't know about block sizes." >&4
! val="$undef"
! fi
! set d_statblks
! eval $setvar
: see if _ptr and _cnt from stdio act std
echo " "
--- 8815,8822 ----
: see if stat knows about block sizes
echo " "
! set d_statblks stat st_blocks $i_sysstat sys/stat.h
! eval $hasfield
: see if _ptr and _cnt from stdio act std
echo " "
***************
*** 8716,8722 ****
#include <stdio.h>
#define FILE_ptr(fp) $stdio_ptr
#define FILE_cnt(fp) $stdio_cnt
! main() {
FILE *fp = fopen("try.c", "r");
char c = getc(fp);
if (
--- 8866,8872 ----
#include <stdio.h>
#define FILE_ptr(fp) $stdio_ptr
#define FILE_cnt(fp) $stdio_cnt
! int main() {
FILE *fp = fopen("try.c", "r");
char c = getc(fp);
if (
***************
*** 8767,8773 ****
#include <stdio.h>
#define FILE_base(fp) $stdio_base
#define FILE_bufsiz(fp) $stdio_bufsiz
! main() {
FILE *fp = fopen("try.c", "r");
char c = getc(fp);
if (
--- 8917,8923 ----
#include <stdio.h>
#define FILE_base(fp) $stdio_base
#define FILE_bufsiz(fp) $stdio_bufsiz
! int main() {
FILE *fp = fopen("try.c", "r");
char c = getc(fp);
if (
***************
*** 8803,8809 ****
echo " "
echo "Checking to see if your C compiler can copy structs..." >&4
$cat >try.c <<'EOCP'
! main()
{
struct blurfl {
int dyick;
--- 8953,8959 ----
echo " "
echo "Checking to see if your C compiler can copy structs..." >&4
$cat >try.c <<'EOCP'
! int main()
{
struct blurfl {
int dyick;
***************
*** 9056,9062 ****
false) dflt='n';;
*) dflt='y';;
esac
! rp="Some systems have problems with vfork(). Do you want to use it?"
. ./myread
case "$ans" in
y|Y) ;;
--- 9206,9221 ----
false) dflt='n';;
*) dflt='y';;
esac
! cat <<'EOM'
!
! Perl can only use a vfork() that doesn't suffer from strict
! restrictions on calling functions or modifying global data in
! the child. For example, glibc-2.1 contains such a vfork()
! that is unsuitable. If your system provides a proper fork()
! call, chances are that you do NOT want perl to use vfork().
!
! EOM
! rp="Do you still want to use vfork()?"
. ./myread
case "$ans" in
y|Y) ;;
***************
*** 9148,9154 ****
echo " "
echo 'Checking to see if your C compiler knows about "volatile"...' >&4
$cat >try.c <<'EOCP'
! main()
{
typedef struct _goo_struct goo_struct;
goo_struct * volatile goo = ((goo_struct *)0);
--- 9307,9313 ----
echo " "
echo 'Checking to see if your C compiler knows about "volatile"...' >&4
$cat >try.c <<'EOCP'
! int main()
{
typedef struct _goo_struct goo_struct;
goo_struct * volatile goo = ((goo_struct *)0);
***************
*** 9207,9213 ****
char foo;
double bar;
} try;
! main()
{
printf("%d\n", (char *)&try.bar - (char *)&try.foo);
}
--- 9366,9372 ----
char foo;
double bar;
} try;
! int main()
{
printf("%d\n", (char *)&try.bar - (char *)&try.foo);
}
***************
*** 9242,9248 ****
EOM
$cat >try.c <<'EOCP'
#include <stdio.h>
! main()
{
int i;
union {
--- 9401,9407 ----
EOM
$cat >try.c <<'EOCP'
#include <stdio.h>
! int main()
{
int i;
union {
***************
*** 9337,9343 ****
#include <sys/types.h>
#include <stdio.h>
#include <db.h>
! main()
{
#ifdef DB_VERSION_MAJOR /* DB version >= 2 */
int Major, Minor, Patch ;
--- 9496,9502 ----
#include <sys/types.h>
#include <stdio.h>
#include <db.h>
! int main()
{
#ifdef DB_VERSION_MAJOR /* DB version >= 2 */
int Major, Minor, Patch ;
***************
*** 9420,9426 ****
{
}
HASHINFO info;
! main()
{
info.hash = hash_cb;
}
--- 9579,9585 ----
{
}
HASHINFO info;
! int main()
{
info.hash = hash_cb;
}
***************
*** 9465,9471 ****
{
}
BTREEINFO info;
! main()
{
info.prefix = prefix_cb;
}
--- 9624,9630 ----
{
}
BTREEINFO info;
! int main()
{
info.prefix = prefix_cb;
}
***************
*** 9518,9524 ****
#endif
exit(0);
}
! main() { sub(); }
EOCP
if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then
voidflags=$defvoidused
--- 9677,9683 ----
#endif
exit(0);
}
! int main() { sub(); }
EOCP
if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then
voidflags=$defvoidused
***************
*** 9590,9596 ****
$echo $n "Checking to see how big your double precision numbers are...$c" >&4
$cat >try.c <<'EOCP'
#include <stdio.h>
! main()
{
printf("%d\n", sizeof(double));
}
--- 9749,9755 ----
$echo $n "Checking to see how big your double precision numbers are...$c" >&4
$cat >try.c <<'EOCP'
#include <stdio.h>
! int main()
{
printf("%d\n", sizeof(double));
}
***************
*** 9610,9615 ****
--- 9769,9800 ----
esac
$rm -f try.c try
+ echo " "
+ echo "Determining whether or not we are on an EBCDIC system..." >&4
+ $cat >tebcdic.c <<EOM
+ int main()
+ {
+ if ('M'==0xd4) return 0;
+ return 1;
+ }
+ EOM
+ val=$undef
+ set tebcdic
+ if eval $compile_ok; then
+ if ./tebcdic; then
+ echo "You have EBCDIC." >&4
+ val="$define"
+ else
+ echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin." >&4
+ fi
+ else
+ echo "I'm unable to compile the test program." >&4
+ echo "I'll assume ASCII or some ISO Latin." >&4
+ fi
+ $rm -f tebcdic.c tebcdic
+ set ebcdic
+ eval $setvar
+
: see what type file positions are declared as in the library
rp="What is the type for file position used by fsetpos()?"
set fpos_t fpostype long stdio.h sys/types.h
***************
*** 9630,9635 ****
--- 9815,9826 ----
: Store the full pathname to the sed program for use in the C program
full_sed=$sed
+ : Store the full pathname to the ar program for use in the Makefile.SH
+ : Respect a hint or command line value for full_ar.
+ case "$full_ar" in
+ '') full_ar=$ar ;;
+ esac
+
: see what type gids are declared as in the kernel
echo " "
echo "Looking for the type for group ids returned by getgid()."
***************
*** 9928,9934 ****
fi
$cat >>try.c <<'EOCP'
#include <stdio.h>
! main()
{
printf("%d\n", sizeof(VOID_PTR));
exit(0);
--- 10119,10125 ----
fi
$cat >>try.c <<'EOCP'
#include <stdio.h>
! int main()
{
printf("%d\n", sizeof(VOID_PTR));
exit(0);
***************
*** 9966,9972 ****
#endif
EOCP
$cat >>try.c <<'EOCP'
! main()
{
register int i;
register unsigned long tmp;
--- 10157,10163 ----
#endif
EOCP
$cat >>try.c <<'EOCP'
! int main()
{
register int i;
register unsigned long tmp;
***************
*** 10004,10010 ****
echo 'int bar1() { return bar2(); }' > bar1.c
echo 'int bar2() { return 2; }' > bar2.c
$cat > foo.c <<'EOP'
! main() { printf("%d\n", bar1()); exit(0); }
EOP
$cc $ccflags -c bar1.c >/dev/null 2>&1
$cc $ccflags -c bar2.c >/dev/null 2>&1
--- 10195,10201 ----
echo 'int bar1() { return bar2(); }' > bar1.c
echo 'int bar2() { return 2; }' > bar2.c
$cat > foo.c <<'EOP'
! int main() { printf("%d\n", bar1()); exit(0); }
EOP
$cc $ccflags -c bar1.c >/dev/null 2>&1
$cc $ccflags -c bar2.c >/dev/null 2>&1
***************
*** 10064,10070 ****
#ifdef I_SYSSELECT
#include <sys/select.h>
#endif
! main()
{
struct tm foo;
#ifdef S_TIMEVAL
--- 10255,10261 ----
#ifdef I_SYSSELECT
#include <sys/select.h>
#endif
! int main()
{
struct tm foo;
#ifdef S_TIMEVAL
***************
*** 10148,10154 ****
#ifdef I_SYS_SELECT
#include <sys/select.h>
#endif
! main() {
fd_set fds;
#ifdef TRYBITS
--- 10339,10345 ----
#ifdef I_SYS_SELECT
#include <sys/select.h>
#endif
! int main() {
fd_set fds;
#ifdef TRYBITS
***************
*** 10217,10224 ****
: The first arg can be int, unsigned, or size_t
: The last arg may or may not be 'const'
val=''
for xxx in 'fd_set *' 'int *'; do
! for nfd in 'int' 'size_t' 'unsigned' ; do
for tmo in 'struct timeval *' 'const struct timeval *'; do
case "$val" in
'') try="extern select _(($nfd, $xxx, $xxx, $xxx, $tmo));"
--- 10408,10417 ----
: The first arg can be int, unsigned, or size_t
: The last arg may or may not be 'const'
val=''
+ : void pointer has been seen but using that
+ : breaks the selectminbits test
for xxx in 'fd_set *' 'int *'; do
! for nfd in 'int' 'size_t' 'unsigned' 'unsigned long'; do
for tmo in 'struct timeval *' 'const struct timeval *'; do
case "$val" in
'') try="extern select _(($nfd, $xxx, $xxx, $xxx, $tmo));"
***************
*** 10250,10255 ****
--- 10443,10542 ----
;;
esac
+ : check for the select 'width'
+ case "$selectminbits" in
+ '') case "$d_select" in
+ $define)
+ $cat <<EOM
+
+ Checking to see on how many bits at a time your select() operates...
+ EOM
+ $cat >try.c <<EOCP
+ #include <sys/types.h>
+ #$i_time I_TIME
+ #$i_systime I_SYS_TIME
+ #$i_systimek I_SYS_TIME_KERNEL
+ #ifdef I_TIME
+ # include <time.h>
+ #endif
+ #ifdef I_SYS_TIME
+ # ifdef I_SYS_TIME_KERNEL
+ # define KERNEL
+ # endif
+ # include <sys/time.h>
+ # ifdef I_SYS_TIME_KERNEL
+ # undef KERNEL
+ # endif
+ #endif
+ #$i_sysselct I_SYS_SELECT
+ #ifdef I_SYS_SELECT
+ #include <sys/select.h>
+ #endif
+ #include <stdio.h>
+ $selecttype b;
+ #define S sizeof(*(b))
+ #define MINBITS 64
+ #define NBYTES (S * 8 > MINBITS ? S : MINBITS/8)
+ #define NBITS (NBYTES * 8)
+ int main() {
+ char s[NBYTES];
+ struct timeval t;
+ int i;
+ FILE* fp;
+ int fd;
+
+ fclose(stdin);
+ fp = fopen("try.c", "r");
+ if (fp == 0)
+ exit(1);
+ fd = fileno(fp);
+ if (fd < 0)
+ exit(2);
+ b = ($selecttype)s;
+ for (i = 0; i < NBITS; i++)
+ FD_SET(i, b);
+ t.tv_sec = 0;
+ t.tv_usec = 0;
+ select(fd + 1, b, 0, 0, &t);
+ for (i = NBITS - 1; i > fd && FD_ISSET(i, b); i--);
+ printf("%d\n", i + 1);
+ return 0;
+ }
+ EOCP
+ set try
+ if eval $compile_ok; then
+ selectminbits=`./try`
+ case "$selectminbits" in
+ '') cat >&4 <<EOM
+ Cannot figure out on how many bits at a time your select() operates.
+ I'll play safe and guess it is 32 bits.
+ EOM
+ selectminbits=32
+ bits="32 bits"
+ ;;
+ 1) bits="1 bit" ;;
+ *) bits="$selectminbits bits" ;;
+ esac
+ echo "Your select() operates on $bits at a time." >&4
+ else
+ rp='What is the minimum number of bits your select() operates on?'
+ case "$byteorder" in
+ 1234|12345678) dflt=32 ;;
+ *) dflt=1 ;;
+ esac
+ . ./myread
+ val=$ans
+ selectminbits="$val"
+ fi
+ $rm -f try.* try
+ ;;
+ *) : no select, so pick a harmless default
+ selectminbits='32'
+ ;;
+ esac
+ ;;
+ esac
+
: Trace out the files included by signal.h, then look for SIGxxx names.
: Remove SIGARRAYSIZE used by HPUX.
: Remove SIGTYP void lines used by OS2.
***************
*** 10458,10464 ****
: generate list of signal names
echo " "
case "$sig_name_init" in
! '')
echo "Generating a list of signal names and numbers..." >&4
. ./signal_cmd
sig_name=`$awk '{printf "%s ", $1}' signal.lst`
--- 10745,10757 ----
: generate list of signal names
echo " "
case "$sig_name_init" in
! '') doinit=yes ;;
! *) case "$sig_num_init" in
! ''|*,*) doinit=yes ;;
! esac ;;
! esac
! case "$doinit" in
! yes)
echo "Generating a list of signal names and numbers..." >&4
. ./signal_cmd
sig_name=`$awk '{printf "%s ", $1}' signal.lst`
***************
*** 10466,10472 ****
sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " }
{ printf "\"%s\", ", $1 }
END { printf "0\n" }' signal.lst`
! sig_num=`$awk 'BEGIN { printf "0, " }
{ printf "%d, ", $2}
END { printf "0\n"}' signal.lst`
;;
--- 10759,10767 ----
sig_name_init=`$awk 'BEGIN { printf "\"ZERO\", " }
{ printf "\"%s\", ", $1 }
END { printf "0\n" }' signal.lst`
! sig_num=`$awk '{printf "%d ", $2}' signal.lst`
! sig_num="0 $sig_num"
! sig_num_init=`$awk 'BEGIN { printf "0, " }
{ printf "%d, ", $2}
END { printf "0\n"}' signal.lst`
;;
***************
*** 10498,10504 ****
#include <sys/types.h>
#define Size_t $sizetype
#define SSize_t $dflt
! main()
{
if (sizeof(Size_t) == sizeof(SSize_t))
printf("$dflt\n");
--- 10793,10799 ----
#include <sys/types.h>
#define Size_t $sizetype
#define SSize_t $dflt
! int main()
{
if (sizeof(Size_t) == sizeof(SSize_t))
printf("$dflt\n");
***************
*** 10814,10825 ****
./Cppsym -l $al | $sort | $grep -v '^$' >Cppsym.true
: now check the C compiler for additional symbols
$cat >ccsym <<EOS
$startsh
$cat >tmp.c <<EOF
extern int foo;
EOF
! for i in \`$cc -v -c tmp.c 2>&1\`
do
case "\$i" in
-D*) echo "\$i" | $sed 's/^-D//';;
--- 11109,11124 ----
./Cppsym -l $al | $sort | $grep -v '^$' >Cppsym.true
: now check the C compiler for additional symbols
+ postprocess_cc_v=''
+ case "$osname" in
+ aix) postprocess_cc_v="|$tr , ' '" ;;
+ esac
$cat >ccsym <<EOS
$startsh
$cat >tmp.c <<EOF
extern int foo;
EOF
! for i in \`$cc -v -c tmp.c 2>&1 $postprocess_cc_v\`
do
case "\$i" in
-D*) echo "\$i" | $sed 's/^-D//';;
***************
*** 10828,10836 ****
done
$rm -f try.c
EOS
chmod +x ccsym
$eunicefix ccsym
! ./ccsym | $sort | $uniq >ccsym.raw
$awk '/\=/ { print $0; next }
{ print $0"=1" }' ccsym.raw >ccsym.list
$awk '{ print $0"=1" }' Cppsym.true >ccsym.true
--- 11127,11142 ----
done
$rm -f try.c
EOS
+ unset postprocess_cc_v
chmod +x ccsym
$eunicefix ccsym
! ./ccsym > ccsym1.raw
! if $test -s ccsym1.raw; then
! $sort ccsym1.raw | $uniq >ccsym.raw
! else
! mv ccsym1.raw ccsym.raw
! fi
!
$awk '/\=/ { print $0; next }
{ print $0"=1" }' ccsym.raw >ccsym.list
$awk '{ print $0"=1" }' Cppsym.true >ccsym.true
***************
*** 10838,10849 ****
$comm -12 ccsym.true ccsym.list >ccsym.com
$comm -23 ccsym.true ccsym.list >ccsym.cpp
also=''
- symbols='symbols'
if $test -z ccsym.raw; then
echo "Your C compiler doesn't seem to define any symbol!" >&4
echo " "
echo "However, your C preprocessor defines the following ones:"
$cat Cppsym.true
else
if $test -s ccsym.com; then
echo "Your C compiler and pre-processor define these symbols:"
--- 11144,11158 ----
$comm -12 ccsym.true ccsym.list >ccsym.com
$comm -23 ccsym.true ccsym.list >ccsym.cpp
also=''
if $test -z ccsym.raw; then
echo "Your C compiler doesn't seem to define any symbol!" >&4
echo " "
echo "However, your C preprocessor defines the following ones:"
$cat Cppsym.true
+ ccsymbols=''
+ cppsymbols=`$cat Cppsym.true`
+ cppsymbols=`echo $cppsymbols`
+ cppccsymbols="$cppsymbols"
else
if $test -s ccsym.com; then
echo "Your C compiler and pre-processor define these symbols:"
***************
*** 10851,10870 ****
also='also '
symbols='ones'
$test "$silent" || sleep 1
fi
if $test -s ccsym.cpp; then
$test "$also" && echo " "
! echo "Your C pre-processor ${also}defines the following $symbols:"
$sed -e 's/\(.*\)=.*/\1/' ccsym.cpp
also='further '
$test "$silent" || sleep 1
fi
if $test -s ccsym.own; then
$test "$also" && echo " "
! echo "Your C compiler ${also}defines the following cpp variables:"
$sed -e 's/\(.*\)=1/\1/' ccsym.own
$sed -e 's/\(.*\)=.*/\1/' ccsym.own | $uniq >>Cppsym.true
$test "$silent" || sleep 1
fi
fi
$rm -f ccsym*
--- 11160,11185 ----
also='also '
symbols='ones'
$test "$silent" || sleep 1
+ cppccsymbols=`$cat ccsym.com`
+ cppccsymbols=`echo $cppccsymbols`
fi
if $test -s ccsym.cpp; then
$test "$also" && echo " "
! echo "Your C pre-processor ${also}defines the following symbols:"
$sed -e 's/\(.*\)=.*/\1/' ccsym.cpp
also='further '
$test "$silent" || sleep 1
+ cppsymbols=`$cat ccsym.cpp`
+ cppsymbols=`echo $cppsymbols`
fi
if $test -s ccsym.own; then
$test "$also" && echo " "
! echo "Your C compiler ${also}defines the following cpp symbols:"
$sed -e 's/\(.*\)=1/\1/' ccsym.own
$sed -e 's/\(.*\)=.*/\1/' ccsym.own | $uniq >>Cppsym.true
$test "$silent" || sleep 1
+ ccsymbols=`$cat ccsym.own`
+ ccsymbols=`echo $ccsymbols`
fi
fi
$rm -f ccsym*
***************
*** 11047,11064 ****
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
- : see if sys/stat.h is available
- set sys/stat.h i_sysstat
- eval $inhdr
-
: see if this is a sys/un.h system
set sys/un.h i_sysun
eval $inhdr
--- 11362,11371 ----
***************
*** 11195,11200 ****
--- 11502,11508 ----
esac
;;
IPC/SysV|ipc/sysv)
+ : XXX Do we need a useipcsysv variable here
case "${d_msg}${d_sem}${d_shm}" in
*"${define}"*) avail_ext="$avail_ext $xxx" ;;
esac
***************
*** 11441,11446 ****
--- 11749,11755 ----
cccdlflags='$cccdlflags'
ccdlflags='$ccdlflags'
ccflags='$ccflags'
+ ccsymbols='$ccsymbols'
cf_by='$cf_by'
cf_email='$cf_email'
cf_time='$cf_time'
***************
*** 11460,11465 ****
--- 11769,11776 ----
cppminus='$cppminus'
cpprun='$cpprun'
cppstdin='$cppstdin'
+ cppsymbols='$cppsymbols'
+ cppccsymbols='$cppccsymbols'
cryptlib='$cryptlib'
csh='$csh'
d_Gconvert='$d_Gconvert'
***************
*** 11512,11517 ****
--- 11823,11833 ----
d_fork='$d_fork'
d_fpathconf='$d_fpathconf'
d_fsetpos='$d_fsetpos'
+ d_fstatfs='$d_fstatfs'
+ d_statfsflags='$d_statfsflags'
+ d_fstatvfs='$d_fstatvfs'
+ d_getmntent='$d_getmntent'
+ d_hasmntopt='$d_hasmntopt'
d_ftime='$d_ftime'
d_getgrent='$d_getgrent'
d_getgrps='$d_getgrps'
***************
*** 11706,11711 ****
--- 12022,12028 ----
flex='$flex'
fpostype='$fpostype'
freetype='$freetype'
+ full_ar='$full_ar'
full_csh='$full_csh'
full_sed='$full_sed'
gccversion='$gccversion'
***************
*** 11734,11746 ****
--- 12051,12066 ----
i_limits='$i_limits'
i_locale='$i_locale'
i_malloc='$i_malloc'
+ i_machcthreads='$i_machcthreads'
i_math='$i_math'
i_memory='$i_memory'
+ i_mntent='$i_mntent'
i_ndbm='$i_ndbm'
i_netdb='$i_netdb'
i_neterrno='$i_neterrno'
i_niin='$i_niin'
i_pwd='$i_pwd'
+ i_pthread='$i_pthread'
i_rpcsvcdbm='$i_rpcsvcdbm'
i_sfio='$i_sfio'
i_sgtty='$i_sgtty'
***************
*** 11753,11764 ****
--- 12073,12086 ----
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'
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'
***************
*** 11774,11779 ****
--- 12096,12102 ----
i_varargs='$i_varargs'
i_varhdr='$i_varhdr'
i_vfork='$i_vfork'
+ ignore_versioned_solibs='$ignore_versioned_solibs'
incpath='$incpath'
inews='$inews'
installarchlib='$installarchlib'
***************
*** 11784,11789 ****
--- 12107,12113 ----
installscript='$installscript'
installsitearch='$installsitearch'
installsitelib='$installsitelib'
+ installusrbinperl='$installusrbinperl'
intsize='$intsize'
known_extensions='$known_extensions'
ksh='$ksh'
***************
*** 11882,11887 ****
--- 12206,12212 ----
scriptdir='$scriptdir'
scriptdirexp='$scriptdirexp'
sed='$sed'
+ selectminbits='$selectminbits'
selecttype='$selecttype'
sendmail='$sendmail'
sh='$sh'
***************
*** 11894,11899 ****
--- 12219,12225 ----
sig_name='$sig_name'
sig_name_init='$sig_name_init'
sig_num='$sig_num'
+ sig_num_init='$sig_num_init'
signal_t='$signal_t'
sitearch='$sitearch'
sitearchexp='$sitearchexp'
***************
*** 12022,12072 ****
: if this fails, just run all the .SH files by hand
. ./config.sh
-
- case "$ebcdic" in
- $define)
- xxx=''
- echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4
- rm -f y.tab.c y.tab.h
- yacc -d perly.y >/dev/null 2>&1
- if cmp -s y.tab.c perly.c; then
- rm -f y.tab.c
- else
- echo "perly.y -> perly.c" >&4
- mv -f y.tab.c perly.c
- chmod u+w perly.c
- sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \
- -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c
- xxx="$xxx perly.c"
- fi
- if cmp -s y.tab.h perly.h; then
- rm -f y.tab.h
- else
- echo "perly.y -> perly.h" >&4
- mv -f y.tab.h perly.h
- xxx="$xxx perly.h"
- fi
- echo "x2p/a2p.y" >&4
- cd x2p
- rm -f y.tab.c
- yacc a2p.y >/dev/null 2>&1
- if cmp -s y.tab.c a2p.c
- then
- rm -f y.tab.c
- else
- echo "a2p.y -> a2p.c" >&4
- mv -f y.tab.c a2p.c
- chmod u+w a2p.c
- sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \
- -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c
- xxx="$xxx a2p.c"
- fi
- cd ..
- case "$xxx" in
- '') echo "No parser files were regenerated. That's okay." >&4 ;;
- esac
- ;;
- esac
echo " "
exec 1>&4
--- 12348,12353 ----
diff -c 'perl5.005_02/Copying' 'perl5.005_03/Copying'
Index: ./Copying
*** ./Copying Thu Jul 23 22:59:27 1998
--- ./Copying Sun Oct 25 08:23:54 1998
***************
*** 2,8 ****
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
! 675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
--- 2,8 ----
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
! 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
***************
*** 215,222 ****
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
--- 215,222 ----
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software Foundation,
! Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
diff -c 'perl5.005_02/EXTERN.h' 'perl5.005_03/EXTERN.h'
Index: ./EXTERN.h
*** ./EXTERN.h Thu Jul 23 22:59:27 1998
--- ./EXTERN.h Sat Mar 27 11:57:35 1999
***************
*** 1,6 ****
/* EXTERN.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* EXTERN.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/INSTALL' 'perl5.005_03/INSTALL'
Index: ./INSTALL
Prereq: 1.42
*** ./INSTALL Wed Aug 5 16:57:37 1998
--- ./INSTALL Thu Mar 25 23:45:35 1999
***************
*** 64,69 ****
--- 64,86 ----
changes in the Perl language in the current release. Please see
pod/perldelta.pod for a description of what's changed.
+ =head1 WARNING: This version requires a compiler that supports ANSI C.
+
+ If you find that your C compiler is not ANSI-capable, try obtaining
+ GCC, available from GNU mirrors worldwide (e.g. ftp://ftp.gnu.org/pub/gnu).
+ Another alternative may be to use a tool like C<ansi2knr> to convert the
+ sources back to K&R style, but there is no guarantee this route will get
+ you anywhere, since the prototypes are not the only ANSI features used
+ in the Perl sources. C<ansi2knr> is usually found as part of the freely
+ available C<Ghostscript> distribution. Another similar tool is
+ C<unprotoize>, distributed with GCC. Since C<unprotoize> requires GCC to
+ run, you may have to run it on a platform where GCC is available, and move
+ the sources back to the platform without GCC.
+
+ If you succeed in automatically converting the sources to a K&R compatible
+ form, be sure to email perlbug@perl.com to let us know the steps you
+ followed. This will enable us to officially support this option.
+
=head1 Space Requirements
The complete perl5 source tree takes up about 10 MB of disk space. The
***************
*** 167,172 ****
--- 184,192 ----
into a directory typically found along a user's PATH, or in another
obvious and convenient place.
+ You can use "Configure -Uinstallusrbinperl" which causes installperl
+ to skip installing perl also as /usr/bin/perl.
+
By default, Configure will compile perl to use dynamic loading if
your system supports it. If you want to force perl to be compiled
statically, you can either choose this when Configure prompts you or
***************
*** 472,494 ****
If you need to install perl on many identical systems, it is
convenient to compile it once and create an archive that can be
! installed on multiple systems. Here's one way to do that:
# Set up config.over to install perl into a different directory,
# e.g. /tmp/perl5 (see previous part).
! sh Configure -des
make
make test
! make install
cd /tmp/perl5
! # Edit $archlib/Config.pm to change all the
# install* variables back to reflect where everything will
! # really be installed.
! # Edit any of the scripts in $scriptdir to have the correct
# #!/wherever/perl line.
tar cvf ../perl5-archive.tar .
# Then, on each machine where you want to install perl,
! cd /usr/local # Or wherever you specified as $prefix
tar xvf perl5-archive.tar
=head2 Site-wide Policy settings
--- 492,517 ----
If you need to install perl on many identical systems, it is
convenient to compile it once and create an archive that can be
! installed on multiple systems. Suppose, for example, that you want to
! create an archive that can be installed in /opt/perl.
! Here's one way to do that:
# Set up config.over to install perl into a different directory,
# e.g. /tmp/perl5 (see previous part).
! sh Configure -Dprefix=/opt/perl -des
make
make test
! make install # This will install everything into /tmp/perl5.
cd /tmp/perl5
! # Edit $archlib/Config.pm and $archlib/.packlist to change all the
# install* variables back to reflect where everything will
! # really be installed. (That is, change /tmp/perl5 to /opt/perl
! # everywhere in those files.)
! # Check the scripts in $scriptdir to make sure they have the correct
# #!/wherever/perl line.
tar cvf ../perl5-archive.tar .
# Then, on each machine where you want to install perl,
! cd /opt/perl # Or wherever you specified as $prefix
tar xvf perl5-archive.tar
=head2 Site-wide Policy settings
***************
*** 518,525 ****
=head2 Threads
! On some platforms, perl5.005 can be compiled to use threads. To
! enable this, read the file README.threads, and then try
sh Configure -Dusethreads
--- 541,549 ----
=head2 Threads
! On some platforms, perl5.005 can be compiled with experimental support
! for threads. To enable this, read the file README.threads, and then
! try:
sh Configure -Dusethreads
***************
*** 653,661 ****
sh Configure -Duseshrplib
! To actually build perl, you must add the current working directory to your
! LD_LIBRARY_PATH environment variable before running make. You can do
! this with
LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH; export LD_LIBRARY_PATH
--- 677,700 ----
sh Configure -Duseshrplib
! To build a shared libperl, the environment variable controlling shared
! library search (LD_LIBRARY_PATH in most systems, DYLD_LIBRARY_PATH for
! NeXTSTEP/OPENSTEP, LIBRARY_PATH for BeOS) must be set up to include
! the Perl build directory because that's where the shared libperl will
! be created. Configure arranges Makefile to have the correct shared
! library search settings.
!
! However, there are some special cases where manually setting the
! shared library path might be required. For example, if you want to run
! something like the following with the newly-built but not-yet-installed
! ./perl:
!
! cd t; ./perl misc/failing_test.t
! or
! ./perl -Ilib ~/my_mission_critical_test
!
! then you need to set up the shared library path explicitly.
! You can do this with
LD_LIBRARY_PATH=`pwd`:$LD_LIBRARY_PATH; export LD_LIBRARY_PATH
***************
*** 663,671 ****
setenv LD_LIBRARY_PATH `pwd`
! for Csh-style shells. You *MUST* do this before running make.
! Folks running NeXT OPENSTEP must substitute DYLD_LIBRARY_PATH for
! LD_LIBRARY_PATH above.
There is also an potential problem with the shared perl library if you
want to have more than one "flavor" of the same version of perl (e.g.
--- 702,714 ----
setenv LD_LIBRARY_PATH `pwd`
! for Csh-style shells. (This procedure may also be needed if for some
! unexpected reason Configure fails to set up Makefile correctly.)
!
! You can often recognize failures to build/use a shared libperl from error
! messages complaining about a missing libperl.so (or libperl.sl in HP-UX),
! for example:
! 18126:./miniperl: /sbin/loader: Fatal Error: cannot map libperl.so
There is also an potential problem with the shared perl library if you
want to have more than one "flavor" of the same version of perl (e.g.
***************
*** 771,791 ****
by adding appropriate -D directives to your ccflags variable in
config.sh.
- For example, you can replace the rand() and srand() functions in the
- perl source by any other random number generator by a trick such as the
- following (this should all be on one line):
-
- sh Configure -Dccflags='-Dmy_rand=random -Dmy_srand=srandom' \
- -Drandbits=31
-
- or you can use the drand48 family of functions with
-
- sh Configure -Dccflags='-Dmy_rand=lrand48 -Dmy_srand=srand48' \
- -Drandbits=31
-
- or by adding the -D flags to your ccflags at the appropriate Configure
- prompt. (Read pp.c to see how this works.)
-
You should also run Configure interactively to verify that a hint file
doesn't inadvertently override your ccflags setting. (Hints files
shouldn't do that, but some might.)
--- 814,819 ----
***************
*** 920,925 ****
--- 948,989 ----
You'll probably also have to extensively modify the extension building
mechanism.
+ =item Environment variable clashes
+
+ Configure uses a CONFIG variable that is reported to cause trouble on
+ ReliantUnix 5.44. If your system sets this variable, you can try
+ unsetting it before you run Configure. Configure should eventually
+ be fixed to avoid polluting the namespace of the environment.
+
+ =item Digital UNIX/Tru64 UNIX and BIN_SH
+
+ In Digital UNIX/Tru64 UNIX Configure might abort with
+
+ Build a threading Perl? [n]
+ Configure[2437]: Syntax error at line 1 : `config.sh' is not expected.
+
+ This indicates that Configure is being run with a broken Korn shell
+ (even though you think you are using a Bourne shell by using
+ "sh Configure" or "./Configure"). The Korn shell bug has been reported
+ to Compaq as of February 1999 but in the meanwhile, the reason ksh is
+ being used is that you have the environment variable BIN_SH set to
+ 'xpg4'. This causes /bin/sh to delegate its duties to /bin/posix/sh
+ (a ksh). Unset the environment variable and rerun Configure.
+
+ =item HP-UX 11, pthreads, and libgdbm
+
+ If you are running Configure with -Dusethreads in HP-UX 11, be warned
+ that POSIX threads and libgdbm (the GNU dbm library) compiled before
+ HP-UX 11 do not mix. This will cause a basic test run by Configure to
+ fail
+
+ Pthread internal error: message: __libc_reinit() failed, file: ../pthreads/pthread.c, line: 1096
+ Return Pointer is 0xc082bf33
+ sh: 5345 Quit(coredump)
+
+ and Configure will give up. The cure is to recompile and install
+ libgdbm under HP-UX 11.
+
=item Porting information
Specific information for the OS/2, Plan9, VMS and Win32 ports is in the
***************
*** 1218,1223 ****
--- 1282,1298 ----
with "ipcrm -s SEMAPHORE_ID_HERE" or configure more semaphores to your
system.
+ =item GNU binutils
+
+ If you mix GNU binutils (nm, ld, ar) with equivalent vendor-supplied
+ tools you may be in for some trouble. For example creating archives
+ with an old GNU 'ar' and then using a new current vendor-supplied 'ld'
+ may lead into linking problems. Either recompile your GNU binutils
+ under your current operating system release, or modify your PATH not
+ to include the GNU utils before running Configure, or specify the
+ vendor-supplied utilities explicitly to Configure, for example by
+ Configure -Dar=/bin/ar.
+
=item Miscellaneous
Some additional things that have been reported for either perl4 or perl5:
***************
*** 1236,1241 ****
--- 1311,1322 ----
Machines with half-implemented dbm routines will need to #undef I_ODBM
+ HP-UX 11 Y2K patch "Y2K-1100 B.11.00.B0125 HP-UX Core OS Year 2000
+ Patch Bundle" has been reported to break the io/fs test #18 which
+ tests whether utime() can change timestamps. The Y2K patch seems to
+ break utime() so that over NFS the timestamps do not get changed
+ (on local filesystems utime() still works).
+
=back
=head1 make test
diff -c 'perl5.005_02/INTERN.h' 'perl5.005_03/INTERN.h'
Index: ./INTERN.h
*** ./INTERN.h Thu Jul 23 22:59:28 1998
--- ./INTERN.h Sat Mar 27 11:57:33 1999
***************
*** 1,6 ****
/* INTERN.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* INTERN.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/MANIFEST' 'perl5.005_03/MANIFEST'
Index: ./MANIFEST
*** ./MANIFEST Tue Aug 4 18:08:11 1998
--- ./MANIFEST Sun Mar 28 10:12:59 1999
***************
*** 29,37 ****
--- 29,41 ----
Porting/pumpkin.pod Guidelines and hints for Perl maintainers
README The Instructions
README.amiga Notes about AmigaOS port
+ README.apollo Notes about Apollo DomainOS port
README.beos Notes about BeOS port
README.cygwin32 Notes about Cygwin32 port
README.dos Notes about dos/djgpp port
+ README.hpux Notes about HP-UX port
+ README.hurd Notes about GNU/Hurd port
+ README.mint Notes about Atari MiNT port
README.mpeix Notes about MPE/iX port
README.os2 Notes about OS/2 port
README.os390 Notes about OS/390 (nee MVS) port
***************
*** 39,49 ****
--- 43,55 ----
README.qnx Notes about QNX port
README.threads Notes about multithreading
README.vms Notes about VMS port
+ README.vos Notes about Stratus VOS port
README.win32 Notes about Win32 port
Todo The Wishlist
Todo-5.005 What needs doing before 5.005 release
XSlock.h Include file for extensions built with PERL_OBJECT defined
XSUB.h Include file for extension subroutines
+ apollo/netinet/in.h Apollo DomainOS port: C header file frontend
av.c Array value code
av.h Array value header
beos/nm.c BeOS port
***************
*** 65,72 ****
cygwin32/perlgcc Cygwin32 port
cygwin32/perlld Cygwin32 port
deb.c Debugging routines
! djgpp/config.over DOS/DJGPP port
! djgpp/configure.bat DOS/DJGPP port
djgpp/djgpp.c DOS/DJGPP port
djgpp/djgppsed.sh DOS/DJGPP port
djgpp/fixpmain DOS/DJGPP port
--- 71,78 ----
cygwin32/perlgcc Cygwin32 port
cygwin32/perlld Cygwin32 port
deb.c Debugging routines
! djgpp/config.over DOS/DJGPP port
! djgpp/configure.bat DOS/DJGPP port
djgpp/djgpp.c DOS/DJGPP port
djgpp/djgppsed.sh DOS/DJGPP port
djgpp/fixpmain DOS/DJGPP port
***************
*** 185,190 ****
--- 191,197 ----
ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder
ext/DB_File/Makefile.PL Berkeley DB extension makefile writer
ext/DB_File/dbinfo Berkeley DB database version checker
+ ext/DB_File/hints/dynixptx.pl Hints for DB_File for named architecture
ext/DB_File/typemap Berkeley DB extension interface types
ext/Data/Dumper/Changes Data pretty printer, changelog
ext/Data/Dumper/Dumper.pm Data pretty printer, module
***************
*** 195,200 ****
--- 202,208 ----
ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer
ext/DynaLoader/README Dynamic Loader notes and intro
ext/DynaLoader/dl_aix.xs AIX implementation
+ ext/DynaLoader/dl_beos.xs BeOS implementation
ext/DynaLoader/dl_cygwin32.xs Cygwin32 implementation
ext/DynaLoader/dl_dld.xs GNU dld style implementation
ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation
***************
*** 213,218 ****
--- 221,227 ----
ext/GDBM_File/GDBM_File.pm GDBM extension Perl module
ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines
ext/GDBM_File/Makefile.PL GDBM extension makefile writer
+ ext/GDBM_File/hints/sco.pl Hint for GDBM_File for named architecture
ext/GDBM_File/typemap GDBM extension interface types
ext/IO/IO.pm Top-level interface to IO::* classes
ext/IO/IO.xs IO extension external subroutines
***************
*** 262,269 ****
--- 271,280 ----
ext/POSIX/POSIX.pod POSIX extension documentation
ext/POSIX/POSIX.xs POSIX extension external subroutines
ext/POSIX/hints/bsdos.pl Hint for POSIX for named architecture
+ ext/POSIX/hints/dynixptx.pl Hint for POSIX for named architecture
ext/POSIX/hints/freebsd.pl Hint for POSIX for named architecture
ext/POSIX/hints/linux.pl Hint for POSIX for named architecture
+ ext/POSIX/hints/mint.pl Hint for POSIX for named architecture
ext/POSIX/hints/netbsd.pl Hint for POSIX for named architecture
ext/POSIX/hints/next_3.pl Hint for POSIX for named architecture
ext/POSIX/hints/openbsd.pl Hint for POSIX for named architecture
***************
*** 380,385 ****
--- 391,397 ----
hints/fps.sh Hints for named architecture
hints/freebsd.sh Hints for named architecture
hints/genix.sh Hints for named architecture
+ hints/gnu.sh Hints for named architecture
hints/greenhills.sh Hints for named architecture
hints/hpux.sh Hints for named architecture
hints/i386.sh Hints for named architecture
***************
*** 394,399 ****
--- 406,412 ----
hints/lynxos.sh Hints for named architecture
hints/machten.sh Hints for named architecture
hints/machten_2.sh Hints for named architecture
+ hints/mint.sh Hints for named architecture
hints/mips.sh Hints for named architecture
hints/mpc.sh Hints for named architecture
hints/mpeix.sh Hints for named architecture
***************
*** 429,440 ****
hints/unisysdynix.sh Hints for named architecture
hints/utekv.sh Hints for named architecture
hints/uts.sh Hints for named architecture
hv.c Hash value code
hv.h Hash value header
installhtml Perl script to install html files for pods
installman Perl script to install man pages for pods
installperl Perl script to do "make install" dirty work
- interp.sym Interpreter specific symbols to hide in a struct
intrpvar.h Variables held in each interpreter instance
iperlsys.h Perl's interface to the system
keywords.h The keyword numbers
--- 442,453 ----
hints/unisysdynix.sh Hints for named architecture
hints/utekv.sh Hints for named architecture
hints/uts.sh Hints for named architecture
+ hints/uwin.sh Hints for named architecture
hv.c Hash value code
hv.h Hash value header
installhtml Perl script to install html files for pods
installman Perl script to install man pages for pods
installperl Perl script to do "make install" dirty work
intrpvar.h Variables held in each interpreter instance
iperlsys.h Perl's interface to the system
keywords.h The keyword numbers
***************
*** 456,463 ****
lib/Carp.pm Error message base class
lib/Class/Struct.pm Declare struct-like datatypes as Perl classes
lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir)
! lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
lib/DirHandle.pm like FileHandle only for directories
lib/English.pm Readable aliases for short variables
lib/Env.pm Map environment into ordinary variables
lib/Exporter.pm Exporter base class
--- 469,477 ----
lib/Carp.pm Error message base class
lib/Class/Struct.pm Declare struct-like datatypes as Perl classes
lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir)
! lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
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.pm Exporter base class
***************
*** 553,559 ****
lib/bigrat.pl An arbitrary precision rational arithmetic package
lib/blib.pm For "use blib"
lib/cacheout.pl Manages output filehandles when you need too many
! lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead)
lib/complete.pl A command completion subroutine
lib/constant.pm For "use constant"
lib/ctime.pl A ctime workalike
--- 567,573 ----
lib/bigrat.pl An arbitrary precision rational arithmetic package
lib/blib.pm For "use blib"
lib/cacheout.pl Manages output filehandles when you need too many
! lib/chat2.pl Obsolete ipc library (use Comm.pm etc instead)
lib/complete.pl A command completion subroutine
lib/constant.pm For "use constant"
lib/ctime.pl A ctime workalike
***************
*** 602,607 ****
--- 616,628 ----
mg.h Magic header
minimod.pl Writes lib/ExtUtils/Miniperl.pm
miniperlmain.c Basic perl w/o dynamic loading or extensions
+ mint/errno.h MiNT port
+ mint/Makefile MiNT port
+ mint/pwd.c MiNT port
+ mint/README MiNT port
+ mint/stdio.h MiNT port
+ mint/sys/time.h MiNT port
+ mint/time.h MiNT port
mpeix/mpeixish.h MPE/iX port
mpeix/nm MPE/iX port
mpeix/relink MPE/iX port
***************
*** 725,739 ****
--- 746,763 ----
pod/perlmodlib.pod Module policy info
pod/perlobj.pod Object info
pod/perlop.pod Operator info
+ pod/perlopentut.pod open() tutorial
pod/perlpod.pod Pod info
pod/perlport.pod Portability guide
pod/perlre.pod Regular expression info
pod/perlref.pod References info
+ pod/perlreftut.pod References tutorial
pod/perlrun.pod Execution info
pod/perlsec.pod Security info
pod/perlstyle.pod Style info
pod/perlsub.pod Subroutine info
pod/perlsyn.pod Syntax info
+ pod/perlthrtut.pod Threads tutorial
pod/perltie.pod Tieing an object class into a simple variable
pod/perltoc.pod Table of Contents info
pod/perltoot.pod Tom's object-oriented tutorial
***************
*** 829,834 ****
--- 853,859 ----
t/lib/english.t See if English works
t/lib/env.t See if Env works
t/lib/errno.t See if Errno works
+ t/lib/fatal.t See if Fatal works
t/lib/fields.t See if base/fields works
t/lib/filecache.t See if FileCache works
t/lib/filecopy.t See if File::Copy works
***************
*** 870,876 ****
t/lib/soundex.t See if Soundex works
t/lib/symbol.t See if Symbol works
t/lib/texttabs.t See if Text::Tabs works
! t/lib/textwrap.t See if Text::Wrap works
t/lib/thread.t Basic test of threading (skipped if no threads)
t/lib/tie-push.t Test for Tie::Array
t/lib/tie-stdarray.t Test for Tie::StdArray
--- 895,902 ----
t/lib/soundex.t See if Soundex works
t/lib/symbol.t See if Symbol works
t/lib/texttabs.t See if Text::Tabs works
! t/lib/textfill.t See if Text::Wrap::fill works
! t/lib/textwrap.t See if Text::Wrap::wrap works
t/lib/thread.t Basic test of threading (skipped if no threads)
t/lib/tie-push.t Test for Tie::Array
t/lib/tie-stdarray.t Test for Tie::StdArray
***************
*** 903,908 ****
--- 929,935 ----
t/op/glob.t See if <*> works
t/op/goto.t See if goto works
t/op/goto_xs.t See if "goto &sub" works on XSUBs
+ t/op/grep.t See if grep() and map() work
t/op/groups.t See if $( works
t/op/gv.t See if typeglobs work
t/op/hashwarn.t See if warnings for bad hash assignments work
***************
*** 938,944 ****
t/op/runlevel.t See if die() works from perl_call_*()
t/op/sleep.t See if sleep works
t/op/sort.t See if sort works
! t/op/splice.t See if splice works
t/op/split.t See if split works
t/op/sprintf.t See if sprintf works
t/op/stat.t See if stat works
--- 965,971 ----
t/op/runlevel.t See if die() works from perl_call_*()
t/op/sleep.t See if sleep works
t/op/sort.t See if sort works
! t/op/splice.t See if splice works
t/op/split.t See if split works
t/op/sprintf.t See if sprintf works
t/op/stat.t See if stat works
***************
*** 951,956 ****
--- 978,984 ----
t/op/tiearray.t See if tie for arrays works
t/op/tiehandle.t See if tie for handles works
t/op/time.t See if time functions work
+ t/op/tr.t See if tr works
t/op/undef.t See if undef works
t/op/universal.t See if UNIVERSAL class works
t/op/unshift.t See if unshift works
***************
*** 1006,1024 ****
vms/genopt.com hack to write options files in case of broken makes
vms/make_command.com record MM[SK] command used to build Perl
vms/mms2make.pl convert descrip.mms to make syntax
! vms/munchconfig.c performs shell $var substitution for VMS
vms/myconfig.com record local configuration info for bug report
vms/perlvms.pod VMS-specific additions to Perl documentation
vms/perly_c.vms perly.c with fixed declarations for global syms
vms/perly_h.vms perly.h with fixed declarations for global syms
vms/sockadapt.c glue for SockshShr socket support
vms/sockadapt.h glue for SockshShr socket support
! vms/subconfigure.com performs compiler checks and writes config.sh, config.h, and descrip.mms
vms/test.com DCL driver for regression tests
vms/vms.c VMS-specific C code for Perl core
vms/vms_yfix.pl convert Unix perly.[ch] to VMS perly_[ch].vms
vms/vmsish.h VMS-specific C header for Perl core
vms/writemain.pl Generate perlmain.c from miniperlmain.c+extensions
win32/GenCAPI.pl Win32 port for C API with PERL_OBJECT
win32/Makefile Win32 makefile for NMAKE (Visual C++ build)
win32/TEST Win32 port
--- 1034,1062 ----
vms/genopt.com hack to write options files in case of broken makes
vms/make_command.com record MM[SK] command used to build Perl
vms/mms2make.pl convert descrip.mms to make syntax
! vms/munchconfig.c performs shell $var substitution for VMS
vms/myconfig.com record local configuration info for bug report
vms/perlvms.pod VMS-specific additions to Perl documentation
vms/perly_c.vms perly.c with fixed declarations for global syms
vms/perly_h.vms perly.h with fixed declarations for global syms
vms/sockadapt.c glue for SockshShr socket support
vms/sockadapt.h glue for SockshShr socket support
! vms/subconfigure.com performs compiler checks and writes config.sh, config.h, and descrip.mms
vms/test.com DCL driver for regression tests
vms/vms.c VMS-specific C code for Perl core
vms/vms_yfix.pl convert Unix perly.[ch] to VMS perly_[ch].vms
vms/vmsish.h VMS-specific C header for Perl core
vms/writemain.pl Generate perlmain.c from miniperlmain.c+extensions
+ vos/build.cm VOS command macro to build Perl
+ vos/Changes Changes made to port Perl to the VOS operating system
+ vos/compile_perl.cm VOS commnad macro to build multiple version of Perl
+ vos/config.h config.h for VOS
+ vos/config_h.SH_orig config_h.SH at the time config.h was created
+ vos/perl.bind VOS bind control file
+ vos/test_vos_dummies.c Test program for "vos_dummies.c"
+ vos/vos_accept.c Wrapper to fixup nonstandard VOS _accept function
+ vos/vos_dummies.c Wrappers to soak up undefined functions
+ vos/vosish.h VOS-specific header file
win32/GenCAPI.pl Win32 port for C API with PERL_OBJECT
win32/Makefile Win32 makefile for NMAKE (Visual C++ build)
win32/TEST Win32 port
diff -c 'perl5.005_02/Makefile.SH' 'perl5.005_03/Makefile.SH'
Index: ./Makefile.SH
*** ./Makefile.SH Thu Jul 23 22:59:30 1998
--- ./Makefile.SH Wed Mar 3 20:35:25 1999
***************
*** 43,54 ****
# NeXT uses a different name.
ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH"
;;
os2*) # OS/2 doesn't need anything special for LD_LIBRARY_PATH.
ldlibpth=''
;;
! sunos*|freebsd[23]*|netbsd*)
linklibperl="-lperl"
;;
aix*)
shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp"
case "$osvers" in
--- 43,59 ----
# NeXT uses a different name.
ldlibpth="DYLD_LIBRARY_PATH=`pwd`:$DYLD_LIBRARY_PATH"
;;
+ beos*) ldlibpth="LIBRARY_PATH=`pwd`:$LIBRARY_PATH"
+ ;;
os2*) # OS/2 doesn't need anything special for LD_LIBRARY_PATH.
ldlibpth=''
;;
! sunos*)
linklibperl="-lperl"
;;
+ netbsd*|freebsd[234]*)
+ linklibperl="-L. -lperl"
+ ;;
aix*)
shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp"
case "$osvers" in
***************
*** 161,167 ****
$make_set_make
# These variables may need to be manually set for non-Unix systems.
! AR = $ar
EXE_EXT = $_exe
LIB_EXT = $_a
OBJ_EXT = $_o
--- 166,172 ----
$make_set_make
# These variables may need to be manually set for non-Unix systems.
! AR = $full_ar
EXE_EXT = $_exe
LIB_EXT = $_a
OBJ_EXT = $_o
***************
*** 450,463 ****
-@sh -c true
# No compat3.sym here since and including the 5.004_50.
! SYM = global.sym interp.sym perlio.sym thread.sym
SYMH = perlvars.h thrdvar.h
# The following files are generated automatically
# keywords.h: keywords.pl
# opcode.h: opcode.pl
! # embed.h: embed.pl global.sym interp.sym
# byterun.h: bytecode.pl
# byterun.c: bytecode.pl
# lib/B/Asmdata.pm: bytecode.pl
--- 455,469 ----
-@sh -c true
# No compat3.sym here since and including the 5.004_50.
! # No interp.sym since 5.005_03.
! SYM = global.sym perlio.sym thread.sym
SYMH = perlvars.h thrdvar.h
# The following files are generated automatically
# keywords.h: keywords.pl
# opcode.h: opcode.pl
! # embed.h: embed.pl global.sym
# byterun.h: bytecode.pl
# byterun.c: bytecode.pl
# lib/B/Asmdata.pm: bytecode.pl
***************
*** 598,610 ****
# Please *don't* use this unless all tests pass.
# If you want to report test failures, use "make nok" instead.
ok: utilities
! $(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
okfile: utilities
! $(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok
nok: utilities
! $(LBLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)'
clist: $(c)
echo $(c) | tr ' ' $(TRNL) >.clist
--- 604,616 ----
# Please *don't* use this unless all tests pass.
# If you want to report test failures, use "make nok" instead.
ok: utilities
! $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
okfile: utilities
! $(LDLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' -F perl.ok
nok: utilities
! $(LDLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)'
clist: $(c)
echo $(c) | tr ' ' $(TRNL) >.clist
***************
*** 644,646 ****
--- 650,719 ----
;;
esac
$rm -f $firstmakefile
+
+ # Now do any special processing required before building.
+
+ case "$ebcdic" in
+ $define)
+ xxx=''
+ echo "This is an EBCDIC system, checking if any parser files need regenerating." >&4
+ case "$osname" in
+ os390)
+ rm -f y.tab.c y.tab.h
+ yacc -d perly.y >/dev/null 2>&1
+ if cmp -s y.tab.c perly.c; then
+ rm -f y.tab.c
+ else
+ echo "perly.y -> perly.c" >&2
+ mv -f y.tab.c perly.c
+ chmod u+w perly.c
+ sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \
+ -e 's/y\.tab/perly/g' perly.c >perly.tmp && mv perly.tmp perly.c
+ xxx="$xxx perly.c"
+ fi
+ if cmp -s y.tab.h perly.h; then
+ rm -f y.tab.h
+ else
+ echo "perly.y -> perly.h" >&2
+ mv -f y.tab.h perly.h
+ xxx="$xxx perly.h"
+ fi
+ if cd x2p
+ then
+ rm -f y.tab.c y.tab.h
+ yacc a2p.y >/dev/null 2>&1
+ if cmp -s y.tab.c a2p.c
+ then
+ rm -f y.tab.c
+ else
+ echo "a2p.y -> a2p.c" >&2
+ mv -f y.tab.c a2p.c
+ chmod u+w a2p.c
+ sed -e 's/fprintf *( *stderr *,/PerlIO_printf(Perl_debug_log,/g' \
+ -e 's/y\.tab/a2p/g' a2p.c >a2p.tmp && mv a2p.tmp a2p.c
+ xxx="$xxx a2p.c"
+ fi
+ # In case somebody yacc -d:ed the a2p.y.
+ if test -f y.tab.h
+ then
+ if cmp -s y.tab.h a2p.h
+ then
+ rm -f y.tab.h
+ else
+ echo "a2p.h -> a2p.h" >&2
+ mv -f y.tab.h a2p.h
+ xxx="$xxx a2p.h"
+ fi
+ fi
+ cd ..
+ fi
+ ;;
+ *)
+ echo "'$osname' is an EBCDIC system I don't know that well." >&4
+ ;;
+ esac
+ case "$xxx" in
+ '') echo "No parser files were regenerated. That's okay." >&2 ;;
+ esac
+ ;;
+ esac
diff -c 'perl5.005_02/Porting/Glossary' 'perl5.005_03/Porting/Glossary'
Index: ./Porting/Glossary
*** ./Porting/Glossary Thu Jul 23 22:59:32 1998
--- ./Porting/Glossary Wed Mar 3 20:35:29 1999
***************
*** 5,11 ****
the formatting regular.]
Mcc (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the Mcc program. After Configure runs,
the value is reset to a plain "Mcc" and is not useful.
--- 5,11 ----
the formatting regular.]
Mcc (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the Mcc program. After Configure runs,
the value is reset to a plain "Mcc" and is not useful.
***************
*** 52,58 ****
will retain binary compatibility.
ar (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the ar program. After Configure runs,
the value is reset to a plain "ar" and is not useful.
--- 52,58 ----
will retain binary compatibility.
ar (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the ar program. After Configure runs,
the value is reset to a plain "ar" and is not useful.
***************
*** 79,85 ****
include os2/os2.obj.
awk (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the awk program. After Configure runs,
the value is reset to a plain "awk" and is not useful.
--- 79,85 ----
include os2/os2.obj.
awk (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the awk program. After Configure runs,
the value is reset to a plain "awk" and is not useful.
***************
*** 105,111 ****
The value is a plain '' and is not useful.
byacc (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the byacc program. After Configure runs,
the value is reset to a plain "byacc" and is not useful.
--- 105,111 ----
The value is a plain '' and is not useful.
byacc (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the byacc program. After Configure runs,
the value is reset to a plain "byacc" and is not useful.
***************
*** 129,135 ****
4 = couldn't cast in argument expression list
cat (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the cat program. After Configure runs,
the value is reset to a plain "cat" and is not useful.
--- 129,135 ----
4 = couldn't cast in argument expression list
cat (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the cat program. After Configure runs,
the value is reset to a plain "cat" and is not useful.
***************
*** 154,159 ****
--- 154,165 ----
This variable contains any additional C compiler flags desired by
the user. It is up to the Makefile to use this.
+ ccsymbols (Cppsym.U):
+ The variable contains the symbols defined by the C compiler alone.
+ The symbols defined by cpp or by cc when it calls cpp are not in
+ this list, see cppsymbols and cppccsymbols.
+ The list is a space-separated list of symbol=value tokens.
+
cf_by (cf_who.U):
Login name of the person who ran the Configure script and answered the
questions. This is used to tag both config.sh and config_h.SH.
***************
*** 184,190 ****
included).
comm (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the comm program. After Configure runs,
the value is reset to a plain "comm" and is not useful.
--- 190,196 ----
included).
comm (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the comm program. After Configure runs,
the value is reset to a plain "comm" and is not useful.
***************
*** 199,205 ****
is primarily for the use of other Configure units.
cp (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the cp program. After Configure runs,
the value is reset to a plain "cp" and is not useful.
--- 205,211 ----
is primarily for the use of other Configure units.
cp (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the cp program. After Configure runs,
the value is reset to a plain "cp" and is not useful.
***************
*** 208,214 ****
The value is a plain '' and is not useful.
cpp (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the cpp program. After Configure runs,
the value is reset to a plain "cpp" and is not useful.
--- 214,220 ----
The value is a plain '' and is not useful.
cpp (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the cpp program. After Configure runs,
the value is reset to a plain "cpp" and is not useful.
***************
*** 244,256 ****
It is primarily used by other Configure units that ask about
preprocessor symbols.
cryptlib (d_crypt.U):
This variable holds -lcrypt or the path to a libcrypt.a archive if
the crypt() function is not defined in the standard C library. It is
up to the Makefile to use this.
csh (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the csh program. After Configure runs,
the value is reset to a plain "csh" and is not useful.
--- 250,274 ----
It is primarily used by other Configure units that ask about
preprocessor symbols.
+ cppsymbols (Cppsym.U):
+ The variable contains the symbols defined by the C preprocessor
+ alone. The symbols defined by cc or by cc when it calls cpp are
+ not in this list, see ccsymbols and cppccsymbols.
+ The list is a space-separated list of symbol=value tokens.
+
+ cppccsymbols (Cppsym.U):
+ The variable contains the symbols defined by the C compiler when
+ when it calls cpp. The symbols defined by the cc alone or cpp
+ alone are not in this list, see ccsymbols and cppsymbols.
+ The list is a space-separated list of symbol=value tokens.
+
cryptlib (d_crypt.U):
This variable holds -lcrypt or the path to a libcrypt.a archive if
the crypt() function is not defined in the standard C library. It is
up to the Makefile to use this.
csh (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the csh program. After Configure runs,
the value is reset to a plain "csh" and is not useful.
***************
*** 477,482 ****
--- 495,508 ----
This variable conditionally defines HAS_FSETPOS if fsetpos() is
available to set the file position indicator.
+ d_fstatfs (d_statfs.U):
+ This variable conditionally defines the HAS_FSTATFS symbol, which
+ indicates to the C program that the fstatfs() routine is available.
+
+ d_fstatvfs (d_statvfs.U):
+ This variable conditionally defines the HAS_FSTATVFS symbol, which
+ indicates to the C program that the fstatvfs() routine is available.
+
d_ftime (d_ftime.U):
This variable conditionally defines the HAS_FTIME symbol, which indicates
that the ftime() routine exists. The ftime() routine is basically
***************
*** 522,527 ****
--- 548,558 ----
indicates to the C program that the getlogin() routine is available
to get the login name.
+ d_getmntent (d_getmntent.U):
+ This variable conditionally defines the HAS_GETMNTENT symbol, which
+ indicates to the C program that the getmntent() routine is available
+ to iterate through mounted files.
+
d_getnbyaddr (d_getnbyad.U):
This variable conditionally defines the HAS_GETNETBYADDR symbol, which
indicates to the C program that the getnetbyaddr() routine is available
***************
*** 626,631 ****
--- 657,667 ----
This variable conditionally defines GRPASSWD, which indicates
that struct group in <grp.h> contains gr_passwd.
+ d_hasmntopt (d_hasmntopt.U):
+ This variable conditionally defines the HAS_HASMNTOPT symbol, which
+ indicates to the C program that the hasmntopt() routine is available
+ to query the mount options of file systems.
+
d_htonl (d_htonl.U):
This variable conditionally defines HAS_HTONL if htonl() and its
friends are available to do network order byte swapping.
***************
*** 1072,1077 ****
--- 1108,1123 ----
This variable conditionally defines USE_STAT_BLOCKS if this system
has a stat structure declaring st_blksize and st_blocks.
+ d_statfsflags (d_statfs.U):
+ This variable conditionally defines the HAS_STRUCT_STATFS_FLAGS
+ symbol, which indicates to struct statfs from has f_flags member.
+ This kind of struct statfs is coming from sys/mount.h (BSD),
+ not from sys/statfs.h (SYSV).
+
+ d_statvfs (d_statvfs.U):
+ This variable conditionally defines the HAS_STATVFS symbol, which
+ indicates to the C program that the statvfs() routine is available.
+
d_stdio_cnt_lval (d_stdstdio.U):
This variable conditionally defines STDIO_CNT_LVALUE if the
FILE_cnt macro can be used as an lvalue.
***************
*** 1260,1266 ****
the C program that it runs under Xenix.
date (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the date program. After Configure runs,
the value is reset to a plain "date" and is not useful.
--- 1306,1312 ----
the C program that it runs under Xenix.
date (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the date program. After Configure runs,
the value is reset to a plain "date" and is not useful.
***************
*** 1307,1318 ****
See trnl.U
echo (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the echo program. After Configure runs,
the value is reset to a plain "echo" and is not useful.
egrep (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the egrep program. After Configure runs,
the value is reset to a plain "egrep" and is not useful.
--- 1353,1364 ----
See trnl.U
echo (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the echo program. After Configure runs,
the value is reset to a plain "echo" and is not useful.
egrep (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the egrep program. After Configure runs,
the value is reset to a plain "egrep" and is not useful.
***************
*** 1329,1335 ****
This is an old synonym for _exe.
expr (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the expr program. After Configure runs,
the value is reset to a plain "expr" and is not useful.
--- 1375,1381 ----
This is an old synonym for _exe.
expr (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the expr program. After Configure runs,
the value is reset to a plain "expr" and is not useful.
***************
*** 1340,1346 ****
is available.
find (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the find program. After Configure runs,
the value is reset to a plain "find" and is not useful.
--- 1386,1392 ----
is available.
find (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the find program. After Configure runs,
the value is reset to a plain "find" and is not useful.
***************
*** 1362,1367 ****
--- 1408,1418 ----
This variable contains the return type of free(). It is usually
void, but occasionally int.
+ full_ar (Loc_ar.U):
+ This variable contains the full pathname to 'ar', whether or
+ not the user has specified 'portability'. This is only used
+ in the Makefile.SH.
+
full_csh (d_csh.U):
This variable contains the full pathname to 'csh', whether or
not the user has specified 'portability'. This is only used
***************
*** 1387,1393 ****
of getgid(). Typically, it is the type of group ids in the kernel.
grep (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the grep program. After Configure runs,
the value is reset to a plain "grep" and is not useful.
--- 1438,1444 ----
of getgid(). Typically, it is the type of group ids in the kernel.
grep (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the grep program. After Configure runs,
the value is reset to a plain "grep" and is not useful.
***************
*** 1403,1409 ****
gidtype (gid_t), but sometimes it isn't.
gzip (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the gzip program. After Configure runs,
the value is reset to a plain "gzip" and is not useful.
--- 1454,1460 ----
gidtype (gid_t), but sometimes it isn't.
gzip (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the gzip program. After Configure runs,
the value is reset to a plain "gzip" and is not useful.
***************
*** 1489,1494 ****
--- 1540,1549 ----
This variable conditionally defines the I_LOCALE symbol,
and indicates whether a C program should include <locale.h>.
+ i_machcthr (i_machcthr.U):
+ This variable conditionally defines the I_MACH_CTHREADS symbol,
+ and indicates whether a C program should include <mach/cthreads.h>.
+
i_malloc (i_malloc.U):
This variable conditionally defines the I_MALLOC symbol, and indicates
whether a C program should include <malloc.h>.
***************
*** 1501,1506 ****
--- 1556,1565 ----
This variable conditionally defines the I_MEMORY symbol, and indicates
whether a C program should include <memory.h>.
+ i_mntent (i_mntent.U):
+ This variable conditionally defines the I_MNTENT symbol, and indicates
+ whether a C program should include <mntent.h>.
+
i_ndbm (i_ndbm.U):
This variable conditionally defines the I_NDBM symbol, which
indicates to the C program that <ndbm.h> exists and should
***************
*** 1580,1585 ****
--- 1639,1648 ----
indicates to the C program that <sys/ioctl.h> exists and should
be included.
+ i_sysmount (i_sysmount.U):
+ This variable conditionally defines the I_SYSMOUNT symbol,
+ and indicates whether a C program should include <sys/mount.h>.
+
i_sysndir (i_sysndir.U):
This variable conditionally defines the I_SYS_NDIR symbol, and indicates
whether a C program should include <sys/ndir.h>.
***************
*** 1606,1611 ****
--- 1669,1682 ----
This variable conditionally defines the I_SYS_STAT symbol,
and indicates whether a C program should include <sys/stat.h>.
+ i_sysstatfs (i_sysstatfs.U):
+ This variable conditionally defines the I_SYSSTATFS symbol,
+ and indicates whether a C program should include <sys/statfs.h>.
+
+ i_sysstatvfs (i_sysstatvfs.U):
+ This variable conditionally defines the I_SYSSTATVFS symbol,
+ and indicates whether a C program should include <sys/statvfs.h>.
+
i_systime (i_time.U):
This variable conditionally defines I_SYS_TIME, which indicates
to the C program that it should include <sys/time.h>.
***************
*** 1671,1676 ****
--- 1742,1752 ----
This variable conditionally defines the I_VFORK symbol, and indicates
whether a C program should include vfork.h.
+ ignore_versioned_solibs (libs.U):
+ This variable should be non-empty if non-versioned shared
+ libraries (libfoo.so.x.y) are to be ignored (because they
+ cannot be linked against).
+
incpath (usrinc.U):
This variable must preceed the normal include path to get hte
right one, as in "$incpath/usr/include" or "$incpath/usr/lib".
***************
*** 1722,1727 ****
--- 1798,1808 ----
those systems using AFS. For extra portability, only this variable
should be used in makefiles.
+ installusrbinperl (instubperl.U):
+ This variable tells whether Perl should be installed also as
+ /usr/bin/perl in addition to
+ $installbin/perl
+
intsize (intsize.U):
This variable contains the value of the INTSIZE symbol, which
indicates to the C program how many bytes there are in an int.
***************
*** 1756,1762 ****
the user. It is up to the Makefile to use this.
less (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the less program. After Configure runs,
the value is reset to a plain "less" and is not useful.
--- 1837,1843 ----
the user. It is up to the Makefile to use this.
less (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the less program. After Configure runs,
the value is reset to a plain "less" and is not useful.
***************
*** 1788,1794 ****
ahead of ucb or bsd libraries for SVR4.
line (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the line program. After Configure runs,
the value is reset to a plain "line" and is not useful.
--- 1869,1875 ----
ahead of ucb or bsd libraries for SVR4.
line (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the line program. After Configure runs,
the value is reset to a plain "line" and is not useful.
***************
*** 1801,1807 ****
the user. It is up to the Makefile to use this.
ln (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the ln program. After Configure runs,
the value is reset to a plain "ln" and is not useful.
--- 1882,1888 ----
the user. It is up to the Makefile to use this.
ln (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the ln program. After Configure runs,
the value is reset to a plain "ln" and is not useful.
***************
*** 1845,1851 ****
The value is a plain '' and is not useful.
ls (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the ls program. After Configure runs,
the value is reset to a plain "ls" and is not useful.
--- 1926,1932 ----
The value is a plain '' and is not useful.
ls (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the ls program. After Configure runs,
the value is reset to a plain "ls" and is not useful.
***************
*** 1863,1869 ****
The value is a plain '' and is not useful.
make (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the make program. After Configure runs,
the value is reset to a plain "make" and is not useful.
--- 1944,1950 ----
The value is a plain '' and is not useful.
make (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the make program. After Configure runs,
the value is reset to a plain "make" and is not useful.
***************
*** 1934,1940 ****
Possible values are "BSD 4.3" and "System V".
mkdir (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the mkdir program. After Configure runs,
the value is reset to a plain "mkdir" and is not useful.
--- 2015,2021 ----
Possible values are "BSD 4.3" and "System V".
mkdir (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the mkdir program. After Configure runs,
the value is reset to a plain "mkdir" and is not useful.
***************
*** 1949,1955 ****
modes for system calls.
more (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the more program. After Configure runs,
the value is reset to a plain "more" and is not useful.
--- 2030,2036 ----
modes for system calls.
more (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the more program. After Configure runs,
the value is reset to a plain "more" and is not useful.
***************
*** 2006,2012 ****
This is only useful if you have getnetbyaddr(), naturally.
nm (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the nm program. After Configure runs,
the value is reset to a plain "nm" and is not useful.
--- 2087,2093 ----
This is only useful if you have getnetbyaddr(), naturally.
nm (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the nm program. After Configure runs,
the value is reset to a plain "nm" and is not useful.
***************
*** 2026,2032 ****
in the package. All of them will be built.
nroff (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the nroff program. After Configure runs,
the value is reset to a plain "nroff" and is not useful.
--- 2107,2113 ----
in the package. All of them will be built.
nroff (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the nroff program. After Configure runs,
the value is reset to a plain "nroff" and is not useful.
***************
*** 2086,2092 ****
used to separate elements in the command shell search PATH.
perl (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the perl program. After Configure runs,
the value is reset to a plain "perl" and is not useful.
--- 2167,2173 ----
used to separate elements in the command shell search PATH.
perl (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the perl program. After Configure runs,
the value is reset to a plain "perl" and is not useful.
***************
*** 2099,2105 ****
shell scripts and in the "eval 'exec'" idiom.
pg (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the pg program. After Configure runs,
the value is reset to a plain "pg" and is not useful.
--- 2180,2186 ----
shell scripts and in the "eval 'exec'" idiom.
pg (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the pg program. After Configure runs,
the value is reset to a plain "pg" and is not useful.
***************
*** 2172,2178 ****
no data and an EOF.. Sigh!
rm (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the rm program. After Configure runs,
the value is reset to a plain "rm" and is not useful.
--- 2253,2259 ----
no data and an EOF.. Sigh!
rm (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the rm program. After Configure runs,
the value is reset to a plain "rm" and is not useful.
***************
*** 2197,2206 ****
at configuration time, for programs not wanting to bother with it.
sed (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the sed program. After Configure runs,
the value is reset to a plain "sed" and is not useful.
selecttype (selecttype.U):
This variable holds the type used for the 2nd, 3rd, and 4th
arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
--- 2278,2294 ----
at configuration time, for programs not wanting to bother with it.
sed (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the sed program. After Configure runs,
the value is reset to a plain "sed" and is not useful.
+ selectminbits (selectminbits.U):
+ This variable holds the minimum number of bits operated by select.
+ That is, if you do select(n, ...), how many bits at least will be
+ cleared in the masks if some activity is detected. Usually this
+ is either n or 32*ceil(n/32), especially many little-endians do
+ the latter. This is only useful if you have select(), naturally.
+
selecttype (selecttype.U):
This variable holds the type used for the 2nd, 3rd, and 4th
arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
***************
*** 2208,2214 ****
have select(), naturally.
sendmail (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the sendmail program. After Configure runs,
the value is reset to a plain "sendmail" and is not useful.
--- 2296,2302 ----
have select(), naturally.
sendmail (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the sendmail program. After Configure runs,
the value is reset to a plain "sendmail" and is not useful.
***************
*** 2277,2282 ****
--- 2365,2376 ----
the value of the signal listed in the same place within the
sig_name list.
+ sig_num_init (sig_name.U):
+ This variable holds the signal numbers, enclosed in double quotes and
+ separated by commas, suitable for use in the SIG_NUM definition
+ below. A "ZERO" is prepended to the list, and the list is
+ terminated with a plain 0.
+
signal_t (d_voidsig.U):
This variable holds the type of the signal handler (void or int).
***************
*** 2329,2335 ****
This variable has the names of any libraries needed for socket support.
sort (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the sort program. After Configure runs,
the value is reset to a plain "sort" and is not useful.
--- 2423,2429 ----
This variable has the names of any libraries needed for socket support.
sort (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the sort program. After Configure runs,
the value is reset to a plain "sort" and is not useful.
***************
*** 2440,2451 ****
The value is a plain '' and is not useful.
tee (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the tee program. After Configure runs,
the value is reset to a plain "tee" and is not useful.
test (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the test program. After Configure runs,
the value is reset to a plain "test" and is not useful.
--- 2534,2545 ----
The value is a plain '' and is not useful.
tee (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the tee program. After Configure runs,
the value is reset to a plain "tee" and is not useful.
test (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the test program. After Configure runs,
the value is reset to a plain "test" and is not useful.
***************
*** 2458,2469 ****
included). Anyway, the type Time_t should be used.
touch (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the touch program. After Configure runs,
the value is reset to a plain "touch" and is not useful.
tr (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the tr program. After Configure runs,
the value is reset to a plain "tr" and is not useful.
--- 2552,2563 ----
included). Anyway, the type Time_t should be used.
touch (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the touch program. After Configure runs,
the value is reset to a plain "touch" and is not useful.
tr (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the tr program. After Configure runs,
the value is reset to a plain "tr" and is not useful.
***************
*** 2482,2493 ****
ushort, or whatever type is used to declare user ids in the kernel.
uname (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the uname program. After Configure runs,
the value is reset to a plain "uname" and is not useful.
uniq (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the uniq program. After Configure runs,
the value is reset to a plain "uniq" and is not useful.
--- 2576,2587 ----
ushort, or whatever type is used to declare user ids in the kernel.
uname (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the uname program. After Configure runs,
the value is reset to a plain "uname" and is not useful.
uniq (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the uniq program. After Configure runs,
the value is reset to a plain "uniq" and is not useful.
***************
*** 2574,2580 ****
The value is a plain '' and is not useful.
zip (Loc.U):
! This variable is be used internally by Configure to determine the
full pathname (if any) of the zip program. After Configure runs,
the value is reset to a plain "zip" and is not useful.
--- 2668,2674 ----
The value is a plain '' and is not useful.
zip (Loc.U):
! This variable is used internally by Configure to determine the
full pathname (if any) of the zip program. After Configure runs,
the value is reset to a plain "zip" and is not useful.
diff -c 'perl5.005_02/Porting/patching.pod' 'perl5.005_03/Porting/patching.pod'
Index: ./Porting/patching.pod
*** ./Porting/patching.pod Thu Jul 23 22:59:34 1998
--- ./Porting/patching.pod Thu Jan 21 21:37:42 1999
***************
*** 10,16 ****
=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
to follow the instructions set forth in this document and
submit a patch 8-).
--- 10,16 ----
=head2 How to contribute to this document
You may mail corrections, additions, and suggestions to me
! 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,41 ****
--- 36,47 ----
=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,176 ****
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).
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.
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.
Test _all_ behaviors of a given operator, library, or function-
All optional arguments
Return values in various contexts (boolean, scalar, list, lvalue)
--- 165,183 ----
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 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.
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.
Test _all_ behaviors of a given operator, library, or function-
All optional arguments
Return values in various contexts (boolean, scalar, list, lvalue)
***************
*** 289,311 ****
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-)
=head1 Last Modified
! Last modified 21 May 1998 by Daniel Grisinger <dgris@perrin.dimensional.com>
=head1 Author and Copyright Information
--- 296,320 ----
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 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 January 1999
! Daniel Grisinger <dgris@dimensional.com>
=head1 Author and Copyright Information
***************
*** 314,319 ****
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.
-
-
-
--- 323,325 ----
diff -c 'perl5.005_02/Porting/pumpkin.pod' 'perl5.005_03/Porting/pumpkin.pod'
Index: ./Porting/pumpkin.pod
Prereq: 1.22
*** ./Porting/pumpkin.pod Thu Jul 23 22:59:35 1998
--- ./Porting/pumpkin.pod Thu Mar 4 18:34:07 1999
***************
*** 1178,1183 ****
--- 1178,1193 ----
back into the main distribution, but various parts of the perl
Configure/build/install process still assume src='.'.
+ =item Directory for vendor-supplied modules?
+
+ If a vendor supplies perl, but wants to leave $siteperl and $sitearch
+ for the local user to use, where should the vendor put vendor-supplied
+ modules (such as Tk.so?) If the vendor puts them in $archlib, then
+ they need to be updated each time the perl version is updated.
+ Perhaps we need a set of libries $vendorperl and $vendorarch that
+ track $apiversion (like the $sitexxx directories do) rather than
+ just $version (like the main perl directory).
+
=item Hint file fixes
Various hint files work around Configure problems. We ought to fix
diff -c 'perl5.005_02/README' 'perl5.005_03/README'
Index: ./README
*** ./README Thu Jul 23 22:59:35 1998
--- ./README Sat Mar 27 11:47:57 1999
***************
*** 1,7 ****
Perl Kit, Version 5.0
! Copyright 1989-1997, Larry Wall
All rights reserved.
This program is free software; you can redistribute it and/or modify
--- 1,7 ----
Perl Kit, Version 5.0
! Copyright 1989-1999, Larry Wall
All rights reserved.
This program is free software; you can redistribute it and/or modify
***************
*** 22,29 ****
Kit, in the file named "Artistic". If not, I'll be glad to provide one.
You should also have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
For those of you that choose to use the GNU General Public License,
my interpretation of the GNU General Public License is that no Perl
--- 22,29 ----
Kit, in the file named "Artistic". If not, I'll be glad to provide one.
You should also have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software Foundation,
! Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
For those of you that choose to use the GNU General Public License,
my interpretation of the GNU General Public License is that no Perl
diff -c /dev/null 'perl5.005_03/README.apollo'
Index: README.apollo
*** README.apollo Wed Dec 31 18:00:00 1969
--- README.apollo Wed Mar 17 18:05:55 1999
***************
*** 0 ****
--- 1,11 ----
+ The following tests are known to fail as of Perl 5.005_03:
+
+ comp/decl..........FAILED at test 0
+ op/write...........FAILED at test 0
+ lib/filefind.......FAILED at test 2
+ lib/io_udp.........FAILED at test 2
+ lib/findbin........stat(/ressel/ABT/USER/vta/jk/proj.local/perl/perl5.005_03-MAINT_TRIAL_5/t/lib/): No such file or directory at ../lib/FindBin.pm line 162
+ stat(/ressel/ABT/USER/vta/jk/proj.local/perl/perl5.005_03-MAINT_TRIAL_5/t/lib/): No such file or directory at ../lib/FindBin.pm line 163
+ FAILED at test 1
+
+ Johann Klasek <jk@auto.tuwien.ac.at>
diff -c 'perl5.005_02/README.beos' 'perl5.005_03/README.beos'
Index: ./README.beos
Prereq: 1.2
*** ./README.beos Thu Jul 23 22:59:35 1998
--- ./README.beos Thu Jan 28 21:19:54 1999
***************
*** 1,75 ****
- $Id: README.beos,v 1.2 1998/05/02 01:55:04 dogcow Exp dogcow $
-
Notes on building perl under BeOS:
GENERAL ISSUES
--------------
! perl will almost compile straight out of the box with ./Configure -d, but
! there are a few gotchas:
! Currently, you have to edit config.sh and remove SDBM_File from the
! dynamic_ext= and extensions= lines. SDBM_File does not build properly
! at this time. You need to run ./Configure -S after editing config.sh.
!
! In addition, with mwcc, after doing `make depend`, you need to edit
! makefile and x2p/makefile and remove the lines that mention 'Bletch:'.
! This is not necessary if you're using gnu cpp.
!
! in short:
! ./Configure -d
! remove SDBM_File from config.sh
! ./Configure -S
! make depend
! remove Bletch: from makefile and x2p/makefile
! make
! Other than that, perl should build without problems. There are some
! technical comments in hints/beos.sh.
! OS RELEASE-SPECIFIC NOTES
! -------------------------
! PR1/PPC:
! See R3/X86. Same bug, different form.
! PR2/PPC:
! Signals are somewhat unreliable, but they can work. Use caution.
! The POSIX module is still somewhat buggy.
!
! R3/X86:
! Under R3 x86, there are some serious problems with the math routines
! such that numbers are incorrectly printed. This causes problems with
! modules that encode their version numbers - in particular, IO.pm will
! probably not work properly. This should be fixed under R3.1.
!
! The problem has manifested itself if you see something similar to the
! following during the compile:
!
! cc -c -I/usr/local/include -O -DVERSION=\"1.1504\" -DXS_VERSION=\"1.1499999999\" -fpic -I../.. IO.c
! (lots of 9's are the indication of the problem.)
!
! In the meantime, you can use the following workaround:
!
! make perl
! cd ext/IO
! cc -c -I/usr/local/include -O -DVERSION=\"1.1504\" -DXS_VERSION=\"1.15\" -fpic -I../.. IO.c
! cd ..
! make
!
! (Substitute the correct numbers if IO has been updated.)
!
! R3/PPC-
! There's math problems, but of a different kind. In particular,
! perl -e 'print (240000 - (3e4<<3))' gives a non-zero answer.
! I'm looking into this. There is no workaround as yet. Hopefully,
! this will be fixed in R3.1.
CONTACT INFORMATION
-------------------
If you have comments, problem reports, or even patches or bugfixes (gasp!)
please email me.
! 1 May 1998
Tom Spindler
! dogcow@merit.edu
--- 1,43 ----
Notes on building perl under BeOS:
GENERAL ISSUES
--------------
! how to compile perl:
! To compile perl under BeOS R4 x86:
! `./Configure -d` and hit ^C when it asks you if you want to make changes
! to config.sh;
! edit config.sh and do the following:
! change d_socket='define' to ='undef';
! remove SDBM, Errno, and Socket from dynamic_ext= and nonxs_ext=;
!
! add '#define bool short' to x2p/a2p.h;
! ../Configure -S; make; make install
! cd ~/config/lib; ln -s 5.00502/BeOS-BePC/CORE/libperl.so .
! (substitute 5.00502 with the appropriate filename)
!
! OS RELEASE-SPECIFIC NOTES
! -------------------------
! R4 x86 - dynamic loading finally works! Yay! This means you can compile
! your own modules into perl. However, Sockets and Errno still don't work.
! (Hopefully, sockets will at least work by R5, if not sooner.)
!
! R4 PPC - I have not tested this. I rather severely doubt that dynamic
! loading will work. (My BeBox is in pieces right now, following a nasty
! disk crash.) You may have to disable dynamic loading to get the thing
! to compile at all. (use `./Configure` without -d, and say 'no' to
! 'Build a shared libperl.so'.)
CONTACT INFORMATION
-------------------
If you have comments, problem reports, or even patches or bugfixes (gasp!)
please email me.
! 28 Jan 1999
Tom Spindler
! dogcow@isi.net
diff -c /dev/null 'perl5.005_03/README.hpux'
Index: README.hpux
*** README.hpux Wed Dec 31 18:00:00 1969
--- README.hpux Thu Mar 4 18:34:08 1999
***************
*** 0 ****
--- 1,226 ----
+ If you read this file _as_is_, just ignore the funny characters you
+ see. It is written in the POD format (see pod/perlpod.pod) which is
+ specially designed to be readable as is.
+
+ =head1 NAME
+
+ README.hpux - Perl version 5 on Hewlett-Packard Unix (HP-UX) systems
+
+ =head1 DESCRIPTION
+
+ This document describes various features of HP's Unix operating system (HP-UX)
+ that will affect how Perl version 5 (hereafter just Perl) is compiled and/or
+ runs.
+
+ =head2 Compiling Perl 5 on HP-UX
+
+ When compiling Perl, the use of an ANSI C compiler is highly recommended.
+ The C compiler that ships with all HP-UX systems is a K&R compiler that
+ should only be used to build new kernels.
+
+ Perl can be compiled with either HP's ANSI C compiler or with gcc. The
+ former is recommended, as not only can it compile Perl with no difficulty,
+ but also can take advantage of features listed later that require the use
+ of HP compiler-specific command-line flags.
+
+ If you decide to use gcc, make sure your installation is recent and complete,
+ and be sure to read the Perl README file for more gcc-specific details.
+
+ =head2 PA-RISC
+
+ HP's current Unix systems run on its own Precision Architecture (PA-RISC) chip.
+ HP-UX used to run on the Motorola MC68000 family of chips, but any machine with
+ this chip in it is quite obsolete and this document will not attempt to address
+ issues for compiling Perl on the Motorola chipset.
+
+ The most recent version of PA-RISC at the time of this document's last update
+ is 2.0.
+
+ =head2 PA-RISC 1.0
+
+ The original version of PA-RISC, HP no longer sells any system with this chip.
+
+ The following systems contain PA-RISC 1.0 chips:
+
+ 600, 635, 645, 800, 808, 815, 822, 825, 832, 834, 835, 840,
+ 842, 845, 850, 852, 855, 860, 865, 870, 890
+
+ =head2 PA-RISC 1.1
+
+ An upgrade to the PA-RISC design, it shipped for many years in many different
+ system.
+
+ The following systems contain with PA-RISC 1.1 chips:
+
+ 705, 710, 712, 715, 720, 722, 725, 728, 730, 735, 743, 745, 747, 750,
+ 755, 770, 807S, 817S, 827S, 837S, 847S, 857S, 867S, 877S, 887S, 897S,
+ D200, D210, D220, D230, D250, D260, D310, D320, D330, D350, D360, D400,
+ E25, E35, E45, E55, F10, F20, F30, G30, G40, G50, G60, G70, H30, H40,
+ H50, H60, H70, I30, I40, I50, I60, I70, K100, K200, K210, K220, K400,
+ K410, K420, T500, T520
+
+
+ =head2 PA-RISC 2.0
+
+ The most recent upgrade to the PA-RISC design, it added support for 64-bit
+ integer data.
+
+ The following systems contain PA-RISC 2.0 chips (this is very likely to be
+ out of date):
+
+ D270, D280, D370, D380, K250, K260, K370, K380, K450, K460, K570, K580,
+ T600, V2200
+
+ A complete list of models at the time the OS was built is in the file
+ /opt/langtools/lib/sched.models.
+ The first column corresponds to the output of the "uname -m" command
+ (without the leading "9000/").
+ The second column is the PA-RISC version
+ and the third column is the exact chip type used.
+
+ =head2 Portability Between PA-RISC Versions
+
+ An executable compiled on a PA-RISC 2.0 platform will not execute on a
+ PA-RISC 1.1 platform, even if they are running the same version of HP-UX.
+ If you are building Perl on a PA-RISC 2.0 platform and want that Perl to
+ to also run on a PA-RISC 1.1, the compiler flags +DAportable and +DS32
+ should be used.
+
+ It is no longer possible to compile PA-RISC 1.0 executables on either the
+ PA-RISC 1.1 or 2.0 platforms.
+
+ =head2 Building Dynamic Extensions on HP-UX
+
+ HP-UX supports dynamically loadable libraries (shared libraries).
+ Shared libraries end with the suffix .sl.
+
+ Shared libraries created on a platform using a particular PA-RISC version
+ are not usable on platforms using an earlier PA-RISC version by default.
+ However, this backwards compatibility may be enabled using the same
+ +DAportable compiler flag (with the same PA-RISC 1.0 caveat mentioned above).
+
+ To create a shared library, the following steps must be performed:
+
+ 1. Compile source modules with +z or +Z flag to create a .o module
+ which contains Position-Independent Code (PIC). The linker will
+ tell you in the next step if +Z was needed.
+
+ 2. Link the shared library using the -b flag. If the code calls
+ any functions in other system libraries (e.g., libm), it must
+ be included on this line.
+
+ (Note that these steps are usually handled automatically by the extension's
+ Makefile).
+
+ If these dependent libraries are not listed at shared library creation
+ time, you will get fatal "Unresolved symbol" errors at run time when the
+ library is loaded.
+
+ You may create a shared library that referers to another library, which
+ may be either an archive library or a shared library. If it is a
+ shared library, this is called a "dependent library".
+ The dependent library's name is recorded in the main shared library,
+ but it is not linked into the shared library.
+ Instead, it is loaded when the main shared library is loaded.
+
+ If the referred library is an archive library, then it is treated as a
+ simple collection of .o modules (all of which must contain PIC). These
+ modules are then linked into the shared library.
+
+ Note that it is okay to create a library which contains a dependent library
+ that is already linked into perl.
+
+ It is no longer possible to link PA-RISC 1.0 shared libraries.
+
+ =head2 The HP ANSI C Compiler
+
+ When using this compiler to build Perl, you should make sure that
+ the flag -Aa is added to the cpprun and cppstdin variables in the
+ config.sh file.
+
+ =head2 Using Large Files with Perl
+
+ Beginning with HP-UX version 10.20, files larger than 2GB (2^31) may be
+ created and manipulated.
+ Three separate methods of doing this are available.
+ Of these methods,
+ the best method for Perl is to compile using the -D_FILE_OFFSET_BITS=64
+ compiler flag.
+ This causes Perl to be compiled using structures and functions in which
+ these are 64 bits wide, rather than 32 bits wide.
+
+ There are only two drawbacks to this approach:
+ the first is that the seek and tell functions (both the builtin version
+ and the POSIX module's version) will not correctly
+ function for these large files
+ (the offset arguments in seek and tell are implemented as type long).
+ The second is that any extension which calls any file-manipulating C function
+ will need to be recompiled using the above-mentioned -D_FILE_OFFSET_BITS=64
+ flag.
+ The list of functions that will need to recompiled is:
+ creat, fgetpos, fopen,
+ freopen, fsetpos, fstat,
+ fstatvfs, fstatvfsdev, ftruncate,
+ ftw, lockf, lseek,
+ lstat, mmap, nftw,
+ open, prealloc, stat,
+ statvfs, statvfsdev, tmpfile,
+ truncate, getrlimit, setrlimit
+
+ =head2 Threaded Perl
+
+ It is impossible to compile a version of threaded Perl on any version of
+ HP-UX before 10.30, and it is strongly suggested that you be running on
+ HP-UX 11.00 at least.
+
+ To compile Perl with thread, add -Dusethreads to the arguments of Configure.
+ Ensure that the -D_POSIX_C_SOURCE=199506L compiler flag is automatically
+ added to the list of flags. Also make sure that -lpthread is listed before
+ -lc in the list of libraries to link Perl with.
+
+ As of the date of this document, Perl threads are not fully supported on HP-UX.
+
+ =head2 64-bit Perl
+
+ Beginning with HP-UX 11.00, programs compiled under HP-UX can take advantage
+ of the LP64 programming environment (LP64 means Longs and Pointers are 64 bits
+ wide).
+
+ Work is being performed on Perl to make it 64-bit compliant on all versions
+ of Unix. Once this is complete, scalar variables will be able to hold
+ numbers larger than 2^32 with complete precision.
+
+ As of the date of this document, Perl is not 64-bit compliant on HP-UX.
+
+ Should a user wish to experiment with compiling Perl in the LP64 environment,
+ the following steps must be taken: libraries must be searched only within
+ /lib/pa20_64, the compiler flag +DD64 must be used, and the C library is
+ now located at /lib/pa20_64/libc.sl.
+
+ On the brighter side, the large file problem goes away, as longs are now
+ 64 bits wide.
+
+ =head2 GDBM and Threads
+
+ If you attempt to compile Perl with threads on an 11.X system and also link
+ in the GDBM library, then Perl will immediately core dump when it starts up.
+ The only workaround at this point is to relink the GDBM library under 11.X,
+ then relink it into Perl.
+
+ =head2 NFS filesystems and utime(2)
+
+ If you are compiling Perl on a remotely-mounted NFS filesystem, the test
+ io/fs.t may fail on test #18.
+ This appears to be a bug in HP-UX and no fix is currently available.
+
+ =head1 AUTHOR
+
+ Jeff Okamoto <okamoto@corp.hp.com>
+
+ With much assistance regarding shared libraries from Marc Sabatella.
+
+ =head1 DATE
+
+ Version 0.2: 1999/03/01
+
+ =cut
diff -c /dev/null 'perl5.005_03/README.hurd'
Index: README.hurd
*** README.hurd Wed Dec 31 18:00:00 1969
--- README.hurd Sun Mar 14 15:01:09 1999
***************
*** 0 ****
--- 1,40 ----
+ Notes on Perl on the Hurd
+ Last Updated: Sat, 6 Mar 1999 16:07:59 +0100
+ Written by: Mark Kettenis <kettenis@gnu.org>
+
+ If you want to use Perl on the Hurd, I recommend using the Debian
+ GNU/Hurd distribution (see http://www.debian.org), even if an
+ official, stable release has not yet been made. The old `gnu-0.2'
+ binary distribution will most certainly have additional problems.
+
+ * Known Problems
+
+ The Perl testsuite may still report some errors on the Hurd. The
+ `lib/anydbm.t' and `op/stat.t' tests will most certainly fail. The
+ first fails because Berkeley DB 2 does not allow empty keys and the
+ test tries to use them anyway. This is not really a Hurd bug. The
+ same test fails on Linux with version 2.1 of the GNU C Library. The
+ second failure is caused by a bug in the Hurd's filesystem servers,
+ that we have not been able to fix yet. I don't think it is crucial.
+
+ The socket tests may fail if the network is not configured. You have
+ to make `/hurd/pfinet' the translator for `/servers/socket/2', giving
+ it the right arguments. Try `/hurd/pfinet --help' for more
+ information.
+
+ Here are the statistics for Perl 5.005_03 on my system:
+
+ Failed Test Status Wstat Total Fail Failed List of failed
+ -------------------------------------------------------------------------------
+ lib/anydbm.t 12 1 8.33% 12
+ op/stat.t 58 1 1.72% 4
+ 5 tests skipped, plus 14 subtests skipped.
+ Failed 2/189 test scripts, 98.94% okay. 2/6669 subtests failed, 99.97% okay.
+
+ There are quite a few systems out there that do worse!
+
+ However, since I am running a very recent Hurd snapshot, in which a lot of
+ bugs that were exposed by the Perl testsuite have been fixed, you may
+ encounter more failures. Likely candidates are: `lib/io_pipe.t',
+ `lib/io_sock.t', `lib/io_udp.t' and `lib/time.t'.
+
diff -c /dev/null 'perl5.005_03/README.mint'
Index: README.mint
*** README.mint Wed Dec 31 18:00:00 1969
--- README.mint Thu Jan 28 19:13:32 1999
***************
*** 0 ****
--- 1,222 ----
+ ##########################################################################
+ # *** README.mint
+ ##########################################################################
+
+ If you want to build perl yourself on MiNT (or maybe on an Atari without
+ MiNT) you may want to accept some advice from somebody who already did it...
+
+ There was a perl port for Atari ST done by ++jrb bammi@cadence.com.
+ This port tried very hard to build on non-MiNT-systems. For the
+ sake of efficiency I've left this way. Yet, I haven't removed bammi's
+ patches but left them intact. Unfortunately some of the files that
+ bammi contributed to the perl distribution seem to have vanished?
+
+ So, how can you distinguish my patches from bammi's patches? All of
+ bammi's stuff is embedded in "#ifdef atarist" preprocessor macros.
+ My MiNT port uses "#ifdef __MINT__" instead (and unconditionally
+ undefines "atarist". If you want to continue on bammi's port, all
+ you have to do is to swap the "-D" and "-U" switches for "__MINT__"
+ and "atarist" in the variable ccflags.
+
+ However, I think that my version will still run on non-MiNT-systems
+ provided that the user has a Eunuchs-like environment (i.e. the
+ standard envariables like $PATH, $HOME, ... are set, there is a
+ POSIX compliant shell in /bin/sh, and...)
+
+ Known problems
+ ==============
+
+ The problems you may encounter when building perl on your machine
+ are most probably due to deficiencies in MiNT resp. the Atari
+ platform in general.
+
+ First of all, if you have less than 8 MB of RAM you shouldn't
+ even try to build Perl yourself. Better grab a binary pre-compiled
+ version somewhere. Even if you have more memory you should take
+ some care. Try to run in a fresh environment (without memory
+ fragmented too much) with as few daemons, accessories, xcontrol
+ modules etc. as possible. If you run some AES you should
+ consider to start a console based environment instead.
+
+ A problem has been reported with sed. Sed is used to create
+ some configuration files based on the answers you have given
+ to the Configure script. Unfortunately the Perl Configure script
+ shows sed on MiNT its limits. I have sed 2.05 with a stacksize
+ of 64k and I have encountered no problems. If sed crashes
+ during your configuration process you should first try to
+ augment sed's stacksize:
+
+ fixstk 64k /usr/bin/sed
+
+ (or similar). If it still doesn't help you may have a look
+ which other versions of sed are installed on your system.
+ If you have a KGMD 1.0 installation you will find three
+ in /usr/bin. Have a look there.
+
+ Perl has some "mammut" C files. If gcc reports "internal
+ compiler error: program cc1 got fatal signal 10" this is very
+ likely due to a stack overflow in program cc1. Find cc1
+ and fix its stack. I have made good experiences with
+
+ fixstk 2 cc1
+
+ This doesn't establish a stack of 2 Bytes only as you might
+ think. It really reserves one half of the available memory
+ for cc1's stack. A setting of 1 would reserve the entire
+ memory for cc1, 3 would reserve three thirds. You will have
+ to find out the value that suits to your system yourself.
+
+ BTW, cc1 is maybe a little hard to find. It is generally installed
+ as
+ /usr/local/lib/gcc-lib/<platform>/<gcc-version>/cc1
+
+ where <platform> is probably something like "m68k-atari-mint"
+ and <version> is the gcc version you use (find out with
+ "gcc --version"). Maybe "gcc-lib" is not installed in
+ "/usr/local/lib" but "/usr/lib" on your system.
+
+ Now run make (maybe "make -k"). If you get a fatal signal 10
+ increase cc1's stacksize, if you run out of memory you should
+ either decrease the stacksize or follow some more hints:
+
+ Perl's building process is very handy on machines with a lot
+ of virtual memory but may result in a desaster if you are short
+ of memory. If gcc fails to compile many source files you should
+ reduce the optimization. Grep for "optimize" in the file
+ config.sh and change the flags.
+
+ If only several huge files cause problems (actually it is not a
+ matter of the file size resp. the amount of code but depends on
+ the size of the individual funtions) it is useful to bypass
+ the make program and compile these files directly from the
+ command line. For example if you got something like the
+ following from make:
+
+ CCCMD = gcc -DPERL_CORE ....
+ ...
+ ...: virtual memory exhausted
+
+ you should hack into the shell:
+
+ gcc -DPERL_CORE ... toke.c
+
+ Please note that you have to add the name of the source file
+ (here toke.c) at the end.
+
+ If none of this helps, you're helpless. Wait for a binary
+ release. If you have succeded you may encounter another problem
+ at the linking process. If gcc complains that it can't find
+ some libraries within the perl distribution you probably have
+ an old linker. If it complains for example about "file not
+ found for xxx.olb" you should cd into the directory in
+ question and
+
+ ln -s libxxx.a xxx.olb
+
+ This will fix the problem.
+
+ This version (5.00402) of perl has passed most of the tests on my system:
+
+ Failed Test Status Wstat Total Fail Failed List of failed
+ ------------------------------------------------------------------------------
+ io/pipe.t 10 2 20.00% 7, 9
+ io/tell.t 13 1 7.69% 12
+ lib/complex.t 762 13 1.71% 84-85, 248-251, 257, 272-273,
+ 371, 380, 419-420
+ lib/io_pipe.t 10 1 10.00% 9
+ lib/io_tell.t 13 1 7.69% 12
+ op/magic.t 30 2 6.67% 29-30
+ Failed 6/152 test scripts, 96.05% okay. 20/4359 subtests failed, 99.54% okay.
+
+ Pipes always cause problems with MiNT, it's actually a surprise that
+ most of the tests did work. I've got no idea why the "tell" test failed,
+ this shouldn't mean too big a problem however.
+
+ Most of the failures of lib/complex seem to be harmless, actually errors
+ far right to the decimal point... Two failures seem to be serious:
+ The sign of the results is reversed. I would say that this is due
+ to minor bugs in the portable math lib that I compiled perl with.
+
+ I haven't bothered very much to find the reason for the failures
+ with op/magic.t and op/stat.t. Maybe you'll find it out.
+
+ ##########################################################################
+
+ Another possible problem may arise from the implementation of the "pwd"
+ command. It happened to add a carriage return and newline to its output
+ no matter what the setting of $UNIXMODE is. This is quite annoying since many
+ library modules for perl take the output of pwd, chop off the
+ trailing newline character and then expect to see a valid path in
+ that. But the carriage return (last but second character!) isn't
+ chopped off. You can either try to patch all library modules (at
+ the price of performance for the extra transformation) or you can
+ use my version of pwd that doesn't suffer from this deficiency.
+
+ The fixed implementation is in the mint subdirectory. Running
+ "Configure" will attempt to build and install it if necessary
+ (hints/mint.sh will do this work) but you can build and install it
+ explicitly by:
+
+ cd mint
+ make install
+
+ This is the fastest solution.
+
+ Just in case you want to go the hard way: perl won't even build with a
+ broken pwd! You will have to fix the library modules
+ (ext/POSIX/POSIX.pm, lib/Cwd.pm, lib/pwd.pl) at last after building
+ miniperl.
+
+ A major nuisance of current MiNTLib versions is the implementation
+ of system() which is far from being POSIX compliant. A real system()
+ should fork and then exec /bin/sh with its argument as a command
+ line to the shell. The MiNTLib system() however doesn't expect
+ that every user has a POSIX shell in /bin/sh. It tries to work
+ around the problem by forking and exec'ing the first token in its argument
+ string. To get a little bit of compliance to POSIX system() it
+ tries to handle at least redirection ("<" or ">") on its own
+ behalf.
+
+ This isn't a good idea since many programs expect that they can
+ pass a command line to system() that exploits all features of a
+ POSIX shell. If you use the MiNTLib version of system() with
+ perl the Perl function system() will suffer from the same deficiencies.
+
+ You will find a fixed version of system() in the mint subdirectory.
+ You can easily insert this version into your system libc:
+
+ cd mint
+ make system.o
+ ar r /usr/lib/libc.a
+ ranlib /usr/lib/libc.a
+
+ If you are suspicious you should either back up your libc before
+ or extract the original system.o from your libc with
+ "ar x /usr/lib/libc.a system.o". You can then backup the system.o
+ module somewhere before you succeed.
+
+ Anything missing? Yep, I've almost forgotten...
+ No file in this distribution without a fine saying. Take this one:
+
+ "From a thief you should learn: (1) to work at night;
+ (2) if one cannot gain what one wants in one night to
+ try again the next night; (3) to love one's coworkers
+ just as thieves love each other; (4) to be willing to
+ risk one's life even for a little thing; (5) not to
+ attach too much value to things even though one has
+ risked one's life for them - just as a thief will resell
+ a stolen article for a fraction of its real value;
+ (6) to withstand all kinds of beatings and tortures
+ but to remain what you are; and (7) to believe your
+ work is worthwhile and not be willing to change it."
+
+ -- Rabbi Dov Baer, Maggid of Mezeritch
+
+ OK, this was my motto while working on Perl for MiNT, especially rule (1)...
+
+ Have fun with Perl!
+
+ Guido Flohr
+ --
+ mailto:gufl0000@stud.uni-sb.de
+ http://stud.uni-sb.de/~gufl0000
diff -c 'perl5.005_02/README.os390' 'perl5.005_03/README.os390'
Index: ./README.os390
*** ./README.os390 Sun Aug 2 00:15:06 1998
--- ./README.os390 Sun Mar 14 15:01:09 1999
***************
*** 1,12 ****
! This is a fully ported perl for OS/390 Release 3. It may work on
! other versions, but that's the one we've tested it on.
! If you've downloaded the binary distribution, it needs to be
! installed below /usr/local. Source code distributions have an
! automated `make install` step that means you do not need to extract
! the source code below /usr/local (though that is where it will be
! installed by default). You may need to worry about the networking
! configuration files discussed in the last bullet below.
Gunzip/gzip for OS/390 is discussed at:
--- 1,28 ----
! This document is written in pod format hence there are punctuation
! characters in in odd places. Do not worry, you've apparently got
! the ASCII->EBCDIC translation worked out correctly. You can read
! more about pod in pod/perlpod.pod or the short summary in the
! INSTALL file.
! =head1 NAME
!
! README.os390 - building and installing Perl for OS/390.
!
! =head1 SYNOPSIS
!
! This document will help you Configure, build, test and install Perl
! on OS/390 Unix System Services.
!
! =head1 DESCRIPTION
!
! This is a fully ported perl for OS/390 Release 3, 5 and 6.
! It may work on other versions, but those are the ones we've
! tested it on.
!
! You may need to carry out some system configuration tasks before
! running the Configure script for perl.
!
! =head2 Unpacking
Gunzip/gzip for OS/390 is discussed at:
***************
*** 16,52 ****
pax -o to=IBM-1047,from=ISO8859-1 -r < latest.tar
GNU make for OS/390, which may be required for the build of perl,
is available from:
http://www.mks.com/s390/gnu/index.htm
! Once you've unpacked the distribution, run Configure (see INSTALL for
! full discussion of the Configure options), and then run make, then
! "make test" then "make install" (this last step may require UID=0
! privileges)
!
! There is a "hints" file for os390 that specifies the correct values
! for most things. Some things to watch out for are
!
! - this port doesn't support dynamic loading. Although
! OS/390 has support for DLLs, there are some differences
! that cause problems for perl.
!
! - You may see a "WHOA THERE!!!" message for $d_shmatprototype
! it is OK to keep the recommended "define".
!
! - Don't turn on the compiler optimization flag "-O". There's
! a bug in either the optimizer or perl that causes perl to
! not work correctly when the optimizer is on.
!
! - Some of the configuration files in /etc used by the
! networking APIs are either missing or have the wrong
! names. In particular, make sure that there's either
! an /etc/resolv.conf or and /etc/hosts, so that
! gethostbyname() works, and make sure that the file
! /etc/proto has been renamed to /etc/protocol (NOT
! /etc/protocols, as used by other Unix systems).
When using perl on OS/390 please keep in mind that the EBCDIC and ASCII
character sets are different. Perl builtin functions that may behave
--- 32,114 ----
pax -o to=IBM-1047,from=ISO8859-1 -r < latest.tar
+ =head2 Setup and utilities
+
+ Be sure that your yacc installation is in place including any necessary
+ parser template files. If you have not already done so then be sure to:
+
+ cp /samples/yyparse.c /etc
+
+ This may also be a good time to ensure that your /etc/protocol file
+ and either your /etc/resolv.conf or /etc/hosts files are in place.
+
GNU make for OS/390, which may be required for the build of perl,
is available from:
http://www.mks.com/s390/gnu/index.htm
! =head2 Configure
!
! Once you've unpacked the distribution, run "sh Configure" (see INSTALL
! for a full discussion of the Configure options). There is a "hints" file
! for os390 that specifies the correct values for most things. Some things
! to watch out for include:
!
! =over 4
!
! =item *
!
! Some of the parser default template files in /samples are needed in /etc.
! In particular be sure that you at least copy /samples/yyparse.c to /etc
! before running perl's Configure. This step ensures successful extraction
! of EBCDIC versions of parser files such as perly.c.
!
! =item *
!
! This port doesn't support dynamic loading. Although
! OS/390 has support for DLLs, there are some differences
! that cause problems for perl.
!
! =item *
!
! You may see a "WHOA THERE!!!" message for $d_shmatprototype
! it is OK to keep the recommended "define".
!
! =item *
!
! Don't turn on the compiler optimization flag "-O". There's
! a bug in either the optimizer or perl that causes perl to
! not work correctly when the optimizer is on.
!
! =item *
!
! Some of the configuration files in /etc used by the
! networking APIs are either missing or have the wrong
! names. In particular, make sure that there's either
! an /etc/resolv.conf or and /etc/hosts, so that
! gethostbyname() works, and make sure that the file
! /etc/proto has been renamed to /etc/protocol (NOT
! /etc/protocols, as used by other Unix systems).
!
! =back
!
! =head2 Build, test, install
!
! Simply put:
!
! sh Configure
! make
! make test
!
! if everything looks ok then:
!
! make install
!
! this last step may or may not require UID=0 privileges depending
! on how you answered the questions that Configure asked and whether
! or not you have write access to the directories you specified.
!
! =head2 Usage Hints
When using perl on OS/390 please keep in mind that the EBCDIC and ASCII
character sets are different. Perl builtin functions that may behave
***************
*** 61,83 ****
for an example of how to use the "eval exec" trick to ask the shell to
have perl run your scripts for you.
! perl-mvs mailing list: The Perl Institute (http://www.perl.org/)
! maintains a mailing list of interest to all folks building and/or
using perl on EBCDIC platforms. To subscibe, send a message of:
subscribe perl-mvs
to majordomo@perl.org.
! Regression tests: as the 5.005 kit was was being assembled
! the following "failures" were known to appear on some machines
! during `make test` (mostly due to ASCII vs. EBCDIC conflicts),
! your results may differ:
!
! comp/cpp..........FAILED at test 0
! op/pack...........FAILED at test 58
! op/stat...........Out of memory!
! op/taint..........FAILED at test 73
! lib/errno.........FAILED at test 1
! lib/posix.........FAILED at test 19
! lib/searchdict....FAILED at test 1
--- 123,158 ----
for an example of how to use the "eval exec" trick to ask the shell to
have perl run your scripts for you.
! =head2 Extensions
!
! You can build xs based extensions to Perl for OS/390 but will need to
! follow the instructions in ExtUtils::MakeMaker for building statically
! linked perl binaries. In most cases people have reported better
! results with GNU make rather than the system's /bin/make.
!
! =head1 AUTHORS
!
! David Fiander and Peter Prymmer.
!
! =head1 SEE ALSO
!
! L<INSTALL>, L<perlport>, L<ExtUtils::MakeMaker>.
!
! =head2 Mailing list
!
! The Perl Institute (http://www.perl.org/) maintains a perl-mvs
! mailing list of interest to all folks building and/or
using perl on EBCDIC platforms. To subscibe, send a message of:
subscribe perl-mvs
to majordomo@perl.org.
! =head1 HISTORY
!
! This document was originally written by David Fiander for the 5.005
! release of Perl.
!
! This document was podified for the 5.005_03 release of perl 11 March 1999.
!
! =cut
diff -c 'perl5.005_02/README.threads' 'perl5.005_03/README.threads'
Index: ./README.threads
*** ./README.threads Sun Aug 2 18:30:17 1998
--- ./README.threads Thu Feb 11 18:05:41 1999
***************
*** 1,3 ****
--- 1,10 ----
+ NOTE
+
+ Threading is a highly experimental feature. There are still a
+ few race conditions that show up under high contention on SMP
+ machines. Internal implementation is still subject to changes.
+ It is not recommended for production use at this time.
+
Building
If you want to build with multi-threading support and you are
***************
*** 27,33 ****
POSIX.1c threads then read on. Additional information may be in
a platform-specific "hints" file in the hints/ subdirectory.
! Omit the -d from your ./Configure arguments. For example, use
./Configure -Dusethreads
--- 34,41 ----
POSIX.1c threads then read on. Additional information may be in
a platform-specific "hints" file in the hints/ subdirectory.
! On other platforms that use Configure to build perl, omit the -d
! from your ./Configure arguments. For example, use:
./Configure -Dusethreads
***************
*** 92,97 ****
--- 100,109 ----
Add -lc_r to libswanted
Change -lc in lddflags to be -lpthread -lc_r -lc
+ For Win32:
+ See README.win32, and the notes at the beginning of win32/Makefile
+ or win32/makefile.mk.
+
Now you can do a
make
***************
*** 147,157 ****
Bugs
* FAKE_THREADS should produce a working perl but the Thread
! extension won't build with it yet.
!
! * There's a known memory leak (curstack isn't freed at the end
! of each thread because it causes refcount problems that I
! haven't tracked down yet) and there are very probably others too.
* There may still be races where bugs show up under contention.
--- 159,166 ----
Bugs
* FAKE_THREADS should produce a working perl but the Thread
! extension won't build with it yet. (FAKE_THREADS has not been
! tested at all in recent times.)
* There may still be races where bugs show up under contention.
***************
*** 275,277 ****
--- 284,289 ----
Configure-related info updated 16 July 1998 by
Andy Dougherty <doughera@lafayette.edu>
+
+ Other minor updates 10 Feb 1999 by
+ Gurusamy Sarathy
diff -c 'perl5.005_02/README.vms' 'perl5.005_03/README.vms'
Index: ./README.vms
*** ./README.vms Sat Jul 25 21:28:39 1998
--- ./README.vms Wed Mar 3 20:35:30 1999
***************
*** 1,4 ****
! Last Revised 21-July-1998 by Dan Sugalski <sugalskd@ous.edu>
Originally by Charles Bailey <bailey@newman.upenn.edu>
* Important safety tip
--- 1,4 ----
! Last Revised 01-March-1999 by Dan Sugalski <sugalskd@ous.edu>
Originally by Charles Bailey <bailey@newman.upenn.edu>
* Important safety tip
***************
*** 31,37 ****
to lend a hand we'd love to have you. Join the Perl Porting Team Now!
The current sources and build procedures have been tested on a VAX using
! VaxC and Dec C, and on an AXP using Dec C. If you run into problems with
other compilers, please let us know.
There are issues with varions versions of Dec C, so if you're not running a
--- 31,37 ----
to lend a hand we'd love to have you. Join the Perl Porting Team Now!
The current sources and build procedures have been tested on a VAX using
! Dec C, and on an AXP using Dec C. If you run into problems with
other compilers, please let us know.
There are issues with varions versions of Dec C, so if you're not running a
***************
*** 41,53 ****
* Other required software
In addition to VMS, you'll need:
! 1) A C compiler. Dec C for AXP, or Dec C, or gcc for the VAX.
2) A make tool. Dec's MMS (v2.6 or later), or MadGoat's free MMS
analog MMK (available from ftp.madgoat.com/madgoat) both work
just fine. Gnu Make might work, but it's been so long since
anyone's tested it that we're not sure. MMK's free, though, so
go ahead and use that.
If you want to include socket support, you'll need a TCP stack and either
Dec C, or socket libraries. See the Socket Support topic for more details.
--- 41,78 ----
* Other required software
In addition to VMS, you'll need:
! 1) A C compiler. Dec C or gcc for AXP or the VAX.
2) A make tool. Dec's MMS (v2.6 or later), or MadGoat's free MMS
analog MMK (available from ftp.madgoat.com/madgoat) both work
just fine. Gnu Make might work, but it's been so long since
anyone's tested it that we're not sure. MMK's free, though, so
go ahead and use that.
+ You may also want to have on hand:
+ 1) UNZIP.EXE for VMS available from a number of web/ftp sites.
+ http://www.cdrom.com/pub/infozip/UnZip.html
+ http://www.openvms.digital.com/cd/INFO-ZIP/
+ ftp://ftp.digital.com/pub/VMS/
+ ftp://ftp.openvms.digital.com/
+ ftp://ftp.madgoat.com/madgoat/
+ ftp://ftp.wku.edu/vms/
+ 2) GUNZIP/GZIP.EXE for VMS available from a number of web/ftp sites.
+ http://www.fsf.org/order/ftp.html
+ ftp://ftp.uu.net/archive/systems/gnu/diffutils*.tar.gz
+ ftp://gatekeeper.dec.com/pub/GNU/diffutils*.tar.gz
+ ftp://ftp.gnu.org/pub/gnu/diffutils*.tar.gz
+ http://www.openvms.digital.com/cd/GZIP/
+ ftp://ftp.digital.com/pub/VMS/
+ 3) VMS TAR also available from a number of web/ftp sites.
+ ftp://ftp.lp.se/vms/
+ http://www.openvms.digital.com/cd/VMSTAR/
+ ftp://ftp.digital.com/pub/VMS/
+ Please note that UNZIP and GUNZIP are not the same thing (they work with
+ different formats). Most of the useful files from CPAN (the Comprehensive
+ Perl Archive Network) are in .tar.gz format (this includes copies of the
+ source code for perl as well as modules and scripts that you may wish to
+ add later) hence you probably want to have GUNZIP.EXE and VMSTAR.EXE on
+ your VMS machine.
If you want to include socket support, you'll need a TCP stack and either
Dec C, or socket libraries. See the Socket Support topic for more details.
***************
*** 81,88 ****
@CONFIGURE "-des"
! (note the quotes and case) will choose reasonable defaults. (It takes Dec C
! over Gnu C, Dec C sockets over SOCKETSHR sockets, and either over no sockets)
* Testing Perl
--- 106,114 ----
@CONFIGURE "-des"
! (note the quotation marks and case) will choose reasonable defaults. (It
! takes Dec C over Gnu C, Dec C sockets over SOCKETSHR sockets, and either
! over no sockets)
* Testing Perl
***************
*** 96,106 ****
Compile Command:
! $MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1")
Test Command:
! $MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1") test
MMS will run all the tests. This may take some time, as there are a lot of
tests. If any tests fail, there will be a note made on-screen. At the end
--- 122,132 ----
Compile Command:
! $MMS
Test Command:
! $MMS test
MMS will run all the tests. This may take some time, as there are a lot of
tests. If any tests fail, there will be a note made on-screen. At the end
***************
*** 109,115 ****
If any tests fail, it means something's wrong with Perl. If the test suite
hangs (some tests can take upwards of two or three minutes, or more if
! you're on an especially slow machine, depending on you machine speed, so
don't be hasty), then the test *after* the last one displayed failed. Don't
install Perl unless you're confident that you're OK. Regardless of how
confident you are, make a bug report to the VMSPerl mailing list.
--- 135,141 ----
If any tests fail, it means something's wrong with Perl. If the test suite
hangs (some tests can take upwards of two or three minutes, or more if
! you're on an especially slow machine, depending on your machine speed, so
don't be hasty), then the test *after* the last one displayed failed. Don't
install Perl unless you're confident that you're OK. Regardless of how
confident you are, make a bug report to the VMSPerl mailing list.
***************
*** 133,138 ****
--- 159,167 ----
Note that "-V" really is a capital V in double quotes. This will dump out a
couple of screens worth of config info, and can help us diagnose the problem.
+ If (and only if) that did not work then try enclosing the output of:
+
+ @[.vms]myconfig
* Cleaning up and starting fresh
***************
*** 142,152 ****
Compile Command:
! $MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1")
Cleanup Command:
! $MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1") realclean
If you don't do this, things may behave erratically. They might not, too,
so it's best to be sure and do it.
--- 171,181 ----
Compile Command:
! $MMS
Cleanup Command:
! $MMS realclean
If you don't do this, things may behave erratically. They might not, too,
so it's best to be sure and do it.
***************
*** 170,201 ****
If for some reason it complains about target INSTALL being up to date,
throw a /FORCE switch on the MMS or MMK command.
3) Either define the symbol PERL somewhere, such as
SYS$MANAGER:SYLOGIN.COM, to be "PERL :== $PERL_ROOT:[000000]PERL.EXE", or
install Perl into DCLTABLES.EXE (Check out the section "Installing Perl
into DCLTABLES" for more info), or put the image in a directory that's in
your DCL$PATH (if you're using VMS 6.2 or higher).
! 4) Optionally define the command PERLDOC as
! PERLDOC :== "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -T"
Note that if you wish to use most as a pager please see
! ftp://space.mit.edu/pub/davis/ for both most and slang.
! 5) Optionally define the command PERLBUG (the Perl bug report generator) as
! PERLBUG :== "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
! 6) Optionally define the command POD2MAN (Converts POD files to nroff
source suitable for converting to man pages. Also quiets complaints during
module builds) as
DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
! POD2MAN :== "$PERL_ROOT:[000000]PERL POD2MAN"
! 7) Optionally define the command POD2TEXT (Converts POD files to text,
which is required for perldoc -f to work properly) as
DEFINE/NOLOG POD2TEXT PERL_ROOT:[LIB.POD]POD2TEXT.COM
! POD2TEXT :== "$PERL_ROOT:[000000]PERL POD2TEXT"
In all these cases, if you've got PERL defined as a foreign command, you
can replace $PERL_ROOT:[000000]PERL with ''perl'. If you've installed perl
--- 199,239 ----
If for some reason it complains about target INSTALL being up to date,
throw a /FORCE switch on the MMS or MMK command.
+ The script [.VMS]PERL_SETUP.COM that is written by CONFIGURE.COM
+ will take care of most of the following:
+
3) Either define the symbol PERL somewhere, such as
SYS$MANAGER:SYLOGIN.COM, to be "PERL :== $PERL_ROOT:[000000]PERL.EXE", or
install Perl into DCLTABLES.EXE (Check out the section "Installing Perl
into DCLTABLES" for more info), or put the image in a directory that's in
your DCL$PATH (if you're using VMS 6.2 or higher).
! 4) Either define the logical name PERLSHR somewhere
! (such as in PERL_SETUP.COM) like so:
! DEFINE/NOLOG PERLSHR PERL_ROOT:[000000]PERLSHR.EXE
! or copy perl_root:[000000]perlshr.exe sys$share:.
!
! 5) Optionally define the command PERLDOC as
! PERLDOC == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -t"
Note that if you wish to use most as a pager please see
! ftp://space.mit.edu/pub/davis/ for both most and slang (or perhaps
! ftp://ftp.wku.edu/vms/narnia/most.zip ).
! 6) Optionally define the command PERLBUG (the Perl bug report generator) as
! PERLBUG == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
! 7) Optionally define the command POD2MAN (Converts POD files to nroff
source suitable for converting to man pages. Also quiets complaints during
module builds) as
DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
! POD2MAN == "$PERL_ROOT:[000000]PERL POD2MAN"
! 8) Optionally define the command POD2TEXT (Converts POD files to text,
which is required for perldoc -f to work properly) as
DEFINE/NOLOG POD2TEXT PERL_ROOT:[LIB.POD]POD2TEXT.COM
! POD2TEXT == "$PERL_ROOT:[000000]PERL POD2TEXT"
In all these cases, if you've got PERL defined as a foreign command, you
can replace $PERL_ROOT:[000000]PERL with ''perl'. If you've installed perl
***************
*** 233,252 ****
The one exception is the various *DIR install locations. Changing those
requires changes in genconfig.pl as well. Be really careful if you need to
! change these,a s they can cause some fairly subtle problems.
* Extra things in the Perl distribution
In addition to the standard stuff that gets installed, there are two
optional extensions, DCLSYM and STDIO, that are handy. Instructions for
these two modules are in [.VMS.EXT.DCLSYM] and [.VMS.EXT.STDIO],
! respectively.
* Socket Support
Perl includes a number of functions for IP sockets, which are available if
! you choose to compile Perl with socket support. (See the section Compiling
! Perl for more info on selecting a socket stack) Since IP networking is an
optional addition to VMS, there are several different IP stacks
available. How well integrated they are into the system depends on the
stack, your version of VMS, and the version of your C compiler.
--- 271,314 ----
The one exception is the various *DIR install locations. Changing those
requires changes in genconfig.pl as well. Be really careful if you need to
! change these, as they can cause some fairly subtle problems.
!
! * INSTALLing images
!
! On systems that are using perl quite a bit, and particularly those with
! minimal RAM, you can boost the performance of perl by INSTALLing it as
! a known image. PERLSHR.EXE is typically larger than 1500 blocks
! and that is a reasonably large amount of IO to load each time perl is
! invoked.
!
! INSTALL ADD PERLSHR/SHARE
!
! should be enough for PERLSHR.EXE (/share implies /header and /open),
! while /HEADER should do for PERL.EXE (perl.exe is not a shared image).
!
! If your code 'use's modules, check to see if there's an executable for
! them, too. In the base perl build, POSIX, IO, Fcntl, Opcode, SDBM_File,
! DCLsym, and Stdio all have shared images that can be installed /SHARE.
!
! How much of a win depends on your memory situation, but if you're firing
! off perl with any regularity (like more than once every 20 seconds or so)
! it's probably a win.
!
! While there is code in perl to remove privileges as it runs you are advised
! to NOT INSTALL PERL.EXE with PRIVs!
* Extra things in the Perl distribution
In addition to the standard stuff that gets installed, there are two
optional extensions, DCLSYM and STDIO, that are handy. Instructions for
these two modules are in [.VMS.EXT.DCLSYM] and [.VMS.EXT.STDIO],
! respectively. They are built automatically for versions of perl >= 5.005.
* Socket Support
Perl includes a number of functions for IP sockets, which are available if
! you choose to compile Perl with socket support (see the section Compiling
! Perl for more info on selecting a socket stack). Since IP networking is an
optional addition to VMS, there are several different IP stacks
available. How well integrated they are into the system depends on the
stack, your version of VMS, and the version of your C compiler.
***************
*** 272,278 ****
it. There's a script in PERL_ROOT:[UTILS], perlbug, that walks you through
the process of creating a bug report. This script includes details of your
installation, and is very handy. Completed bug reports should go to
! PERLBUG@PERL.COM.
* Gotchas to watch out for
--- 334,340 ----
it. There's a script in PERL_ROOT:[UTILS], perlbug, that walks you through
the process of creating a bug report. This script includes details of your
installation, and is very handy. Completed bug reports should go to
! perlbug@perl.com.
* Gotchas to watch out for
***************
*** 286,292 ****
$DEFINE/TRANS=(CONC,TERM) PERLSRC disk:[dir.dir.dir.perldir.]" (note the
trailing period) and $SET DEFAULT PERLSRC:[000000] before building. Perl
modules can be just as bad (or worse), so watch out for them, too. The
! configuration script will warn if it thinks you're too deep.
Finally, the third thing that bites people is leftover pieces from a failed
build. If things go wrong, make sure you do a "(MMK|MMS|make) realclean"
--- 348,355 ----
$DEFINE/TRANS=(CONC,TERM) PERLSRC disk:[dir.dir.dir.perldir.]" (note the
trailing period) and $SET DEFAULT PERLSRC:[000000] before building. Perl
modules can be just as bad (or worse), so watch out for them, too. The
! configuration script will warn if it thinks you're too deep (at least on
! versions of VMS prior to 7.2).
Finally, the third thing that bites people is leftover pieces from a failed
build. If things go wrong, make sure you do a "(MMK|MMS|make) realclean"
***************
*** 323,334 ****
The VMSPERL mailing list address is VMSPERL@NEWMAN.UPENN.EDU. Any mail
sent there gets echoed to all subscribers of the list.
! The Perl5-Porters list is for anyone involved in porting Perl to a
! platform. This includes you, if you want to participate. It's a high-volume
! list (60-100 messages a day during active development times), so be sure
! you want to be there. The subscription address is
! Perl5-Porters-request@perl.org. Send a message with just the word SUBSCRIBE
! in the body. The posting address is Perl5-Porters@perl.org.
* Acknowledgements
--- 386,395 ----
The VMSPERL mailing list address is VMSPERL@NEWMAN.UPENN.EDU. Any mail
sent there gets echoed to all subscribers of the list.
! To unsubscribe from VMSPERL send the message UNSUBSCRIBE VMSPERL to
! VMSPERL-REQUEST@NEWMAN.UPENN.EDU. Be sure to do so from the subscribed
! account that you are cancelling.
!
* Acknowledgements
***************
*** 348,363 ****
for the getredirection() code
Rich Salz <rsalz@bbn.com>
for readdir() and related routines
! Peter Prymmer <pvhp@lns62.lns.cornell.edu)
for extensive testing, as well as development work on
configuration and documentation for VMS Perl,
! Dan Sugalski <sugalsd@stargate.lbcc.cc.or.us>
for extensive contributions to recent version support,
development of VMS-specific extensions, and dissemination
of information about VMS Perl,
the Stanford Synchrotron Radiation Laboratory and the
Laboratory of Nuclear Studies at Cornell University for
! the the opportunity to test and develop for the AXP,
and to the entire VMSperl group for useful advice and suggestions. In
addition the perl5-porters deserve credit for their creativity and
willingness to work with the VMS newcomers. Finally, the greatest debt of
--- 409,424 ----
for the getredirection() code
Rich Salz <rsalz@bbn.com>
for readdir() and related routines
! Peter Prymmer <pvhp@forte.com> or <pvhp@lns62.lns.cornell.edu>
for extensive testing, as well as development work on
configuration and documentation for VMS Perl,
! Dan Sugalski <sugalskd@ous.edu>
for extensive contributions to recent version support,
development of VMS-specific extensions, and dissemination
of information about VMS Perl,
the Stanford Synchrotron Radiation Laboratory and the
Laboratory of Nuclear Studies at Cornell University for
! the opportunity to test and develop for the AXP,
and to the entire VMSperl group for useful advice and suggestions. In
addition the perl5-porters deserve credit for their creativity and
willingness to work with the VMS newcomers. Finally, the greatest debt of
diff -c /dev/null 'perl5.005_03/README.vos'
Index: README.vos
*** README.vos Wed Dec 31 18:00:00 1969
--- README.vos Thu Feb 11 18:05:42 1999
***************
*** 0 ****
--- 1,139 ----
+ Perl 5 README file for the Stratus VOS operating system.
+ Paul Green (Paul_Green@stratus.com)
+ February 4, 1999
+
+
+ Introduction
+ ------------
+ This is a port of Perl version 5, revision 005-03, to VOS. Perl
+ is a scripting or macro language that is popular on many
+ systems. See your local computer bookstore for a number of good
+ books on Perl.
+
+ Most of the Perl features should work on VOS. However, any
+ attempt by perl.pm to call the following unimplemented POSIX
+ functions will result in an error message and an immediate and
+ fatal call to the VOS debugger. They are "dup", "fork", and
+ "waitpid". The lack of these functions pretty much prevents you
+ from starting VOS commands and grabbing their output in perl.
+ The workaround is to run the commands outside of perl, then have
+ perl process the output file.
+
+
+ Compiling Perl 5 on VOS
+ -----------------------
+ Before you can build Perl 5 on VOS, you need to have or acquire the
+ following additional items.
+
+ 1. The VOS Standard C Compiler and Runtime, or the VOS Standard C
+ Cross-Compiler. This is a standard Stratus product.
+
+ 2. The VOS OS TCP/IP product set. While the necessary header
+ files are included with VOS POSIX.1, you still need the
+ appropriate object files in order to bind perl.pm. This is
+ a standard Stratus product.
+
+ 3. The VOS POSIX.1 environment. As of this writing, this is
+ available on the VOS FTP site. Login anonymously to
+ ftp.stratus.com and get the file
+ /pub/vos/alpha/posix.save.evf.gz in binary file-transfer
+ mode. Or use the Uniform Resource Locator (URL)
+ ftp://ftp.stratus.com/pub/vos/alpha/posix.save.evf.gz from
+ your web browser. This is not a standard Stratus product.
+
+ Instructions for unbundling this file are at
+ ftp://ftp.stratus.com/pub/vos/utility/utility.html.
+
+ To build perl 5, change to the "vos" subdirectory and type the
+ command "compile_perl -processor X", where X is the processor
+ type (mc68020, i80860, pa7100, pa8000) that you wish to use.
+
+
+ Installing Perl 5 on VOS
+ ------------------------
+ 1. Create the directory >system>ported>command_library.
+
+ 2. Copy the appropriate version of the perl program module to
+ this directory. For example, with your current directory
+ set to the top-level directory of Perl 5, to install the
+ executable program module for the Motorola 68K
+ architecture, enter:
+
+ !copy_file vos>obj>perl.pm >system>ported>command_library>*
+
+ (If you wish to use both Perl version 4 and Perl version 5,
+ you must give them different names; for example, perl.pm
+ and perl5.pm).
+
+ 3. Create the directory >system>ported>perl>lib.
+
+ 4. Copy all of the files and subdirectories from the lib
+ subdirectory into this new directory. For example, with
+ the current directory set to the top-level directory of the
+ perl distribution, enter:
+
+ !copy_dir lib >system>ported>perl>lib>5.005
+
+ 5. While there are currently no architecture-specific
+ extensions or modules distributed with perl, the following
+ directories can be used to hold such files:
+
+ >system>ported>perl>lib>5.005.68k
+ >system>ported>perl>lib>5.005.860
+ >system>ported>perl>lib>5.005.7100
+ >system>ported>perl>lib>5.005.8000
+
+ 6. Site-specific perl extensions and modules can be installed
+ in one of two places. Put architecture-independent files
+ into:
+
+ >system>ported>perl>lib>site>5.005
+
+ Put architecture-dependent files into one of the following
+ directories:
+
+ >system>ported>perl>lib>site>5.005.68k
+ >system>ported>perl>lib>site>5.005.860
+ >system>ported>perl>lib>site>5.005.7100
+ >system>ported>perl>lib>site>5.005.8000
+
+ 7. You can examine the @INC variable from within a perl program
+ to see the order in which Perl searches these directories.
+
+
+ Unimplemented Features
+ ----------------------
+ If Perl 5 attempts to call an unimplemented VOS POSIX.1 function,
+ it will print a fatal error message and enter the VOS debugger.
+ This error is not recoverable. See vos_dummies.c for a list of
+ the unimplemented POSIX.1 functions. To see what functions are
+ unimplemented and what the error message looks like, compile and
+ execute "test_vos_dummies.c".
+
+
+ Restrictions
+ ------------
+ This port of Perl version 5 to VOS prefers Unix-style,
+ slash-separated pathnames over VOS-style greater-than-separated
+ pathnames. VOS-style pathnames should work in most contexts, but
+ if you have trouble, replace all greater-than characters by slash
+ characters. Because the slash character is used as a pathname
+ delimiter, Perl cannot process VOS pathnames containing a slash
+ character in a directory or file name; these must be renamed.
+
+ This port of Perl also uses Unix-epoch date values internally.
+ As long as you are dealing with ASCII character string
+ representations of dates, this should not be an issue. The
+ supported epoch is January 1, 1980 to January 17, 2038.
+
+ See the file pod/perlport.pod for more information about the VOS
+ port of Perl.
+
+
+ Support Status
+ --------------
+ I'm offering this port "as is". You can ask me questions, but I
+ can't guarantee I'll be able to answer them; I don't know much
+ about Perl itself; I'm still learning that.
+
+ (end)
diff -c 'perl5.005_02/README.win32' 'perl5.005_03/README.win32'
Index: ./README.win32
*** ./README.win32 Fri Aug 7 22:57:52 1998
--- ./README.win32 Sun Mar 28 16:36:42 1999
***************
*** 47,53 ****
Borland C++ version 5.02 or later
Microsoft Visual C++ version 4.2 or later
! Mingw32 with EGCS version 1.0.2
Mingw32 with GCC version 2.8.1
The last two of these are high quality freeware compilers. Support
--- 47,53 ----
Borland C++ version 5.02 or later
Microsoft Visual C++ version 4.2 or later
! Mingw32 with EGCS versions 1.0.2, 1.1
Mingw32 with GCC version 2.8.1
The last two of these are high quality freeware compilers. Support
***************
*** 75,80 ****
--- 75,83 ----
The surest way to build it is on WindowsNT, using the cmd shell.
+ Make sure the path to the build directory does not contain spaces. The
+ build usually works in this circumstance, but some tests will fail.
+
=item Borland C++
If you are using the Borland compiler, you will need dmake, a freely
***************
*** 104,110 ****
=item Mingw32 with EGCS or GCC
! ECGS-1.0.2 binaries can be downloaded from:
ftp://ftp.xraylith.wisc.edu/pub/khan/gnu-win32/mingw32/
--- 107,113 ----
=item Mingw32 with EGCS or GCC
! ECGS binaries can be downloaded from:
ftp://ftp.xraylith.wisc.edu/pub/khan/gnu-win32/mingw32/
***************
*** 121,126 ****
--- 124,131 ----
above. You will need to set up a few environment variables (usually
run from a batch file).
+ You also need dmake. See L</"Borland C++"> above on how to get it.
+
=back
=head2 Building
***************
*** 146,152 ****
ActiveState Tool Corp.) PERL_OBJECT uses C++, and the binaries are
therefore incompatible with the regular C build. However, the
PERL_OBJECT build does provide something called the C-API, for linking
! it with extensions that won't compile under PERL_OBJECT. PERL_OBJECT
is not yet supported under GCC or EGCS. WARNING: Binaries built with
PERL_OBJECT enabled are B<not> compatible with binaries built without.
Perl installs PERL_OBJECT binaries under a distinct architecture name,
--- 151,162 ----
ActiveState Tool Corp.) PERL_OBJECT uses C++, and the binaries are
therefore incompatible with the regular C build. However, the
PERL_OBJECT build does provide something called the C-API, for linking
! it with extensions that won't compile under PERL_OBJECT. Using the C_API
! is typically requested through:
!
! perl Makefile.PL CAPI=TRUE
!
! PERL_OBJECT requires VC++ 5.0 (Service Pack 3 recommended) or later. It
is not yet supported under GCC or EGCS. WARNING: Binaries built with
PERL_OBJECT enabled are B<not> compatible with binaries built without.
Perl installs PERL_OBJECT binaries under a distinct architecture name,
***************
*** 184,189 ****
--- 194,203 ----
You will also have to make sure CCHOME points to wherever you installed
your compiler.
+ The default value for CCHOME in the makefiles for Visual C++
+ may not be correct for some versions. Make sure the default exists
+ and is valid.
+
Other options are explained in the makefiles. Be sure to read the
instructions carefully.
***************
*** 211,219 ****
themselves use the C Runtime heavily, or want to free() pointers
malloc()-ed by perl.
! You can avoid the perl95.exe problems completely if you use Borland
! C++ for building perl (perl95.exe is not needed and will not be built
! in that case).
=back
--- 225,233 ----
themselves use the C Runtime heavily, or want to free() pointers
malloc()-ed by perl.
! You can avoid the perl95.exe problems completely if you either enable
! USE_PERLCRT with Visual C++, or use Borland C++ for building perl. In
! those cases, perl95.exe is not needed and will not be built.
=back
***************
*** 223,239 ****
the testsuite (many tests will be skipped, and but no test should fail).
If some tests do fail, it may be because you are using a different command
! shell than the native "cmd.exe".
! If you used the Borland compiler, you may see a failure in op/taint.t
arising from the inability to find the Borland Runtime DLLs on the system
default path. You will need to copy the DLLs reported by the messages
from where Borland chose to install it, into the Windows system directory
(usually somewhere like C:\WINNT\SYSTEM32), and rerun the test.
The Visual C runtime apparently has a bug that causes posix.t to fail
! one it test#2. This usually happens only if you extracted the files in
! text mode.
Please report any other failures as described under L<BUGS AND CAVEATS>.
--- 237,257 ----
the testsuite (many tests will be skipped, and but no test should fail).
If some tests do fail, it may be because you are using a different command
! shell than the native "cmd.exe", or because you are building from a path
! that contains spaces. So don't do that.
! If you are running the tests from a emacs shell window, you may see
! failures in op/stat.t. Run "dmake test-notty" in that case.
!
! If you're using the Borland compiler, you may see a failure in op/taint.t
arising from the inability to find the Borland Runtime DLLs on the system
default path. You will need to copy the DLLs reported by the messages
from where Borland chose to install it, into the Windows system directory
(usually somewhere like C:\WINNT\SYSTEM32), and rerun the test.
The Visual C runtime apparently has a bug that causes posix.t to fail
! test#2. This usually happens only if you extracted the files in text
! mode. Enable the USE_PERLCRT option in the Makefile to fix this bug.
Please report any other failures as described under L<BUGS AND CAVEATS>.
***************
*** 248,254 ****
C<$INST_TOP\$VERSION\bin>, and C<$INST_TOP\$VERSION\bin\$ARCHNAME>.
For example:
! set PATH c:\perl\5.005\bin;c:\perl\5.005\bin\MSWin32-x6;%PATH%
=head2 Usage Hints
--- 266,272 ----
C<$INST_TOP\$VERSION\bin>, and C<$INST_TOP\$VERSION\bin\$ARCHNAME>.
For example:
! set PATH c:\perl\5.005\bin;c:\perl\5.005\bin\MSWin32-x86;%PATH%
=head2 Usage Hints
***************
*** 269,277 ****
You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
! Currently, Perl does not depend on the registry, but can look up
! values if you choose to put them there. [XXX add registry locations
! that perl looks at here.]
=item File Globbing
--- 287,307 ----
You can also control the shell that perl uses to run system() and
backtick commands via PERL5SHELL. See L<perlrun>.
! Perl does not depend on the registry, but it can look up certain default
! values if you choose to put them there. Perl attempts to read entries from
! C<HKEY_CURRENT_USER\Software\Perl> and C<HKEY_LOCAL_MACHINE\Software\Perl>.
! Entries in the former override entries in the latter. One or more of the
! following entries (of type REG_SZ or REG_EXPAND_SZ) may be set:
!
! lib-$] version-specific path to add to @INC
! lib path to add to @INC
! sitelib-$] version-specific path to add to @INC
! sitelib path to add to @INC
! PERL* fallback for all %ENV lookups that begin with "PERL"
!
! Note the C<$]> in the above is not literal. Substitute whatever version
! of perl you want to honor that entry, e.g. C<5.00502>. Paths must be
! separated with semicolons, as usual on win32.
=item File Globbing
***************
*** 378,386 ****
$MAKE test
$MAKE install
! where $MAKE stands for NMAKE or DMAKE. Some extensions may not
! provide a testsuite (so "$MAKE test" may not do anything, or fail),
! but most serious ones do.
If a module implements XSUBs, you will need one of the supported
C compilers. You must make sure you have set up the environment for
--- 408,441 ----
$MAKE test
$MAKE install
! where $MAKE is whatever 'make' program you have configured perl to
! use. Use "perl -V:make" to find out what this is. Some extensions
! may not provide a testsuite (so "$MAKE test" may not do anything, or
! fail), but most serious ones do.
!
! It is important that you use a supported 'make' program, and
! ensure Config.pm knows about it. If you don't have nmake, you can
! either get dmake from the location mentioned earlier, or get an
! old version of nmake reportedly available from:
!
! ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe
!
! Another option is to use the make written in Perl, available from
! CPAN:
!
! http://www.perl.com/CPAN/authors/id/NI-S/Make-0.03.tar.gz
!
! Note that MakeMaker actually emits makefiles with different syntax
! depending on what 'make' it thinks you are using. Therefore, it is
! important that one of the following values appears in Config.pm:
!
! make='nmake' # MakeMaker emits nmake syntax
! make='dmake' # MakeMaker emits dmake syntax
! any other value # MakeMaker emits generic make syntax
! (e.g GNU make, or Perl make)
!
! If the value doesn't match the 'make' program you want to use,
! edit Config.pm to fix it.
If a module implements XSUBs, you will need one of the supported
C compilers. You must make sure you have set up the environment for
***************
*** 461,467 ****
CPAN in source form, along with many added bugfixes, and with MakeMaker
support. This bundle is available at:
! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.12.zip
See the README in that distribution for building and installation
instructions. Look for later versions that may be available at the
--- 516,522 ----
CPAN in source form, along with many added bugfixes, and with MakeMaker
support. This bundle is available at:
! http://www.perl.com/CPAN/authors/id/GSAR/libwin32-0.14.zip
See the README in that distribution for building and installation
instructions. Look for later versions that may be available at the
***************
*** 693,699 ****
Borland support was added in 5.004_01 (Gurusamy Sarathy).
! Last updated: 12 July 1998
=cut
--- 748,758 ----
Borland support was added in 5.004_01 (Gurusamy Sarathy).
! GCC/mingw32 support was added in 5.005 (Nick Ing-Simmons).
!
! Support for PERL_OBJECT was added in 5.005 (ActiveState Tool Corp).
!
! Last updated: 18 January 1999
=cut
diff -c 'perl5.005_02/Todo' 'perl5.005_03/Todo'
Index: ./Todo
*** ./Todo Thu Jul 23 22:59:39 1998
--- ./Todo Thu Mar 4 18:34:09 1999
***************
*** 10,18 ****
lexperl
Bundled perl preprocessor
Use posix calls internally where possible
! gettimeofday
format BOTTOM
- -iprefix.
-i rename file only when successfully changed
All ARGV input should act like <>
report HANDLE [formats].
--- 10,17 ----
lexperl
Bundled perl preprocessor
Use posix calls internally where possible
! gettimeofday (possibly best left for a module?)
format BOTTOM
-i rename file only when successfully changed
All ARGV input should act like <>
report HANDLE [formats].
***************
*** 23,28 ****
--- 22,29 ----
lvalue functions
regression/sanity tests for suidperl
Full 64 bit support (i.e. "long long")
+ Generalise Errno way of extracting cpp symbols and use that in
+ Errno and Fcntl (ExtUtils::CppSymbol?)
Possible pragmas
debugger
diff -c 'perl5.005_02/Todo-5.005' 'perl5.005_03/Todo-5.005'
Index: ./Todo-5.005
*** ./Todo-5.005 Thu Jul 23 22:59:39 1998
--- ./Todo-5.005 Thu Mar 4 18:34:09 1999
***************
*** 1,26 ****
Multi-threading
$AUTOLOAD. Hmm.
- without USE_THREADS, change extern variable for dTHR
consistent semantics for exit/die in threads
SvREFCNT_dec(curstack) in threadstart() in Thread.xs
better support for externally created threads
Thread::Pool
- more Configure support
spot-check globals like statcache and global GVs for thread-safety
Compiler
auto-produce executable
typed lexicals should affect B::CC::load_pad
workarounds to help Win32
- $^C to track compiler/checker status
END blocks need saving in compiled output
_AUTOLOAD prodding
fix comppadlist (names in comppad_name can have fake SvCUR
from where newASSIGNOP steals the field)
Namespace cleanup
- symbol-space: "pl_" prefix for all global vars
- "Perl_" prefix for all functions
CPP-space: restrict what we export from headers
stop malloc()/free() pollution unless asked
header-space: move into CORE/perl/
--- 1,21 ----
***************
*** 28,36 ****
MULTIPLICITY support
complete work on safe recursive interpreters, C<Perl->new()>
!
! Configure
! installation layout changes to avoid overwriting old versions
Reliable Signals
alternate runops() for signal despatch
--- 23,29 ----
MULTIPLICITY support
complete work on safe recursive interpreters, C<Perl->new()>
! revisit extra implicit arg that provides curthread/curinterp context
Reliable Signals
alternate runops() for signal despatch
***************
*** 38,68 ****
add tests for Thread::Signal
Win32 stuff
- automate maintenance of most PERL_OBJECT code
get PERL_OBJECT building under gcc
rename new headers to be consistent with the rest
sort out the spawnvp() mess
work out DLL versioning
- put perlobject in $ARCHNAME so it can coexist with rest
- get PERL_OBJECT building on non-win32?
style-check
Miscellaneous
rename and alter ISA.pm
magic_setisa should be made to update %FIELDS [???]
! be generous in accepting foreign line terminations
! make filenames 8.3 friendly, where feasible
! upgrade to newer versions of all independently maintained modules
! add new modules (Data-Dumper, Storable?)
! test it with large parts of CPAN
fix pod2html to generate relative URLs
! Documentation
comprehensive perldelta.pod
describe new age patterns
update perl{guts,call,embed,xs} with additions, changes to API
document Win32 choices
- rework INSTALL to reflect changes in installation structure
spot-check all new modules for completeness
better docs for pack()/unpack()
! add perlport.pod
--- 31,61 ----
add tests for Thread::Signal
Win32 stuff
get PERL_OBJECT building under gcc
+ get PERL_OBJECT building on non-win32
+ automate generation of 'protected' prototypes for CPerlObj
rename new headers to be consistent with the rest
sort out the spawnvp() mess
work out DLL versioning
style-check
Miscellaneous
rename and alter ISA.pm
magic_setisa should be made to update %FIELDS [???]
! add new modules (Archive::Tar, Compress::Zlib, CPAN::FTP?)
fix pod2html to generate relative URLs
+ automate testing with large parts of CPAN
! Ongoing
! keep filenames 8.3 friendly, where feasible
! upgrade to newer versions of all independently maintained modules
comprehensive perldelta.pod
+
+ Documentation
describe new age patterns
update perl{guts,call,embed,xs} with additions, changes to API
document Win32 choices
spot-check all new modules for completeness
better docs for pack()/unpack()
! reorg tutorials vs. reference sections
!
diff -c 'perl5.005_02/XSUB.h' 'perl5.005_03/XSUB.h'
Index: ./XSUB.h
*** ./XSUB.h Thu Jul 23 22:59:39 1998
--- ./XSUB.h Wed Dec 30 10:58:42 1998
***************
*** 57,64 ****
#ifdef XS_VERSION
# define XS_VERSION_BOOTCHECK \
STMT_START { \
! SV *tmpsv; \
! char *vn = Nullch, *module = SvPV(ST(0),PL_na); \
if (items >= 2) /* version supplied as bootstrap arg */ \
tmpsv = ST(1); \
else { \
--- 57,64 ----
#ifdef XS_VERSION
# define XS_VERSION_BOOTCHECK \
STMT_START { \
! SV *tmpsv; STRLEN n_a; \
! char *vn = Nullch, *module = SvPV(ST(0),n_a); \
if (items >= 2) /* version supplied as bootstrap arg */ \
tmpsv = ST(1); \
else { \
***************
*** 69,75 ****
tmpsv = perl_get_sv(form("%s::%s", module, \
vn = "VERSION"), FALSE); \
} \
! if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, PL_na)))) \
croak("%s object version %s does not match %s%s%s%s %_", \
module, XS_VERSION, \
vn ? "$" : "", vn ? module : "", vn ? "::" : "", \
--- 69,75 ----
tmpsv = perl_get_sv(form("%s::%s", module, \
vn = "VERSION"), FALSE); \
} \
! if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \
croak("%s object version %s does not match %s%s%s%s %_", \
module, XS_VERSION, \
vn ? "$" : "", vn ? module : "", vn ? "::" : "", \
***************
*** 77,82 ****
--- 77,146 ----
} STMT_END
#else
# define XS_VERSION_BOOTCHECK
+ #endif
+
+ #ifdef PERL_CAPI
+ # define VTBL_sv get_vtbl(want_vtbl_sv)
+ # define VTBL_env get_vtbl(want_vtbl_env)
+ # define VTBL_envelem get_vtbl(want_vtbl_envelem)
+ # define VTBL_sig get_vtbl(want_vtbl_sig)
+ # define VTBL_sigelem get_vtbl(want_vtbl_sigelem)
+ # define VTBL_pack get_vtbl(want_vtbl_pack)
+ # define VTBL_packelem get_vtbl(want_vtbl_packelem)
+ # define VTBL_dbline get_vtbl(want_vtbl_dbline)
+ # define VTBL_isa get_vtbl(want_vtbl_isa)
+ # define VTBL_isaelem get_vtbl(want_vtbl_isaelem)
+ # define VTBL_arylen get_vtbl(want_vtbl_arylen)
+ # define VTBL_glob get_vtbl(want_vtbl_glob)
+ # define VTBL_mglob get_vtbl(want_vtbl_mglob)
+ # define VTBL_nkeys get_vtbl(want_vtbl_nkeys)
+ # define VTBL_taint get_vtbl(want_vtbl_taint)
+ # define VTBL_substr get_vtbl(want_vtbl_substr)
+ # define VTBL_vec get_vtbl(want_vtbl_vec)
+ # define VTBL_pos get_vtbl(want_vtbl_pos)
+ # define VTBL_bm get_vtbl(want_vtbl_bm)
+ # define VTBL_fm get_vtbl(want_vtbl_fm)
+ # define VTBL_uvar get_vtbl(want_vtbl_uvar)
+ # define VTBL_defelem get_vtbl(want_vtbl_defelem)
+ # define VTBL_regexp get_vtbl(want_vtbl_regexp)
+ # ifdef USE_LOCALE_COLLATE
+ # define VTBL_collxfrm get_vtbl(want_vtbl_collxfrm)
+ # endif
+ # ifdef OVERLOAD
+ # define VTBL_amagic get_vtbl(want_vtbl_amagic)
+ # define VTBL_amagicelem get_vtbl(want_vtbl_amagicelem)
+ # endif
+ #else
+ # define VTBL_sv &vtbl_sv
+ # define VTBL_env &vtbl_env
+ # define VTBL_envelem &vtbl_envelem
+ # define VTBL_sig &vtbl_sig
+ # define VTBL_sigelem &vtbl_sigelem
+ # define VTBL_pack &vtbl_pack
+ # define VTBL_packelem &vtbl_packelem
+ # define VTBL_dbline &vtbl_dbline
+ # define VTBL_isa &vtbl_isa
+ # define VTBL_isaelem &vtbl_isaelem
+ # define VTBL_arylen &vtbl_arylen
+ # define VTBL_glob &vtbl_glob
+ # define VTBL_mglob &vtbl_mglob
+ # define VTBL_nkeys &vtbl_nkeys
+ # define VTBL_taint &vtbl_taint
+ # define VTBL_substr &vtbl_substr
+ # define VTBL_vec &vtbl_vec
+ # define VTBL_pos &vtbl_pos
+ # define VTBL_bm &vtbl_bm
+ # define VTBL_fm &vtbl_fm
+ # define VTBL_uvar &vtbl_uvar
+ # define VTBL_defelem &vtbl_defelem
+ # define VTBL_regexp &vtbl_regexp
+ # ifdef USE_LOCALE_COLLATE
+ # define VTBL_collxfrm &vtbl_collxfrm
+ # endif
+ # ifdef OVERLOAD
+ # define VTBL_amagic &vtbl_amagic
+ # define VTBL_amagicelem &vtbl_amagicelem
+ # endif
#endif
#ifdef PERL_OBJECT
diff -c 'perl5.005_02/XSlock.h' 'perl5.005_03/XSlock.h'
Index: ./XSlock.h
*** ./XSlock.h Thu Jul 23 22:59:39 1998
--- ./XSlock.h Sun Mar 28 01:57:09 1999
***************
*** 13,35 ****
};
XSLockManager g_XSLock;
class XSLock
{
public:
! XSLock() { g_XSLock.Enter(); };
~XSLock() { g_XSLock.Leave(); };
};
! CPerlObj* pPerl;
!
#undef dXSARGS
#define dXSARGS \
! dSP; dMARK; \
! I32 ax = mark - PL_stack_base + 1; \
! I32 items = sp - mark; \
! XSLock localLock; \
! ::pPerl = pPerl
!
#endif
--- 13,38 ----
};
XSLockManager g_XSLock;
+ CPerlObj* pPerl;
class XSLock
{
public:
! XSLock(CPerlObj *p) {
! g_XSLock.Enter();
! ::pPerl = p;
! };
~XSLock() { g_XSLock.Leave(); };
};
! /* PERL_CAPI does its own locking in xs_handler() */
! #if defined(PERL_OBJECT) && !defined(PERL_CAPI)
#undef dXSARGS
#define dXSARGS \
! XSLock localLock(pPerl); \
! dSP; dMARK; \
! I32 ax = mark - PL_stack_base + 1; \
! I32 items = sp - mark
! #endif /* PERL_OBJECT && !PERL_CAPI */
#endif
diff -c /dev/null 'perl5.005_03/apollo/netinet/in.h'
Index: apollo/netinet/in.h
*** apollo/netinet/in.h Wed Dec 31 18:00:00 1969
--- apollo/netinet/in.h Wed Mar 17 18:05:56 1999
***************
*** 0 ****
--- 1,8 ----
+ /* Apollo's <netinet/in.h> isn't protected against multiple inclusion. */
+
+ #ifndef _NETINET_IN_INCLUDED
+ #define _NETINET_IN_INCLUDED
+
+ #include "/bsd4.3/usr/include/netinet/in.h"
+
+ #endif /* _NETINET_IN_INCLUDED */
diff -c 'perl5.005_02/av.c' 'perl5.005_03/av.c'
Index: ./av.c
*** ./av.c Thu Jul 23 22:59:39 1998
--- ./av.c Sat Mar 27 11:57:31 1999
***************
*** 1,6 ****
/* av.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* av.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 24,30 ****
if (AvREAL(av))
return;
#ifdef DEBUGGING
! if (SvRMAGICAL(av) && mg_find((SV*)av,'P'))
warn("av_reify called on tied array");
#endif
key = AvMAX(av) + 1;
--- 24,30 ----
if (AvREAL(av))
return;
#ifdef DEBUGGING
! if (SvTIED_mg((SV*)av, 'P'))
warn("av_reify called on tied array");
#endif
key = AvMAX(av) + 1;
***************
*** 41,46 ****
--- 41,47 ----
key = AvARRAY(av) - AvALLOC(av);
while (key)
AvALLOC(av)[--key] = &PL_sv_undef;
+ AvREIFY_off(av);
AvREAL_on(av);
}
***************
*** 49,62 ****
{
dTHR; /* only necessary if we have to extend stack */
MAGIC *mg;
! if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
dSP;
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
! PUSHs(mg->mg_obj);
PUSHs(sv_2mortal(newSViv(key+1)));
PUTBACK;
perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
--- 50,63 ----
{
dTHR; /* only necessary if we have to extend stack */
MAGIC *mg;
! if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
! PUSHs(SvTIED_obj((SV*)av, mg));
PUSHs(sv_2mortal(newSViv(key+1)));
PUTBACK;
perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
***************
*** 174,183 ****
if (key > AvFILLp(av)) {
if (!lval)
return 0;
! if (AvREALISH(av))
! sv = NEWSV(5,0);
! else
! sv = sv_newmortal();
return av_store(av,key,sv);
}
if (AvARRAY(av)[key] == &PL_sv_undef) {
--- 175,181 ----
if (key > AvFILLp(av)) {
if (!lval)
return 0;
! sv = NEWSV(5,0);
return av_store(av,key,sv);
}
if (AvARRAY(av)[key] == &PL_sv_undef) {
***************
*** 370,376 ****
/*SUPPRESS 560*/
/* Give any tie a chance to cleanup first */
! if (SvRMAGICAL(av) && mg_find((SV*)av,'P'))
av_fill(av, -1); /* mg_clear() ? */
if (AvREAL(av)) {
--- 368,374 ----
/*SUPPRESS 560*/
/* Give any tie a chance to cleanup first */
! if (SvTIED_mg((SV*)av, 'P'))
av_fill(av, -1); /* mg_clear() ? */
if (AvREAL(av)) {
***************
*** 397,408 ****
if (SvREADONLY(av))
croak(no_modify);
! if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
! PUSHs(mg->mg_obj);
PUSHs(val);
PUTBACK;
ENTER;
--- 395,406 ----
if (SvREADONLY(av))
croak(no_modify);
! if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
! PUSHs(SvTIED_obj((SV*)av, mg));
PUSHs(val);
PUTBACK;
ENTER;
***************
*** 424,434 ****
return &PL_sv_undef;
if (SvREADONLY(av))
croak(no_modify);
! if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
! XPUSHs(mg->mg_obj);
PUTBACK;
ENTER;
if (perl_call_method("POP", G_SCALAR)) {
--- 422,432 ----
return &PL_sv_undef;
if (SvREADONLY(av))
croak(no_modify);
! if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
! XPUSHs(SvTIED_obj((SV*)av, mg));
PUTBACK;
ENTER;
if (perl_call_method("POP", G_SCALAR)) {
***************
*** 459,470 ****
if (SvREADONLY(av))
croak(no_modify);
! if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,1+num);
! PUSHs(mg->mg_obj);
while (num-- > 0) {
PUSHs(&PL_sv_undef);
}
--- 457,468 ----
if (SvREADONLY(av))
croak(no_modify);
! if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,1+num);
! PUSHs(SvTIED_obj((SV*)av, mg));
while (num-- > 0) {
PUSHs(&PL_sv_undef);
}
***************
*** 510,520 ****
return &PL_sv_undef;
if (SvREADONLY(av))
croak(no_modify);
! if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
! XPUSHs(mg->mg_obj);
PUTBACK;
ENTER;
if (perl_call_method("SHIFT", G_SCALAR)) {
--- 508,518 ----
return &PL_sv_undef;
if (SvREADONLY(av))
croak(no_modify);
! if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
! XPUSHs(SvTIED_obj((SV*)av, mg));
PUTBACK;
ENTER;
if (perl_call_method("SHIFT", G_SCALAR)) {
***************
*** 551,564 ****
croak("panic: null array");
if (fill < 0)
fill = -1;
! if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
dSP;
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
! PUSHs(mg->mg_obj);
PUSHs(sv_2mortal(newSViv(fill+1)));
PUTBACK;
perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
--- 549,562 ----
croak("panic: null array");
if (fill < 0)
fill = -1;
! if (mg = SvTIED_mg((SV*)av, 'P')) {
dSP;
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,2);
! PUSHs(SvTIED_obj((SV*)av, mg));
PUSHs(sv_2mortal(newSViv(fill+1)));
PUTBACK;
perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
diff -c 'perl5.005_02/av.h' 'perl5.005_03/av.h'
Index: ./av.h
*** ./av.h Thu Jul 23 22:59:39 1998
--- ./av.h Sat Mar 27 11:47:28 1999
***************
*** 1,6 ****
/* av.h
*
! * Copyright (c) 1991-1998, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* av.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/bytecode.h' 'perl5.005_03/bytecode.h'
Index: ./bytecode.h
*** ./bytecode.h Thu Jul 23 22:59:39 1998
--- ./bytecode.h Wed Mar 3 20:35:30 1999
***************
*** 64,70 ****
BGET_U32(hi); \
BGET_U32(lo); \
if (sizeof(IV) == 8) \
! arg = (IV) (hi << (sizeof(IV)*4) | lo); \
else if (((I32)hi == -1 && (I32)lo < 0) \
|| ((I32)hi == 0 && (I32)lo >= 0)) { \
arg = (I32)lo; \
--- 64,70 ----
BGET_U32(hi); \
BGET_U32(lo); \
if (sizeof(IV) == 8) \
! arg = ((IV)hi << (sizeof(IV)*4) | lo); \
else if (((I32)hi == -1 && (I32)lo < 0) \
|| ((I32)hi == 0 && (I32)lo >= 0)) { \
arg = (I32)lo; \
diff -c 'perl5.005_02/cc_runtime.h' 'perl5.005_03/cc_runtime.h'
Index: ./cc_runtime.h
*** ./cc_runtime.h Thu Jul 23 22:59:40 1998
--- ./cc_runtime.h Fri Oct 30 21:55:12 1998
***************
*** 45,51 ****
case 0: \
PL_op = ppaddr(ARGS); \
PL_retstack[PL_retstack_ix - 1] = Nullop; \
! if (PL_op != nxt) runops(); \
JMPENV_POP; \
break; \
case 1: JMPENV_POP; JMPENV_JUMP(1); \
--- 45,51 ----
case 0: \
PL_op = ppaddr(ARGS); \
PL_retstack[PL_retstack_ix - 1] = Nullop; \
! if (PL_op != nxt) CALLRUNOPS(); \
JMPENV_POP; \
break; \
case 1: JMPENV_POP; JMPENV_JUMP(1); \
diff -c 'perl5.005_02/config_h.SH' 'perl5.005_03/config_h.SH'
Index: ./config_h.SH
Prereq: 3.0.1.5
*** ./config_h.SH Thu Jul 23 22:59:41 1998
--- ./config_h.SH Wed Mar 3 20:35:32 1999
***************
*** 239,244 ****
--- 239,292 ----
*/
#$d_fsetpos HAS_FSETPOS /**/
+ /* I_SYS_MOUNT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/mount.h>.
+ */
+ #$i_sysmount I_SYS_MOUNT /**/
+
+ /* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+ #$d_fstatfs HAS_FSTATFS /**/
+
+ /* HAS_STRUCT_STATFS_FLAGS:
+ * This symbol, if defined, indicates that the struct statfs has
+ * the f_flags member for mount flags.
+ */
+ #$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/
+
+ /* I_SYS_STATVFS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/statvfs.h>.
+ */
+ #$i_sysstatvfs I_SYS_STATVFS /**/
+
+ /* HAS_FSTATVFS:
+ * This symbol, if defined, indicates that the fstatvfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+ #$d_fstatvfs HAS_FSTATVFS /**/
+
+ /* I_MNTENT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mntent.h>.
+ */
+ #$i_mntent I_MNTENT /**/
+
+ /* HAS_GETMNTENT:
+ * This symbol, if defined, indicates that the getmntent routine is
+ * available to lookup mount entries in some data base or other.
+ */
+ #$d_getmntent HAS_GETMNTENT /**/
+
+ /* HAS_HASMNTOPT:
+ * This symbol, if defined, indicates that the hasmntopt routine is
+ * available to query mount entries returned by getmntent.
+ */
+ #$d_hasmntopt HAS_HASMNTOPT /**/
+
/* HAS_GETTIMEOFDAY:
* This symbol, if defined, indicates that the gettimeofday() system
* call is available for a sub-second accuracy clock. Usually, the file
***************
*** 1813,1819 ****
* the sig_name list.
*/
#define SIG_NAME $sig_name_init /**/
! #define SIG_NUM $sig_num /**/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
--- 1861,1867 ----
* the sig_name list.
*/
#define SIG_NAME $sig_name_init /**/
! #define SIG_NUM $sig_num_init /**/
/* VOIDFLAGS:
* This symbol indicates how much support of the void type is given by this
***************
*** 1902,1907 ****
--- 1950,1964 ----
#define PRIVLIB "$privlib" /**/
#define PRIVLIB_EXP "$privlibexp" /**/
+ /* SELECT_MIN_BITS:
+ * This symbol holds the minimum number of bits operated by select.
+ * That is, if you do select(n, ...), how many bits at least will be
+ * cleared in the masks if some activity is detected. Usually this
+ * is either n or 32*ceil(n/32), especially many little-endians do
+ * the latter. This is only useful if you have select(), naturally.
+ */
+ #define SELECT_MIN_BITS $selectminbits /**/
+
/* SITEARCH:
* This symbol contains the name of the private library for this package.
* The library is private in the sense that it needn't be in anyone's
***************
*** 2016,2021 ****
--- 2073,2090 ----
* instance.
*/
#define ARCHNAME "$archname" /**/
+
+ /* I_MACH_CTHREADS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mach/cthreads.h>.
+ */
+ #$i_machcthreads I_MACH_CTHREADS /**/
+
+ /* I_PTHREAD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <pthread.h>.
+ */
+ #$i_pthread I_PTHREAD /**/
/* HAS_PTHREAD_YIELD:
* This symbol, if defined, indicates that the pthread_yield
diff -c 'perl5.005_02/configure.com' 'perl5.005_03/configure.com'
Index: ./configure.com
*** ./configure.com Sun Aug 2 00:07:00 1998
--- ./configure.com Thu Oct 29 08:36:13 1998
***************
*** 974,980 ****
$ patchlevel = F$EXTRACT(18,F$LENGTH(line)-18,line)
$ got_patch = "true"
$ ENDIF
! $ IF ((F$LOCATE("SUBVERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_sub))
$ THEN
$ line = F$EDIT(line,"COMPRESS, TRIM")
$ subversion = F$EXTRACT(18,F$LENGTH(line)-18,line)
--- 974,980 ----
$ patchlevel = F$EXTRACT(18,F$LENGTH(line)-18,line)
$ got_patch = "true"
$ ENDIF
! $ IF ((F$LOCATE("#define SUBVERSION",line).NE.F$LENGTH(line)).AND.(.NOT.got_sub))
$ THEN
$ line = F$EDIT(line,"COMPRESS, TRIM")
$ subversion = F$EXTRACT(18,F$LENGTH(line)-18,line)
diff -c 'perl5.005_02/cop.h' 'perl5.005_03/cop.h'
Index: ./cop.h
*** ./cop.h Thu Jul 23 22:59:43 1998
--- ./cop.h Sat Mar 27 11:57:30 1999
***************
*** 1,6 ****
/* cop.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* cop.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 142,148 ****
#define POPLOOP2() \
SvREFCNT_dec(cxloop.iterlval); \
if (cxloop.itervar) { \
! SvREFCNT_dec(*cxloop.itervar); \
*cxloop.itervar = cxloop.itersave; \
} \
if (cxloop.iterary && cxloop.iterary != PL_curstack) \
--- 142,148 ----
#define POPLOOP2() \
SvREFCNT_dec(cxloop.iterlval); \
if (cxloop.itervar) { \
! sv_2mortal(*cxloop.itervar); \
*cxloop.itervar = cxloop.itersave; \
} \
if (cxloop.iterary && cxloop.iterary != PL_curstack) \
***************
*** 180,196 ****
cx->cx_type = t, \
cx->blk_oldsp = sp - PL_stack_base, \
cx->blk_oldcop = PL_curcop, \
! cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
cx->blk_oldscopesp = PL_scopestack_ix, \
! cx->blk_oldretsp = PL_retstack_ix, \
cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = gimme; \
DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \
! (long)cxstack_ix, block_type[t]); )
/* Exit a block (RETURN and LAST). */
#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
! newsp = PL_stack_base + cx->blk_oldsp, \
PL_curcop = cx->blk_oldcop, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
--- 180,196 ----
cx->cx_type = t, \
cx->blk_oldsp = sp - PL_stack_base, \
cx->blk_oldcop = PL_curcop, \
! cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
cx->blk_oldscopesp = PL_scopestack_ix, \
! cx->blk_oldretsp = PL_retstack_ix, \
cx->blk_oldpm = PL_curpm, \
cx->blk_gimme = gimme; \
DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \
! (long)cxstack_ix, block_type[CxTYPE(cx)]); )
/* Exit a block (RETURN and LAST). */
#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
! newsp = PL_stack_base + cx->blk_oldsp, \
PL_curcop = cx->blk_oldcop, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
***************
*** 198,211 ****
pm = cx->blk_oldpm, \
gimme = cx->blk_gimme; \
DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \
! (long)cxstack_ix+1,block_type[cx->cx_type]); )
/* Continue a block elsewhere (NEXT and REDO). */
#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
! PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
! PL_retstack_ix = cx->blk_oldretsp
/* substitution context */
struct subst {
--- 198,212 ----
pm = cx->blk_oldpm, \
gimme = cx->blk_gimme; \
DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \
! (long)cxstack_ix+1,block_type[CxTYPE(cx)]); )
/* Continue a block elsewhere (NEXT and REDO). */
#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
! PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
PL_scopestack_ix = cx->blk_oldscopesp, \
! PL_retstack_ix = cx->blk_oldretsp, \
! PL_curpm = cx->blk_oldpm
/* substitution context */
struct subst {
***************
*** 261,278 ****
rxres_free(&cx->sb_rxres)
struct context {
! I32 cx_type; /* what kind of context this is */
union {
struct block cx_blk;
struct subst cx_subst;
} cx_u;
};
#define CXt_NULL 0
#define CXt_SUB 1
#define CXt_EVAL 2
#define CXt_LOOP 3
#define CXt_SUBST 4
#define CXt_BLOCK 5
#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
--- 262,287 ----
rxres_free(&cx->sb_rxres)
struct context {
! U32 cx_type; /* what kind of context this is */
union {
struct block cx_blk;
struct subst cx_subst;
} cx_u;
};
+
+ #define CXTYPEMASK 0xff
#define CXt_NULL 0
#define CXt_SUB 1
#define CXt_EVAL 2
#define CXt_LOOP 3
#define CXt_SUBST 4
#define CXt_BLOCK 5
+
+ /* private flags for CXt_EVAL */
+ #define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
+
+ #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
+ #define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) == (CXt_EVAL|CXp_REAL))
#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
diff -c 'perl5.005_02/cv.h' 'perl5.005_03/cv.h'
Index: ./cv.h
*** ./cv.h Thu Jul 23 22:59:43 1998
--- ./cv.h Sat Mar 27 11:57:28 1999
***************
*** 1,6 ****
/* cv.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* cv.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 94,96 ****
--- 94,105 ----
#define CvLOCKED(cv) (CvFLAGS(cv) & CVf_LOCKED)
#define CvLOCKED_on(cv) (CvFLAGS(cv) |= CVf_LOCKED)
#define CvLOCKED_off(cv) (CvFLAGS(cv) &= ~CVf_LOCKED)
+
+ #define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv))
+ #define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv))
+ #define CvEVAL_off(cv) CvUNIQUE_off(cv)
+
+ /* BEGIN|INIT|END */
+ #define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv))
+ #define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv))
+ #define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv))
diff -c 'perl5.005_02/deb.c' 'perl5.005_03/deb.c'
Index: ./deb.c
*** ./deb.c Thu Jul 23 22:59:44 1998
--- ./deb.c Sat Mar 27 11:57:26 1999
***************
*** 1,6 ****
/* deb.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* deb.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/djgpp/config.over' 'perl5.005_03/djgpp/config.over'
Index: ./djgpp/config.over
*** ./djgpp/config.over Thu Jul 23 22:59:44 1998
--- ./djgpp/config.over Sat Jan 16 10:29:13 1999
***************
*** 15,21 ****
-e 's/fcntl/Fcntl/'\
-e 's/gdbm_fil/GDBM_File/'\
-e 's/io/IO/'\
! -e 's=ipc/sysv=IPC/SysV='\
-e 's/ndbm_fil/NDBM_File/'\
-e 's/odbm_fil/ODBM_File/'\
-e 's/opcode/Opcode/'\
--- 15,24 ----
-e 's/fcntl/Fcntl/'\
-e 's/gdbm_fil/GDBM_File/'\
-e 's/io/IO/'\
! -e 's/SysV//'\
! -e 's/sysv//'\
! -e 's=ipc/=='\
! -e 's=IPC/=='\
-e 's/ndbm_fil/NDBM_File/'\
-e 's/odbm_fil/ODBM_File/'\
-e 's/opcode/Opcode/'\
***************
*** 31,33 ****
--- 34,39 ----
# I use Dos::UseLFN in AutoSplit.pm to override this under win0.95
d_flexfnam='undef'
+
+ # under W95 + bash the test program returns bogus result
+ d_casti32='undef'
diff -c 'perl5.005_02/djgpp/djgpp.c' 'perl5.005_03/djgpp/djgpp.c'
Index: ./djgpp/djgpp.c
*** ./djgpp/djgpp.c Thu Jul 23 22:59:44 1998
--- ./djgpp/djgpp.c Sat Jan 16 10:29:13 1999
***************
*** 133,139 ****
{
dTHR;
int rc;
! char **a,*tmps,**argv;
if (sp<=mark)
return -1;
--- 133,140 ----
{
dTHR;
int rc;
! char **a,*tmps,**argv;
! STRLEN n_a;
if (sp<=mark)
return -1;
***************
*** 141,147 ****
while (++mark <= sp)
if (*mark)
! *a++ = SvPVx(*mark, PL_na);
else
*a++ = "";
*a = Nullch;
--- 142,148 ----
while (++mark <= sp)
if (*mark)
! *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
*a = Nullch;
***************
*** 152,158 ****
) /* will swawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
! if (really && *(tmps = SvPV(really, PL_na)))
rc=spawnvp (P_WAIT,tmps,argv);
else
rc=spawnvp (P_WAIT,argv[0],argv);
--- 153,159 ----
) /* will swawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
! if (really && *(tmps = SvPV(really, n_a)))
rc=spawnvp (P_WAIT,tmps,argv);
else
rc=spawnvp (P_WAIT,argv[0],argv);
***************
*** 250,255 ****
--- 251,257 ----
int fd;
char *matches;
size_t size;
+ fpos_t pos;
};
#define MAXOPENGLOBS 10
***************
*** 284,289 ****
--- 286,292 ----
if ((gi=searchfd (-1)) == NULL)
break;
+ gi->pos=0;
pattern=alloca (strlen (name+=13)+1);
strcpy (pattern,name);
if (!_USE_LFN)
***************
*** 330,340 ****
if ((gi=searchfd (fd))==NULL)
break;
! ic=tell (fd);
! if (siz+ic>=gi->size)
! siz=gi->size-ic;
! memcpy (buf,ic+gi->matches,siz);
! lseek (fd,siz,1);
*rv=siz;
return 1;
}
--- 333,342 ----
if ((gi=searchfd (fd))==NULL)
break;
! if (siz+gi->pos>gi->size)
! siz=gi->size-gi->pos;
! memcpy (buf,gi->pos+gi->matches,siz);
! gi->pos+=siz;
*rv=siz;
return 1;
}
diff -c 'perl5.005_02/doio.c' 'perl5.005_03/doio.c'
Index: ./doio.c
*** ./doio.c Sun Aug 2 00:15:06 1998
--- ./doio.c Sat Mar 27 11:57:24 1999
***************
*** 1,6 ****
/* doio.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* doio.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 18,30 ****
#include "perl.h"
#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
#include <sys/shm.h>
# ifndef HAS_SHMAT_PROTOTYPE
--- 18,29 ----
#include "perl.h"
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
+ #ifndef HAS_SEM
#include <sys/ipc.h>
+ #endif
#ifdef HAS_MSG
#include <sys/msg.h>
#endif
#ifdef HAS_SHM
#include <sys/shm.h>
# ifndef HAS_SHMAT_PROTOTYPE
***************
*** 359,366 ****
PerlIO_clearerr(fp);
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
! fd = PerlIO_fileno(fp);
! fcntl(fd,F_SETFD,fd > PL_maxsysfd);
#endif
IoIFP(io) = fp;
if (writing) {
--- 358,369 ----
PerlIO_clearerr(fp);
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
! {
! int save_errno = errno;
! fd = PerlIO_fileno(fp);
! fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
! errno = save_errno;
! }
#endif
IoIFP(io) = fp;
if (writing) {
***************
*** 545,551 ****
}
else
PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
! SvPV(sv, PL_na), Strerror(errno));
}
if (PL_inplace) {
(void)do_close(PL_argvoutgv,FALSE);
--- 548,554 ----
}
else
PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
! SvPV(sv, oldlen), Strerror(errno));
}
if (PL_inplace) {
(void)do_close(PL_argvoutgv,FALSE);
***************
*** 759,765 ****
if (flag != TRUE)
croak("panic: unsetting binmode"); /* Not implemented yet */
#ifdef DOSISH
! #ifdef atarist
if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
return 1;
else
--- 762,768 ----
if (flag != TRUE)
croak("panic: unsetting binmode"); /* Not implemented yet */
#ifdef DOSISH
! #if defined(atarist) || defined(__MINT__)
if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
return 1;
else
***************
*** 920,925 ****
--- 923,929 ----
else {
SV* sv = POPs;
char *s;
+ STRLEN n_a;
PUTBACK;
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv;
***************
*** 930,936 ****
goto do_fstat;
}
! s = SvPV(sv, PL_na);
PL_statgv = Nullgv;
sv_setpv(PL_statname, s);
PL_laststype = OP_STAT;
--- 934,940 ----
goto do_fstat;
}
! s = SvPV(sv, n_a);
PL_statgv = Nullgv;
sv_setpv(PL_statname, s);
PL_laststype = OP_STAT;
***************
*** 946,951 ****
--- 950,956 ----
{
djSP;
SV *sv;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
EXTEND(SP,1);
if (cGVOP->op_gv == PL_defgv) {
***************
*** 960,972 ****
PL_statgv = Nullgv;
sv = POPs;
PUTBACK;
! sv_setpv(PL_statname,SvPV(sv, PL_na));
#ifdef HAS_LSTAT
! PL_laststatval = PerlLIO_lstat(SvPV(sv, PL_na),&PL_statcache);
#else
! PL_laststatval = PerlLIO_stat(SvPV(sv, PL_na),&PL_statcache);
#endif
! if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
warn(warn_nl, "lstat");
return PL_laststatval;
}
--- 965,977 ----
PL_statgv = Nullgv;
sv = POPs;
PUTBACK;
! sv_setpv(PL_statname,SvPV(sv, n_a));
#ifdef HAS_LSTAT
! PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
#else
! PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache);
#endif
! if (PL_laststatval < 0 && PL_dowarn && strchr(SvPV(sv, n_a), '\n'))
warn(warn_nl, "lstat");
return PL_laststatval;
}
***************
*** 976,981 ****
--- 981,987 ----
{
register char **a;
char *tmps;
+ STRLEN n_a;
if (sp > mark) {
dTHR;
***************
*** 983,996 ****
a = PL_Argv;
while (++mark <= sp) {
if (*mark)
! *a++ = SvPVx(*mark, PL_na);
else
*a++ = "";
}
*a = Nullch;
if (*PL_Argv[0] != '/') /* will execvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
! if (really && *(tmps = SvPV(really, PL_na)))
PerlProc_execvp(tmps,PL_Argv);
else
PerlProc_execvp(PL_Argv[0],PL_Argv);
--- 989,1002 ----
a = PL_Argv;
while (++mark <= sp) {
if (*mark)
! *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
*a = Nullch;
if (*PL_Argv[0] != '/') /* will execvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
! if (really && *(tmps = SvPV(really, n_a)))
PerlProc_execvp(tmps,PL_Argv);
else
PerlProc_execvp(PL_Argv[0],PL_Argv);
***************
*** 1116,1125 ****
char *what;
char *s;
SV **oldmark = mark;
#define APPLY_TAINT_PROPER() \
STMT_START { \
! if (PL_tainting && PL_tainted) { goto taint_proper_label; } \
} STMT_END
/* This is a first heuristic; it doesn't catch tainting magic. */
--- 1122,1132 ----
char *what;
char *s;
SV **oldmark = mark;
+ STRLEN n_a;
#define APPLY_TAINT_PROPER() \
STMT_START { \
! if (PL_tainted) { TAINT_PROPER(what); } \
} STMT_END
/* This is a first heuristic; it doesn't catch tainting magic. */
***************
*** 1141,1147 ****
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! char *name = SvPVx(*mark, PL_na);
APPLY_TAINT_PROPER();
if (PerlLIO_chmod(name, val))
tot--;
--- 1148,1154 ----
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! char *name = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PerlLIO_chmod(name, val))
tot--;
***************
*** 1158,1164 ****
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! char *name = SvPVx(*mark, PL_na);
APPLY_TAINT_PROPER();
if (PerlLIO_chown(name, val, val2))
tot--;
--- 1165,1171 ----
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! char *name = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PerlLIO_chown(name, val, val2))
tot--;
***************
*** 1178,1184 ****
APPLY_TAINT_PROPER();
if (mark == sp)
break;
! s = SvPVx(*++mark, PL_na);
if (isUPPER(*s)) {
if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
s += 3;
--- 1185,1191 ----
APPLY_TAINT_PROPER();
if (mark == sp)
break;
! s = SvPVx(*++mark, n_a);
if (isUPPER(*s)) {
if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
s += 3;
***************
*** 1248,1254 ****
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! s = SvPVx(*mark, PL_na);
APPLY_TAINT_PROPER();
if (PL_euid || PL_unsafe) {
if (UNLINK(s))
--- 1255,1261 ----
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! s = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PL_euid || PL_unsafe) {
if (UNLINK(s))
***************
*** 1277,1299 ****
struct utimbuf utbuf;
#else
struct {
! long actime;
! long modtime;
} utbuf;
#endif
Zero(&utbuf, sizeof utbuf, char);
#ifdef BIG_TIME
! utbuf.actime = (Time_t)SvNVx(*++mark); /* time accessed */
! utbuf.modtime = (Time_t)SvNVx(*++mark); /* time modified */
#else
! utbuf.actime = SvIVx(*++mark); /* time accessed */
! utbuf.modtime = SvIVx(*++mark); /* time modified */
#endif
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! char *name = SvPVx(*mark, PL_na);
APPLY_TAINT_PROPER();
if (PerlLIO_utime(name, &utbuf))
tot--;
--- 1284,1306 ----
struct utimbuf utbuf;
#else
struct {
! Time_t actime;
! Time_t modtime;
} utbuf;
#endif
Zero(&utbuf, sizeof utbuf, char);
#ifdef BIG_TIME
! utbuf.actime = (Time_t)SvNVx(*++mark); /* time accessed */
! utbuf.modtime = (Time_t)SvNVx(*++mark); /* time modified */
#else
! utbuf.actime = (Time_t)SvIVx(*++mark); /* time accessed */
! utbuf.modtime = (Time_t)SvIVx(*++mark); /* time modified */
#endif
APPLY_TAINT_PROPER();
tot = sp - mark;
while (++mark <= sp) {
! char *name = SvPVx(*mark, n_a);
APPLY_TAINT_PROPER();
if (PerlLIO_utime(name, &utbuf))
tot--;
***************
*** 1305,1314 ****
#endif
}
return tot;
-
- taint_proper_label:
- TAINT_PROPER(what);
- return 0; /* this should never happen */
#undef APPLY_TAINT_PROPER
}
--- 1312,1317 ----
diff -c 'perl5.005_02/doop.c' 'perl5.005_03/doop.c'
Index: ./doop.c
*** ./doop.c Thu Jul 23 22:59:45 1998
--- ./doop.c Sat Mar 27 11:57:19 1999
***************
*** 1,6 ****
/* doop.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* doop.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 352,358 ****
len = leftlen < rightlen ? leftlen : rightlen;
lensave = len;
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
! dc = SvPV_force(sv, PL_na);
if (SvCUR(sv) < len) {
dc = SvGROW(sv, len + 1);
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
--- 352,359 ----
len = leftlen < rightlen ? leftlen : rightlen;
lensave = len;
if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
! STRLEN n_a;
! dc = SvPV_force(sv, n_a);
if (SvCUR(sv) < len) {
dc = SvGROW(sv, len + 1);
(void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
***************
*** 491,497 ****
RETURN;
}
! if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
i = HvKEYS(keys);
else {
i = 0;
--- 492,498 ----
RETURN;
}
! if (! SvTIED_mg((SV*)keys, 'P'))
i = HvKEYS(keys);
else {
i = 0;
diff -c 'perl5.005_02/dump.c' 'perl5.005_03/dump.c'
Index: ./dump.c
*** ./dump.c Thu Jul 23 22:59:45 1998
--- ./dump.c Sat Mar 27 11:57:17 1999
***************
*** 1,6 ****
/* dump.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* dump.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 239,249 ****
case OP_GVSV:
case OP_GV:
if (cGVOPo->op_gv) {
SV *tmpsv = NEWSV(0,0);
ENTER;
SAVEFREESV(tmpsv);
gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
! dump("GV = %s\n", SvPV(tmpsv, PL_na));
LEAVE;
}
else
--- 239,250 ----
case OP_GVSV:
case OP_GV:
if (cGVOPo->op_gv) {
+ STRLEN n_a;
SV *tmpsv = NEWSV(0,0);
ENTER;
SAVEFREESV(tmpsv);
gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch);
! dump("GV = %s\n", SvPV(tmpsv, n_a));
LEAVE;
}
else
diff -c 'perl5.005_02/embed.h' 'perl5.005_03/embed.h'
Index: ./embed.h
*** ./embed.h Tue Aug 4 15:16:27 1998
--- ./embed.h Sat Jan 16 12:13:37 1999
***************
*** 159,164 ****
--- 159,165 ----
#define do_trans Perl_do_trans
#define do_vecset Perl_do_vecset
#define do_vop Perl_do_vop
+ #define dofile Perl_dofile
#define dofindlabel Perl_dofindlabel
#define dopoptoeval Perl_dopoptoeval
#define dounwind Perl_dounwind
***************
*** 204,209 ****
--- 205,211 ----
#define get_op_names Perl_get_op_names
#define get_opargs Perl_get_opargs
#define get_specialsv_list Perl_get_specialsv_list
+ #define get_vtbl Perl_get_vtbl
#define gp_free Perl_gp_free
#define gp_ref Perl_gp_ref
#define gt_amg Perl_gt_amg
***************
*** 859,864 ****
--- 861,867 ----
#define save_freeop Perl_save_freeop
#define save_freepv Perl_save_freepv
#define save_freesv Perl_save_freesv
+ #define save_generic_svref Perl_save_generic_svref
#define save_gp Perl_save_gp
#define save_hash Perl_save_hash
#define save_helem Perl_save_helem
diff -c 'perl5.005_02/embed.pl' 'perl5.005_03/embed.pl'
Index: ./embed.pl
*** ./embed.pl Thu Jul 23 22:59:54 1998
--- ./embed.pl Wed Nov 4 19:47:31 1998
***************
*** 37,43 ****
}
readsyms %global, 'global.sym';
- readsyms %interp, 'interp.sym';
sub readvars(\%$$) {
my ($syms, $file,$pre) = @_;
--- 37,42 ----
***************
*** 63,73 ****
foreach my $sym (sort keys %intrp)
{
- warn "$sym not in interp.sym\n" unless exists $interp{$sym};
if (exists $global{$sym})
{
delete $global{$sym};
! warn "$sym in global.sym as well as interp\n";
}
}
--- 62,71 ----
foreach my $sym (sort keys %intrp)
{
if (exists $global{$sym})
{
delete $global{$sym};
! warn "$sym in global.sym as well as intrpvar.h\n";
}
}
***************
*** 80,98 ****
}
}
- foreach my $sym (keys %interp)
- {
- warn "extra $sym in interp.sym\n"
- unless exists $intrp{$sym} || exists $thread{$sym};
- }
-
foreach my $sym (sort keys %thread)
{
! warn "$sym in intrpvar.h\n" if exists $intrp{$sym};
if (exists $global{$sym})
{
delete $global{$sym};
! warn "$sym in global.sym as well as thread\n";
}
}
--- 78,90 ----
}
}
foreach my $sym (sort keys %thread)
{
! warn "$sym in intrpvar.h as well as thrdvar.h\n" if exists $intrp{$sym};
if (exists $global{$sym})
{
delete $global{$sym};
! warn "$sym in global.sym as well as thrdvar.h\n";
}
}
diff -c 'perl5.005_02/embedvar.h' 'perl5.005_03/embedvar.h'
Index: ./embedvar.h
*** ./embedvar.h Tue Aug 4 15:19:02 1998
--- ./embedvar.h Tue Jan 5 21:02:41 1999
***************
*** 250,255 ****
--- 250,256 ----
#define PL_stdingv (PL_curinterp->Istdingv)
#define PL_strchop (PL_curinterp->Istrchop)
#define PL_strtab (PL_curinterp->Istrtab)
+ #define PL_strtab_mutex (PL_curinterp->Istrtab_mutex)
#define PL_sub_generation (PL_curinterp->Isub_generation)
#define PL_sublex_info (PL_curinterp->Isublex_info)
#define PL_sv_arenaroot (PL_curinterp->Isv_arenaroot)
***************
*** 384,389 ****
--- 385,391 ----
#define PL_Istdingv PL_stdingv
#define PL_Istrchop PL_strchop
#define PL_Istrtab PL_strtab
+ #define PL_Istrtab_mutex PL_strtab_mutex
#define PL_Isub_generation PL_sub_generation
#define PL_Isublex_info PL_sublex_info
#define PL_Isv_arenaroot PL_sv_arenaroot
***************
*** 647,652 ****
--- 649,655 ----
#define PL_collxfrm_base (PL_Vars.Gcollxfrm_base)
#define PL_collxfrm_mult (PL_Vars.Gcollxfrm_mult)
#define PL_cop_seqmax (PL_Vars.Gcop_seqmax)
+ #define PL_cred_mutex (PL_Vars.Gcred_mutex)
#define PL_cryptseen (PL_Vars.Gcryptseen)
#define PL_cshlen (PL_Vars.Gcshlen)
#define PL_cshname (PL_Vars.Gcshname)
***************
*** 757,762 ****
--- 760,766 ----
#define PL_Gcollxfrm_base PL_collxfrm_base
#define PL_Gcollxfrm_mult PL_collxfrm_mult
#define PL_Gcop_seqmax PL_cop_seqmax
+ #define PL_Gcred_mutex PL_cred_mutex
#define PL_Gcryptseen PL_cryptseen
#define PL_Gcshlen PL_cshlen
#define PL_Gcshname PL_cshname
diff -c 'perl5.005_02/ext/B/B.pm' 'perl5.005_03/ext/B/B.pm'
Index: ./ext/B/B.pm
*** ./ext/B/B.pm Thu Jul 23 22:59:55 1998
--- ./ext/B/B.pm Sun Nov 29 19:15:08 1998
***************
*** 13,19 ****
class peekop cast_I32 cstring cchar hash threadsv_names
main_root main_start main_cv svref_2object
walkoptree walkoptree_slow walkoptree_exec walksymtable
! parents comppadlist sv_undef compile_stats timing_info);
use strict;
@B::SV::ISA = 'B::OBJECT';
--- 13,19 ----
class peekop cast_I32 cstring cchar hash threadsv_names
main_root main_start main_cv svref_2object
walkoptree walkoptree_slow walkoptree_exec walksymtable
! parents comppadlist sv_undef compile_stats timing_info init_av);
use strict;
@B::SV::ISA = 'B::OBJECT';
***************
*** 530,535 ****
--- 530,537 ----
=item XSUBANY
+ =item CvFLAGS
+
=back
=head2 B::HV METHODS
***************
*** 576,582 ****
=item desc
! This returns the op description from the global C op_desc array
(e.g. "addition" "array deref").
=item targ
--- 578,584 ----
=item desc
! This returns the op description from the global C PL_op_desc array
(e.g. "addition" "array deref").
=item targ
***************
*** 719,724 ****
--- 721,730 ----
Return the (faked) CV corresponding to the main part of the Perl
program.
+
+ =item init_av
+
+ Returns the AV object (i.e. in class B::AV) representing INIT blocks.
=item main_root
diff -c 'perl5.005_02/ext/B/B.xs' 'perl5.005_03/ext/B/B.xs'
Index: ./ext/B/B.xs
*** ./ext/B/B.xs Thu Jul 23 22:59:55 1998
--- ./ext/B/B.xs Wed Dec 30 22:54:17 1998
***************
*** 267,273 ****
cchar(SV *sv)
{
SV *sstr = newSVpv("'", 0);
! char *s = SvPV(sv, PL_na);
if (*s == '\'')
sv_catpv(sstr, "\\'");
--- 267,274 ----
cchar(SV *sv)
{
SV *sstr = newSVpv("'", 0);
! STRLEN n_a;
! char *s = SvPV(sv, n_a);
if (*s == '\'')
sv_catpv(sstr, "\\'");
***************
*** 437,442 ****
--- 438,444 ----
INIT_SPECIALSV_LIST;
#define B_main_cv() PL_main_cv
+ #define B_init_av() PL_initav
#define B_main_root() PL_main_root
#define B_main_start() PL_main_start
#define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv))
***************
*** 444,449 ****
--- 446,454 ----
#define B_sv_yes() &PL_sv_yes
#define B_sv_no() &PL_sv_no
+ B::AV
+ B_init_av()
+
B::CV
B_main_cv()
***************
*** 1163,1168 ****
--- 1168,1180 ----
B::CV cv
CODE:
ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv));
+
+ MODULE = B PACKAGE = B::CV
+
+ U8
+ CvFLAGS(cv)
+ B::CV cv
+
MODULE = B PACKAGE = B::HV PREFIX = Hv
diff -c 'perl5.005_02/ext/B/B/Assembler.pm' 'perl5.005_03/ext/B/B/Assembler.pm'
Index: ./ext/B/B/Assembler.pm
*** ./ext/B/B/Assembler.pm Thu Jul 23 22:59:55 1998
--- ./ext/B/B/Assembler.pm Sun Nov 29 19:18:23 1998
***************
*** 53,58 ****
--- 53,60 ----
sub B::Asmdata::PUT_U32 { pack("N", $_[0]) }
sub B::Asmdata::PUT_I32 { pack("N", $_[0]) }
sub B::Asmdata::PUT_objindex { pack("N", $_[0]) } # could allow names here
+ sub B::Asmdata::PUT_svindex { &B::Asmdata::PUT_objindex }
+ sub B::Asmdata::PUT_opindex { &B::Asmdata::PUT_objindex }
sub B::Asmdata::PUT_strconst {
my $arg = shift;
***************
*** 78,84 ****
error "bad string argument: $arg" unless defined($arg);
return pack("N", length($arg)) . $arg;
}
! sub B::Asmdata::PUT_comment {
my $arg = shift;
$arg = uncstring($arg);
error "bad string argument: $arg" unless defined($arg);
--- 80,86 ----
error "bad string argument: $arg" unless defined($arg);
return pack("N", length($arg)) . $arg;
}
! sub B::Asmdata::PUT_comment_t {
my $arg = shift;
$arg = uncstring($arg);
error "bad string argument: $arg" unless defined($arg);
diff -c 'perl5.005_02/ext/B/B/C.pm' 'perl5.005_03/ext/B/B/C.pm'
Index: ./ext/B/B/C.pm
*** ./ext/B/B/C.pm Thu Jul 23 22:59:57 1998
--- ./ext/B/B/C.pm Sun Nov 29 19:19:29 1998
***************
*** 13,19 ****
use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
class cstring cchar svref_2object compile_stats comppadlist hash
! threadsv_names);
use B::Asmdata qw(@specialsv_name);
use FileHandle;
--- 13,19 ----
use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
class cstring cchar svref_2object compile_stats comppadlist hash
! threadsv_names main_cv init_av);
use B::Asmdata qw(@specialsv_name);
use FileHandle;
***************
*** 44,50 ****
$gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
$pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
$xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
! $xrvsect, $xpvbmsect, $xpviosect);
sub walk_and_save_optree;
my $saveoptree_callback = \&walk_and_save_optree;
--- 44,50 ----
$gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
$pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect,
$xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect,
! $xrvsect, $xpvbmsect, $xpviosect, $bootstrap);
sub walk_and_save_optree;
my $saveoptree_callback = \&walk_and_save_optree;
***************
*** 596,605 ****
warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
$cvstashname, $cvname); # debug
}
! $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0",
$xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
$cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
! $$padlist, ${$cv->OUTSIDE}));
if ($$gv) {
$gv->save;
$init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv));
--- 596,610 ----
warn sprintf("No definition for sub %s::%s (unable to autoload)\n",
$cvstashname, $cvname); # debug
}
! $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0x%x",
$xpvcv_ix, cstring($pv), length($pv), $cv->IVX,
$cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH,
! $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS));
!
! if (${$cv->OUTSIDE} == ${main_cv()}){
! $init->add(sprintf("CvOUTSIDE(s\\_%x)=PL_main_cv;",$$cv));
! }
!
if ($$gv) {
$gv->save;
$init->add(sprintf("CvGV(s\\_%x) = s\\_%x;",$$cv,$$gv));
***************
*** 691,697 ****
}
my $gvfilegv = $gv->FILEGV;
if ($$gvfilegv) {
! $init->add(sprintf("GvFILEGV($sym) = s\\_%x;",$$gvfilegv));
# warn "GV::save GvFILEGV(*$name)\n"; # debug
$gvfilegv->save;
}
--- 696,702 ----
}
my $gvfilegv = $gv->FILEGV;
if ($$gvfilegv) {
! $init->add(sprintf("GvFILEGV($sym) = (GV*)s\\_%x;",$$gvfilegv));
# warn "GV::save GvFILEGV(*$name)\n"; # debug
$gvfilegv->save;
}
***************
*** 847,852 ****
--- 852,858 ----
$cvopsect, $loopsect, $copsect, $svsect, $xpvsect,
$xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect,
$xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect);
+ $bootstrap->output(\*STDOUT, "/* bootstrap %s */\n");
$symsect->output(\*STDOUT, "#define %s\n");
print "\n";
output_declarations();
***************
*** 1046,1075 ****
foreach $sv (@_) {
svref_2object($sv)->save;
}
! }
sub B::GV::savecv {
my $gv = shift;
my $cv = $gv->CV;
my $name = $gv->NAME;
! if ($$cv && !objsym($cv) && !($name eq "bootstrap" && $cv->XSUB)) {
if ($debug_cv) {
warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
$gv->STASH->NAME, $name, $$cv, $$gv);
}
$gv->save;
}
}
sub save_unused_subs {
my %search_pack;
map { $search_pack{$_} = 1 } @_;
no strict qw(vars refs);
walksymtable(\%{"main::"}, "savecv", sub {
my $package = shift;
$package =~ s/::$//;
#warn "Considering $package\n";#debug
return 1 if exists $search_pack{$package};
#warn " (nothing explicit)\n";#debug
# Omit the packages which we use (and which cause grief
# because of fancy "goto &$AUTOLOAD" stuff).
--- 1052,1112 ----
foreach $sv (@_) {
svref_2object($sv)->save;
}
! }
!
! sub Dummy_BootStrap { }
sub B::GV::savecv {
my $gv = shift;
my $cv = $gv->CV;
my $name = $gv->NAME;
! if ($$cv) {
! if ($name eq "bootstrap" && $cv->XSUB) {
! my $file = $cv->FILEGV->SV->PV;
! $bootstrap->add($file);
! my $name = $gv->STASH->NAME.'::'.$name;
! no strict 'refs';
! *{$name} = \&Dummy_BootStrap;
! $cv = $gv->CV;
! }
if ($debug_cv) {
warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
$gv->STASH->NAME, $name, $$cv, $$gv);
}
+ my $package=$gv->STASH->NAME;
+ # This seems to undo all the ->isa and prefix stuff we do below
+ # so disable again for now
+ if (0 && ! grep(/^$package$/,@unused_sub_packages)){
+ warn sprintf("omitting cv in superclass %s", $gv->STASH->NAME)
+ if $debug_cv;
+ return ;
+ }
$gv->save;
}
+ elsif ($name eq 'ISA')
+ {
+ $gv->save;
+ }
+
}
+
+
sub save_unused_subs {
my %search_pack;
map { $search_pack{$_} = 1 } @_;
+ @unused_sub_packages=@_;
no strict qw(vars refs);
walksymtable(\%{"main::"}, "savecv", sub {
my $package = shift;
$package =~ s/::$//;
+ return 0 if ($package =~ /::::/); # skip ::::ISA::CACHE etc.
#warn "Considering $package\n";#debug
return 1 if exists $search_pack{$package};
+ #sub try for a partial match
+ if (grep(/^$package\:\:/,@unused_sub_packages)){
+ return 1;
+ }
#warn " (nothing explicit)\n";#debug
# Omit the packages which we use (and which cause grief
# because of fancy "goto &$AUTOLOAD" stuff).
***************
*** 1079,1088 ****
|| $package eq "SelectSaver") {
return 0;
}
! my $m;
! foreach $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) {
if (defined(&{$package."::$m"})) {
warn "$package has method $m: -u$package assumed\n";#debug
return 1;
}
}
--- 1116,1136 ----
|| $package eq "SelectSaver") {
return 0;
}
! foreach my $u (keys %search_pack) {
! if ($package =~ /^${u}::/) {
! warn "$package starts with $u\n";
! return 1
! }
! if ($package->isa($u)) {
! warn "$package isa $u\n";
! return 1
! }
! return 1 if $package->isa($u);
! }
! foreach my $m (qw(new DESTROY TIESCALAR TIEARRAY TIEHASH)) {
if (defined(&{$package."::$m"})) {
warn "$package has method $m: -u$package assumed\n";#debug
+ push @unused_sub_package, $package;
return 1;
}
}
***************
*** 1091,1104 ****
}
sub save_main {
my $curpad_sym = (comppadlist->ARRAY)[1]->save;
walkoptree(main_root, "save");
warn "done main optree, walking symtable for extras\n" if $debug_cv;
save_unused_subs(@unused_sub_packages);
$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
sprintf("PL_main_start = s\\_%x;", ${main_start()}),
! "PL_curpad = AvARRAY($curpad_sym);");
output_boilerplate();
print "\n";
output_all("perl_init");
--- 1139,1163 ----
}
sub save_main {
+ warn "Walking tree\n";
+ my $curpad_nam = (comppadlist->ARRAY)[0]->save;
my $curpad_sym = (comppadlist->ARRAY)[1]->save;
+ my $init_av = init_av->save;
+ my $inc_hv = svref_2object(\%INC)->save;
+ my $inc_av = svref_2object(\@INC)->save;
walkoptree(main_root, "save");
warn "done main optree, walking symtable for extras\n" if $debug_cv;
save_unused_subs(@unused_sub_packages);
$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
sprintf("PL_main_start = s\\_%x;", ${main_start()}),
! "PL_curpad = AvARRAY($curpad_sym);",
! "PL_initav = $init_av;",
! "GvHV(PL_incgv) = $inc_hv;",
! "GvAV(PL_incgv) = $inc_av;",
! "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
! "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
! warn "Writing output\n";
output_boilerplate();
print "\n";
output_all("perl_init");
***************
*** 1118,1124 ****
xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect,
xrv => \$xrvsect, xpvbm => \$xpvbmsect,
! xpvio => \$xpviosect);
my ($name, $sectref);
while (($name, $sectref) = splice(@sections, 0, 2)) {
$$sectref = new B::Section $name, \%symtable, 0;
--- 1177,1183 ----
xpviv => \$xpvivsect, xpvnv => \$xpvnvsect,
xpvmg => \$xpvmgsect, xpvlv => \$xpvlvsect,
xrv => \$xrvsect, xpvbm => \$xpvbmsect,
! xpvio => \$xpviosect, bootstrap => \$bootstrap);
my ($name, $sectref);
while (($name, $sectref) = splice(@sections, 0, 2)) {
$$sectref = new B::Section $name, \%symtable, 0;
diff -c 'perl5.005_02/ext/B/B/CC.pm' 'perl5.005_03/ext/B/B/CC.pm'
Index: ./ext/B/B/CC.pm
*** ./ext/B/B/CC.pm Thu Jul 23 22:59:57 1998
--- ./ext/B/B/CC.pm Thu Nov 26 20:00:38 1998
***************
*** 878,884 ****
}
runtime("SvSETMAGIC(TOPs);");
} else {
! my $dst = pop @stack;
my $type = $dst->{type};
runtime("sv = POPs;");
runtime("MAYBE_TAINT_SASSIGN_SRC(sv);");
--- 878,884 ----
}
runtime("SvSETMAGIC(TOPs);");
} else {
! my $dst = $stack[-1];
my $type = $dst->{type};
runtime("sv = POPs;");
runtime("MAYBE_TAINT_SASSIGN_SRC(sv);");
***************
*** 946,958 ****
write_back_lexicals(REGISTER|TEMPORARY);
write_back_stack();
my $sym = doop($op);
! runtime("if (PL_op != ($sym)->op_next) PL_op = (*PL_op->op_ppaddr)(ARGS);");
! runtime("SPAGAIN;");
$know_op = 0;
invalidate_lexicals(REGISTER|TEMPORARY);
return $op->next;
}
sub pp_enterwrite {
my $op = shift;
pp_entersub($op);
--- 946,970 ----
write_back_lexicals(REGISTER|TEMPORARY);
write_back_stack();
my $sym = doop($op);
! runtime("while (PL_op != ($sym)->op_next && PL_op != (OP*)0 ){");
! runtime("PL_op = (*PL_op->op_ppaddr)(ARGS);");
! runtime("SPAGAIN;}");
$know_op = 0;
invalidate_lexicals(REGISTER|TEMPORARY);
return $op->next;
}
+ sub pp_goto{
+
+ my $op = shift;
+ my $ppname = $op->ppaddr;
+ write_back_lexicals() unless $skip_lexicals{$ppname};
+ write_back_stack() unless $skip_stack{$ppname};
+ my $sym=doop($op);
+ runtime("if (PL_op != ($sym)->op_next && PL_op != (OP*)0){return PL_op;}");
+ invalidate_lexicals() unless $skip_invalidate{$ppname};
+ return $op->next;
+ }
sub pp_enterwrite {
my $op = shift;
pp_entersub($op);
***************
*** 1051,1057 ****
write_back_lexicals(REGISTER|TEMPORARY);
write_back_stack();
doop($op);
! runtime("PUTBACK;", "return 0;");
$know_op = 0;
return $op->next;
}
--- 1063,1069 ----
write_back_lexicals(REGISTER|TEMPORARY);
write_back_stack();
doop($op);
! runtime("PUTBACK;", "return (PL_op)?PL_op->op_next:0;");
$know_op = 0;
return $op->next;
}
***************
*** 1344,1350 ****
$need_freetmps = 0;
}
if (!$$op) {
! runtime("PUTBACK;", "return 0;");
} elsif ($done{$$op}) {
runtime(sprintf("goto %s;", label($op)));
}
--- 1356,1362 ----
$need_freetmps = 0;
}
if (!$$op) {
! runtime("PUTBACK;","return (PL_op)?PL_op->op_next:0;");
} elsif ($done{$$op}) {
runtime(sprintf("goto %s;", label($op)));
}
***************
*** 1375,1380 ****
--- 1387,1393 ----
sub cc_main {
my @comppadlist = comppadlist->ARRAY;
+ my $curpad_nam = $comppadlist[0]->save;
my $curpad_sym = $comppadlist[1]->save;
my $start = cc_recurse("pp_main", main_root, main_start, @comppadlist);
save_unused_subs(@unused_sub_packages);
***************
*** 1384,1390 ****
if (!defined($module)) {
$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
"PL_main_start = $start;",
! "PL_curpad = AvARRAY($curpad_sym);");
}
output_boilerplate();
print "\n";
--- 1397,1405 ----
if (!defined($module)) {
$init->add(sprintf("PL_main_root = s\\_%x;", ${main_root()}),
"PL_main_start = $start;",
! "PL_curpad = AvARRAY($curpad_sym);",
! "av_store(CvPADLIST(PL_main_cv),0,SvREFCNT_inc($curpad_nam));",
! "av_store(CvPADLIST(PL_main_cv),1,SvREFCNT_inc($curpad_sym));");
}
output_boilerplate();
print "\n";
diff -c 'perl5.005_02/ext/B/B/Disassembler.pm' 'perl5.005_03/ext/B/B/Disassembler.pm'
Index: ./ext/B/B/Disassembler.pm
*** ./ext/B/B/Disassembler.pm Thu Jul 23 22:59:59 1998
--- ./ext/B/B/Disassembler.pm Sun Nov 29 19:20:35 1998
***************
*** 77,83 ****
}
}
! sub GET_comment {
my $fh = shift;
my ($str, $c);
while (defined($c = $fh->getc) && $c ne "\n") {
--- 77,83 ----
}
}
! sub GET_comment_t {
my $fh = shift;
my ($str, $c);
while (defined($c = $fh->getc) && $c ne "\n") {
diff -c 'perl5.005_02/ext/B/Makefile.PL' 'perl5.005_03/ext/B/Makefile.PL'
Index: ./ext/B/Makefile.PL
*** ./ext/B/Makefile.PL Thu Jul 23 23:00:00 1998
--- ./ext/B/Makefile.PL Thu Nov 26 20:11:59 1998
***************
*** 16,22 ****
WriteMakefile(
NAME => "B",
VERSION => "a5",
! MAN3PODS => ' ',
clean => {
FILES => "perl$e byteperl$e *$o B.c *~"
}
--- 16,22 ----
WriteMakefile(
NAME => "B",
VERSION => "a5",
! MAN3PODS => {},
clean => {
FILES => "perl$e byteperl$e *$o B.c *~"
}
diff -c 'perl5.005_02/ext/B/README' 'perl5.005_03/ext/B/README'
Index: ./ext/B/README
*** ./ext/B/README Thu Jul 23 23:00:00 1998
--- ./ext/B/README Sun Oct 25 08:25:46 1998
***************
*** 20,27 ****
in the file named "Artistic". If not, you can get one from the Perl
distribution. You should also have received a copy of the GNU General
Public License, in the file named "Copying". If not, you can get one
! from the Perl distribution or else write to the Free Software
! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
CHANGES
--- 20,27 ----
in the file named "Artistic". If not, you can get one from the Perl
distribution. You should also have received a copy of the GNU General
Public License, in the file named "Copying". If not, you can get one
! from the Perl distribution or else write to the Free Software Foundation,
! Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
CHANGES
diff -c 'perl5.005_02/ext/DB_File/Changes' 'perl5.005_03/ext/DB_File/Changes'
Index: ./ext/DB_File/Changes
*** ./ext/DB_File/Changes Thu Jul 23 23:00:01 1998
--- ./ext/DB_File/Changes Wed Mar 17 18:05:56 1999
***************
*** 203,205 ****
--- 203,234 ----
1.60
Changed the test to check for full tied array support
+
+ 1.61 19th November 1998
+
+ Added a note to README about how to build Berkeley DB 2.x when
+ using HP-UX.
+ Minor modifications to get the module to build with DB 2.5.x
+ Fixed a typo in the definition of O_RDONLY, courtesy of Mark Kettenis.
+
+ 1.62 30th November 1998
+
+ Added hints/dynixptx.pl.
+ Fixed typemap -- 1.61 used PL_na instead of na
+
+ 1.63 19th December 1998
+
+ * Fix to allow DB 2.6.x to build with DB_File
+ * Documentation updated to use push,pop etc in the RECNO example &
+ to include the find_dup & del_dup methods.
+
+ 1.64 21st February 1999
+
+ * Tidied the 1.x to 2.x flag mapping code.
+ * Added a patch from Mark Kettenis <kettenis@wins.uva.nl> to fix a flag
+ mapping problem with O_RDONLY on the Hurd
+ * Updated the message that db-recno.t prints when tests 51, 53 or 55 fail.
+
+ 1.65 6th March 1999
+ * Fixed a bug in the recno PUSH logic.
+ * The BOOT version check now needs 2.3.4 when using Berkeley DB version 2
diff -c 'perl5.005_02/ext/DB_File/DB_File.pm' 'perl5.005_03/ext/DB_File/DB_File.pm'
Index: ./ext/DB_File/DB_File.pm
*** ./ext/DB_File/DB_File.pm Thu Jul 23 23:00:02 1998
--- ./ext/DB_File/DB_File.pm Wed Mar 17 18:05:58 1999
***************
*** 1,10 ****
# DB_File.pm -- Perl 5 interface to Berkeley DB
#
! # written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
! # last modified 16th May 1998
! # version 1.60
#
! # Copyright (c) 1995-8 Paul Marquess. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
--- 1,10 ----
# DB_File.pm -- Perl 5 interface to Berkeley DB
#
! # written by Paul Marquess (Paul.Marquess@btinternet.com)
! # last modified 6th March 1999
! # version 1.65
#
! # Copyright (c) 1995-9 Paul Marquess. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
***************
*** 145,151 ****
use Carp;
! $VERSION = "1.60" ;
#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
$DB_BTREE = new DB_File::BTREEINFO ;
--- 145,151 ----
use Carp;
! $VERSION = "1.65" ;
#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
$DB_BTREE = new DB_File::BTREEINFO ;
***************
*** 300,305 ****
--- 300,339 ----
}
}
+ sub find_dup
+ {
+ croak "Usage: \$db->find_dup(key,value)\n"
+ unless @_ == 3 ;
+
+ my $db = shift ;
+ my ($origkey, $value_wanted) = @_ ;
+ my ($key, $value) = ($origkey, 0);
+ my ($status) = 0 ;
+
+ for ($status = $db->seq($key, $value, R_CURSOR() ) ;
+ $status == 0 ;
+ $status = $db->seq($key, $value, R_NEXT() ) ) {
+
+ return 0 if $key eq $origkey and $value eq $value_wanted ;
+ }
+
+ return $status ;
+ }
+
+ sub del_dup
+ {
+ croak "Usage: \$db->del_dup(key,value)\n"
+ unless @_ == 3 ;
+
+ my $db = shift ;
+ my ($key, $value) = @_ ;
+ my ($status) = $db->find_dup($key, $value) ;
+ return $status if $status != 0 ;
+
+ $status = $db->del($key, R_CURSOR() ) ;
+ return $status ;
+ }
+
sub get_dup
{
croak "Usage: \$db->get_dup(key [,flag])\n"
***************
*** 364,369 ****
--- 398,405 ----
$count = $X->get_dup($key) ;
@list = $X->get_dup($key) ;
%list = $X->get_dup($key, 1) ;
+ $status = $X->find_dup($key, $value) ;
+ $status = $X->del_dup($key, $value) ;
# RECNO only
$a = $X->length;
***************
*** 443,453 ****
B<Note:> The database file format has changed in Berkeley DB version 2.
If you cannot recreate your databases, you must dump any existing
databases with the C<db_dump185> utility that comes with Berkeley DB.
! Once you have upgraded DB_File to use Berkeley DB version 2, your
databases can be recreated using C<db_load>. Refer to the Berkeley DB
documentation for further details.
! Please read L<COPYRIGHT> before using version 2.x of Berkeley DB with
DB_File.
=head2 Interface to Berkeley DB
--- 479,489 ----
B<Note:> The database file format has changed in Berkeley DB version 2.
If you cannot recreate your databases, you must dump any existing
databases with the C<db_dump185> utility that comes with Berkeley DB.
! Once you have rebuilt DB_File to use Berkeley DB version 2, your
databases can be recreated using C<db_load>. Refer to the Berkeley DB
documentation for further details.
! Please read L<"COPYRIGHT"> before using version 2.x of Berkeley DB with
DB_File.
=head2 Interface to Berkeley DB
***************
*** 837,845 ****
This time we have got all the key/value pairs, including the multiple
values associated with the key C<Wall>.
=head2 The get_dup() Method
! B<DB_File> comes with a utility method, called C<get_dup>, to assist in
reading duplicate values from BTREE databases. The method can take the
following forms:
--- 873,884 ----
This time we have got all the key/value pairs, including the multiple
values associated with the key C<Wall>.
+ To make life easier when dealing with duplicate keys, B<DB_File> comes with
+ a few utility methods.
+
=head2 The get_dup() Method
! The C<get_dup> method assists in
reading duplicate values from BTREE databases. The method can take the
following forms:
***************
*** 888,893 ****
--- 927,1005 ----
Smith => [John]
Dog => []
+ =head2 The find_dup() Method
+
+ $status = $X->find_dup($key, $value) ;
+
+ This method checks for the existance of a specific key/value pair. If the
+ pair exists, the cursor is left pointing to the pair and the method
+ returns 0. Otherwise the method returns a non-zero value.
+
+ Assuming the database from the previous example:
+
+ use strict ;
+ use DB_File ;
+
+ use vars qw($filename $x %h $found) ;
+
+ my $filename = "tree" ;
+
+ # Enable duplicate records
+ $DB_BTREE->{'flags'} = R_DUP ;
+
+ $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
+ or die "Cannot open $filename: $!\n";
+
+ $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
+ print "Larry Wall is $found there\n" ;
+
+ $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ;
+ print "Harry Wall is $found there\n" ;
+
+ undef $x ;
+ untie %h ;
+
+ prints this
+
+ Larry Wall is there
+ Harry Wall is not there
+
+
+ =head2 The del_dup() Method
+
+ $status = $X->del_dup($key, $value) ;
+
+ This method deletes a specific key/value pair. It returns
+ 0 if they exist and have been deleted successfully.
+ Otherwise the method returns a non-zero value.
+
+ Again assuming the existance of the C<tree> database
+
+ use strict ;
+ use DB_File ;
+
+ use vars qw($filename $x %h $found) ;
+
+ my $filename = "tree" ;
+
+ # Enable duplicate records
+ $DB_BTREE->{'flags'} = R_DUP ;
+
+ $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
+ or die "Cannot open $filename: $!\n";
+
+ $x->del_dup("Wall", "Larry") ;
+
+ $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
+ print "Larry Wall is $found there\n" ;
+
+ undef $x ;
+ untie %h ;
+
+ prints this
+
+ Larry Wall is not there
+
=head2 Matching Partial Keys
The BTREE interface has a feature which allows partial keys to be
***************
*** 970,976 ****
DB_RECNO provides an interface to flat text files. Both variable and
fixed length records are supported.
! In order to make RECNO more compatible with Perl the array offset for
all RECNO arrays begins at 0 rather than 1 as in Berkeley DB.
As with normal Perl arrays, a RECNO array can be accessed using
--- 1082,1088 ----
DB_RECNO provides an interface to flat text files. Both variable and
fixed length records are supported.
! In order to make RECNO more compatible with Perl, the array offset for
all RECNO arrays begins at 0 rather than 1 as in Berkeley DB.
As with normal Perl arrays, a RECNO array can be accessed using
***************
*** 999,1005 ****
That clarifies the situation with regards Berkeley DB itself. What
about B<DB_File>? Well, the behavior defined in the quote above is
! quite useful, so B<DB_File> conforms it.
That means that you can specify other options (e.g. cachesize) and
still have bval default to C<"\n"> for variable length records, and
--- 1111,1117 ----
That clarifies the situation with regards Berkeley DB itself. What
about B<DB_File>? Well, the behavior defined in the quote above is
! quite useful, so B<DB_File> conforms to it.
That means that you can specify other options (e.g. cachesize) and
still have bval default to C<"\n"> for variable length records, and
***************
*** 1007,1013 ****
=head2 A Simple Example
! Here is a simple example that uses RECNO.
use strict ;
use DB_File ;
--- 1119,1127 ----
=head2 A Simple Example
! Here is a simple example that uses RECNO (if you are using a version
! of Perl earlier than 5.004_57 this example won't work -- see
! L<Extra RECNO Methods> for a workaround).
use strict ;
use DB_File ;
***************
*** 1021,1026 ****
--- 1135,1152 ----
$h[1] = "blue" ;
$h[2] = "yellow" ;
+ push @h, "green", "black" ;
+
+ my $elements = scalar @h ;
+ print "The array contains $elements entries\n" ;
+
+ my $last = pop @h ;
+ print "popped $last\n" ;
+
+ unshift @h, "white" ;
+ my $first = shift @h ;
+ print "shifted $first\n" ;
+
# Check for existence of a key
print "Element 1 Exists with value $h[1]\n" if $h[1] ;
***************
*** 1032,1048 ****
Here is the output from the script:
!
Element 1 Exists with value blue
! The last element is yellow
! The 2nd last element is blue
! =head2 Extra Methods
If you are using a version of Perl earlier than 5.004_57, the tied
! array interface is quite limited. The example script above will work,
! but you won't be able to use C<push>, C<pop>, C<shift>, C<unshift>
! etc. with the tied array.
To make the interface more useful for older versions of Perl, a number
of methods are supplied with B<DB_File> to simulate the missing array
--- 1158,1176 ----
Here is the output from the script:
! The array contains 5 entries
! popped black
! unshifted white
Element 1 Exists with value blue
! The last element is green
! The 2nd last element is yellow
! =head2 Extra RECNO Methods
If you are using a version of Perl earlier than 5.004_57, the tied
! array interface is quite limited. In the example script above
! C<push>, C<pop>, C<shift>, C<unshift>
! or determining the array length will not work with a tied array.
To make the interface more useful for older versions of Perl, a number
of methods are supplied with B<DB_File> to simulate the missing array
***************
*** 1657,1663 ****
=head1 COPYRIGHT
! Copyright (c) 1995-8 Paul Marquess. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.
--- 1785,1791 ----
=head1 COPYRIGHT
! Copyright (c) 1995-9 Paul Marquess. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.
***************
*** 1688,1694 ****
=head1 AUTHOR
The DB_File interface was written by Paul Marquess
! E<lt>pmarquess@bfsec.bt.co.ukE<gt>.
Questions about the DB system itself may be addressed to
E<lt>db@sleepycat.com<gt>.
--- 1816,1822 ----
=head1 AUTHOR
The DB_File interface was written by Paul Marquess
! E<lt>Paul.Marquess@btinternet.comE<gt>.
Questions about the DB system itself may be addressed to
E<lt>db@sleepycat.com<gt>.
diff -c 'perl5.005_02/ext/DB_File/DB_File.xs' 'perl5.005_03/ext/DB_File/DB_File.xs'
Index: ./ext/DB_File/DB_File.xs
*** ./ext/DB_File/DB_File.xs Thu Jul 23 23:00:03 1998
--- ./ext/DB_File/DB_File.xs Wed Mar 17 18:05:59 1999
***************
*** 2,14 ****
DB_File.xs -- Perl 5 interface to Berkeley DB
! written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
! last modified 16th May 1998
! version 1.60
All comments/suggestions/problems are welcome
! Copyright (c) 1995, 1996, 1997, 1998 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
--- 2,14 ----
DB_File.xs -- Perl 5 interface to Berkeley DB
! written by Paul Marquess <Paul.Marquess@btinternet.com>
! last modified 6th March 1999
! version 1.65
All comments/suggestions/problems are welcome
! Copyright (c) 1995-9 Paul Marquess. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
***************
*** 56,61 ****
--- 56,70 ----
This was ok for DB 1.x, but isn't for DB 2.x.
1.59 - No change to DB_File.xs
1.60 - Some code tidy up
+ 1.61 - added flagSet macro for DB 2.5.x
+ fixed typo in O_RDONLY test.
+ 1.62 - No change to DB_File.xs
+ 1.63 - Fix to alllow DB 2.6.x to build.
+ 1.64 - Tidied up the 1.x to 2.x flags mapping code.
+ Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
+ to fix a flag mapping problem with O_RDONLY on the Hurd
+ 1.65 - Fixed a bug in the PUSH logic.
+ Added BOOT check that using 2.3.4 or greater
***************
*** 65,70 ****
--- 74,93 ----
#include "perl.h"
#include "XSUB.h"
+ #ifndef PERL_VERSION
+ #include "patchlevel.h"
+ #define PERL_REVISION 5
+ #define PERL_VERSION PATCHLEVEL
+ #define PERL_SUBVERSION SUBVERSION
+ #endif
+
+ #if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
+
+ # define PL_sv_undef sv_undef
+ # define PL_na na
+
+ #endif
+
/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
* shortly #included by the <db.h>) __attribute__ to the possibly
* already defined __attribute__, for example by GNUC or by Perl. */
***************
*** 153,158 ****
--- 176,187 ----
#define DBT_flags(x) x.flags = 0
#define DB_flags(x, v) x |= v
+ #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
+ #define flagSet(flags, bitmask) ((flags) & (bitmask))
+ #else
+ #define flagSet(flags, bitmask) (((flags) & DB_OPFLAGS_MASK) == (bitmask))
+ #endif
+
#else /* db version 1.x */
typedef union INFO {
***************
*** 205,210 ****
--- 234,240 ----
#define do_SEQ(db, key, value, flag) (db->dbp->seq)(db->dbp, &key, &value, flag)
#define DBT_flags(x)
#define DB_flags(x, v)
+ #define flagSet(flags, bitmask) ((flags) & (bitmask))
#endif /* db version 1 */
***************
*** 216,225 ****
#define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
#define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
#ifdef DB_VERSION_MAJOR
#define db_DESTROY(db) ((db->dbp)->close)(db->dbp, 0)
#define db_close(db) ((db->dbp)->close)(db->dbp, 0)
! #define db_del(db, key, flags) ((flags & R_CURSOR) \
? ((db->cursor)->c_del)(db->cursor, 0) \
: ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
--- 246,256 ----
#define db_sync(db, flags) ((db->dbp)->sync)(db->dbp, flags)
#define db_get(db, key, value, flags) ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
+
#ifdef DB_VERSION_MAJOR
#define db_DESTROY(db) ((db->dbp)->close)(db->dbp, 0)
#define db_close(db) ((db->dbp)->close)(db->dbp, 0)
! #define db_del(db, key, flags) (flagSet(flags, R_CURSOR) \
? ((db->cursor)->c_del)(db->cursor, 0) \
: ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
***************
*** 232,237 ****
--- 263,269 ----
#endif
+
#define db_seq(db, key, value, flags) do_SEQ(db, key, value, flags)
typedef struct {
***************
*** 288,299 ****
{
int status ;
! if (flags & R_CURSOR) {
status = ((db->cursor)->c_del)(db->cursor, 0);
if (status != 0)
return status ;
flags &= ~R_CURSOR ;
}
return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
--- 320,336 ----
{
int status ;
! if (flagSet(flags, R_CURSOR)) {
status = ((db->cursor)->c_del)(db->cursor, 0);
if (status != 0)
return status ;
+ #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
flags &= ~R_CURSOR ;
+ #else
+ flags &= ~DB_OPFLAGS_MASK ;
+ #endif
+
}
return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
***************
*** 311,322 ****
(void)db_version(&Major, &Minor, &Patch) ;
! /* check that libdb is recent enough */
! if (Major == 2 && Minor == 0 && Patch < 5)
! croak("DB_File needs Berkeley DB 2.0.5 or greater, you have %d.%d.%d\n",
Major, Minor, Patch) ;
! #if PATCHLEVEL > 3
sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
#else
{
--- 348,359 ----
(void)db_version(&Major, &Minor, &Patch) ;
! /* check that libdb is recent enough -- we need 2.3.4 or greater */
! if (Major == 2 && (Minor < 3 || (Minor == 3 && Patch < 4)))
! croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
Major, Minor, Patch) ;
! #if PERL_VERSION > 3
sv_setpvf(ver_sv, "%d.%d", Major, Minor) ;
#else
{
***************
*** 577,582 ****
--- 614,620 ----
DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
void * openinfo = NULL ;
INFO * info = &RETVAL->info ;
+ STRLEN n_a;
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
Zero(RETVAL, 1, DB_File_type) ;
***************
*** 718,728 ****
#endif
svp = hv_fetch(action, "bfname", 6, FALSE);
if (svp && SvOK(*svp)) {
! char * ptr = SvPV(*svp,PL_na) ;
#ifdef DB_VERSION_MAJOR
! name = (char*) PL_na ? ptr : NULL ;
#else
! info->db_RE_bfname = (char*) (PL_na ? ptr : NULL) ;
#endif
}
else
--- 756,766 ----
#endif
svp = hv_fetch(action, "bfname", 6, FALSE);
if (svp && SvOK(*svp)) {
! char * ptr = SvPV(*svp,n_a) ;
#ifdef DB_VERSION_MAJOR
! name = (char*) n_a ? ptr : NULL ;
#else
! info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
#endif
}
else
***************
*** 738,744 ****
{
int value ;
if (SvPOK(*svp))
! value = (int)*SvPV(*svp, PL_na) ;
else
value = SvIV(*svp) ;
--- 776,782 ----
{
int value ;
if (SvPOK(*svp))
! value = (int)*SvPV(*svp, n_a) ;
else
value = SvIV(*svp) ;
***************
*** 756,762 ****
if (svp && SvOK(*svp))
{
if (SvPOK(*svp))
! info->db_RE_bval = (u_char)*SvPV(*svp, PL_na) ;
else
info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
DB_flags(info->flags, DB_DELIMITER) ;
--- 794,800 ----
if (svp && SvOK(*svp))
{
if (SvPOK(*svp))
! info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
else
info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
DB_flags(info->flags, DB_DELIMITER) ;
***************
*** 800,825 ****
if ((flags & O_CREAT) == O_CREAT)
Flags |= DB_CREATE ;
- #ifdef O_NONBLOCK
- if ((flags & O_NONBLOCK) == O_NONBLOCK)
- Flags |= DB_EXCL ;
- #endif
-
#if O_RDONLY == 0
if (flags == O_RDONLY)
#else
! if (flags & O_RDONLY) == O_RDONLY)
#endif
Flags |= DB_RDONLY ;
! #ifdef O_NONBLOCK
if ((flags & O_TRUNC) == O_TRUNC)
Flags |= DB_TRUNCATE ;
#endif
status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
if (status == 0)
status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
if (status)
RETVAL->dbp = NULL ;
--- 838,863 ----
if ((flags & O_CREAT) == O_CREAT)
Flags |= DB_CREATE ;
#if O_RDONLY == 0
if (flags == O_RDONLY)
#else
! if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
#endif
Flags |= DB_RDONLY ;
! #ifdef O_TRUNC
if ((flags & O_TRUNC) == O_TRUNC)
Flags |= DB_TRUNCATE ;
#endif
status = db_open(name, RETVAL->type, Flags, mode, NULL, openinfo, &RETVAL->dbp) ;
if (status == 0)
+ #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
+ #else
+ status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
+ 0) ;
+ #endif
if (status)
RETVAL->dbp = NULL ;
***************
*** 1100,1108 ****
{
char * name = (char *) NULL ;
SV * sv = (SV *) NULL ;
if (items >= 3 && SvOK(ST(2)))
! name = (char*) SvPV(ST(2), PL_na) ;
if (items == 6)
sv = ST(5) ;
--- 1138,1147 ----
{
char * name = (char *) NULL ;
SV * sv = (SV *) NULL ;
+ STRLEN n_a;
if (items >= 3 && SvOK(ST(2)))
! name = (char*) SvPV(ST(2), n_a) ;
if (items == 6)
sv = ST(5) ;
***************
*** 1191,1197 ****
{
DBTKEY key ;
DBT value ;
- DB * Db = db->dbp ;
DBT_flags(key) ;
DBT_flags(value) ;
--- 1230,1235 ----
***************
*** 1208,1214 ****
CODE:
{
DBT value ;
- DB * Db = db->dbp ;
DBT_flags(value) ;
CurrentDB = db ;
--- 1246,1251 ----
***************
*** 1232,1237 ****
--- 1269,1275 ----
int i ;
int One ;
DB * Db = db->dbp ;
+ STRLEN n_a;
DBT_flags(key) ;
DBT_flags(value) ;
***************
*** 1245,1252 ****
#endif
for (i = items-1 ; i > 0 ; --i)
{
! value.data = SvPV(ST(i), PL_na) ;
! value.size = PL_na ;
One = 1 ;
key.data = &One ;
key.size = sizeof(int) ;
--- 1283,1290 ----
#endif
for (i = items-1 ; i > 0 ; --i)
{
! value.data = SvPV(ST(i), n_a) ;
! value.size = n_a ;
One = 1 ;
key.data = &One ;
key.size = sizeof(int) ;
***************
*** 1270,1276 ****
{
DBTKEY key ;
DBT value ;
- DB * Db = db->dbp ;
DBT_flags(key) ;
DBT_flags(value) ;
--- 1308,1313 ----
***************
*** 1298,1304 ****
{
DBT value ;
DBTKEY key ;
- DB * Db = db->dbp ;
DBT_flags(key) ;
DBT_flags(value) ;
--- 1335,1340 ----
***************
*** 1325,1366 ****
CODE:
{
DBTKEY key ;
- DBTKEY * keyptr = &key ;
DBT value ;
DB * Db = db->dbp ;
int i ;
DBT_flags(key) ;
DBT_flags(value) ;
CurrentDB = db ;
- /* Set the Cursor to the Last element */
- RETVAL = do_SEQ(db, key, value, R_LAST) ;
- if (RETVAL >= 0)
- {
- if (RETVAL == 1)
- keyptr = &empty ;
#ifdef DB_VERSION_MAJOR
for (i = 1 ; i < items ; ++i)
{
!
! ++ (* (int*)key.data) ;
! value.data = SvPV(ST(i), PL_na) ;
! value.size = PL_na ;
! RETVAL = (Db->put)(Db, NULL, &key, &value, 0) ;
if (RETVAL != 0)
break;
}
#else
for (i = items - 1 ; i > 0 ; --i)
{
! value.data = SvPV(ST(i), PL_na) ;
! value.size = PL_na ;
! RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
if (RETVAL != 0)
break;
}
- #endif
}
}
OUTPUT:
RETVAL
--- 1361,1402 ----
CODE:
{
DBTKEY key ;
DBT value ;
DB * Db = db->dbp ;
int i ;
+ STRLEN n_a;
DBT_flags(key) ;
DBT_flags(value) ;
CurrentDB = db ;
#ifdef DB_VERSION_MAJOR
+ RETVAL = 0 ;
+ key = empty ;
for (i = 1 ; i < items ; ++i)
{
! value.data = SvPV(ST(i), n_a) ;
! value.size = n_a ;
! RETVAL = (Db->put)(Db, NULL, &key, &value, DB_APPEND) ;
if (RETVAL != 0)
break;
}
#else
+ /* Set the Cursor to the Last element */
+ RETVAL = do_SEQ(db, key, value, R_LAST) ;
+ if (RETVAL >= 0)
+ {
+ if (RETVAL == 1)
+ key = empty ;
for (i = items - 1 ; i > 0 ; --i)
{
! value.data = SvPV(ST(i), n_a) ;
! value.size = n_a ;
! RETVAL = (Db->put)(Db, &key, &value, R_IAFTER) ;
if (RETVAL != 0)
break;
}
}
+ #endif
}
OUTPUT:
RETVAL
***************
*** 1436,1442 ****
#endif
OUTPUT:
RETVAL
! key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
int
db_fd(db)
--- 1472,1478 ----
#endif
OUTPUT:
RETVAL
! key if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
int
db_fd(db)
diff -c 'perl5.005_02/ext/DB_File/Makefile.PL' 'perl5.005_03/ext/DB_File/Makefile.PL'
Index: ./ext/DB_File/Makefile.PL
*** ./ext/DB_File/Makefile.PL Thu Jul 23 23:00:03 1998
--- ./ext/DB_File/Makefile.PL Thu Nov 26 20:12:09 1998
***************
*** 11,17 ****
WriteMakefile(
NAME => 'DB_File',
LIBS => ["-L/usr/local/lib $LIB"],
! MAN3PODS => ' ', # Pods will be built by installman.
#INC => '-I/usr/local/include',
VERSION_FROM => 'DB_File.pm',
XSPROTOARG => '-noprototypes',
--- 11,17 ----
WriteMakefile(
NAME => 'DB_File',
LIBS => ["-L/usr/local/lib $LIB"],
! MAN3PODS => {}, # Pods will be built by installman.
#INC => '-I/usr/local/include',
VERSION_FROM => 'DB_File.pm',
XSPROTOARG => '-noprototypes',
diff -c 'perl5.005_02/ext/DB_File/dbinfo' 'perl5.005_03/ext/DB_File/dbinfo'
Index: ./ext/DB_File/dbinfo
*** ./ext/DB_File/dbinfo Thu Jul 23 23:00:03 1998
--- ./ext/DB_File/dbinfo Sun Jan 17 19:24:24 1999
***************
*** 3,9 ****
# Name: dbinfo -- identify berkeley DB version used to create
# a database file
#
! # Author: Paul Marquess
# Version: 1.01
# Date 16th April 1998
#
--- 3,9 ----
# Name: dbinfo -- identify berkeley DB version used to create
# a database file
#
! # Author: Paul Marquess <Paul.Marquess@btinternet.com>
# Version: 1.01
# Date 16th April 1998
#
diff -c /dev/null 'perl5.005_03/ext/DB_File/hints/dynixptx.pl'
Index: ext/DB_File/hints/dynixptx.pl
*** ext/DB_File/hints/dynixptx.pl Wed Dec 31 18:00:00 1969
--- ext/DB_File/hints/dynixptx.pl Thu Nov 26 09:22:54 1998
***************
*** 0 ****
--- 1,3 ----
+ # Need to add an extra '-lc' to the end to work around a DYNIX/ptx bug
+
+ $self->{LIBS} = ['-lm -lc'];
diff -c 'perl5.005_02/ext/DB_File/typemap' 'perl5.005_03/ext/DB_File/typemap'
Index: ./ext/DB_File/typemap
*** ./ext/DB_File/typemap Thu Jul 23 23:00:03 1998
--- ./ext/DB_File/typemap Wed Mar 17 18:06:00 1999
***************
*** 1,8 ****
# typemap for Perl 5 interface to Berkeley
#
! # written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
! # last modified 13th May 1998
! # version 1.59
#
#################################### DB SECTION
#
--- 1,8 ----
# typemap for Perl 5 interface to Berkeley
#
! # written by Paul Marquess <Paul.Marquess@btinternet.com>
! # last modified 21st February 1999
! # version 1.65
#
#################################### DB SECTION
#
diff -c 'perl5.005_02/ext/Data/Dumper/Changes' 'perl5.005_03/ext/Data/Dumper/Changes'
Index: ./ext/Data/Dumper/Changes
*** ./ext/Data/Dumper/Changes Thu Jul 23 23:00:03 1998
--- ./ext/Data/Dumper/Changes Thu Nov 26 21:41:34 1998
***************
*** 6,11 ****
--- 6,29 ----
=over 8
+ =item 2.10 (31 Oct 1998)
+
+ Bugfixes for dumping related undef values, globs, and better double
+ quoting: three patches suggested by Gisle Aas <gisle@aas.no>.
+
+ Escaping of single quotes in the XS version could get tripped up
+ by the presence of nulls in the string. Fix suggested by
+ Slaven Rezic <eserte@cs.tu-berlin.de>.
+
+ Rather large scale reworking of the logic in how seen values
+ are stashed. Anonymous scalars that may be encountered while
+ traversing the structure are properly tracked, in case they become
+ used in data dumped in a later pass. There used to be a problem
+ with the previous logic that prevented such structures from being
+ dumped correctly.
+
+ Various additions to the testsuite.
+
=item 2.09 (9 July 1998)
Implement $Data::Dumper::Bless, suggested by Mark Daku <daku@nortel.ca>.
diff -c 'perl5.005_02/ext/Data/Dumper/Dumper.pm' 'perl5.005_03/ext/Data/Dumper/Dumper.pm'
Index: ./ext/Data/Dumper/Dumper.pm
*** ./ext/Data/Dumper/Dumper.pm Thu Jul 23 23:00:03 1998
--- ./ext/Data/Dumper/Dumper.pm Thu Feb 11 18:05:47 1999
***************
*** 9,15 ****
package Data::Dumper;
! $VERSION = $VERSION = '2.09';
#$| = 1;
--- 9,15 ----
package Data::Dumper;
! $VERSION = $VERSION = '2.101';
#$| = 1;
***************
*** 208,215 ****
my($sname);
my($out, $realpack, $realtype, $type, $ipad, $id, $blesspad);
- return "undef" unless defined $val;
-
$type = ref $val;
$out = "";
--- 208,213 ----
***************
*** 218,264 ****
# prep it, if it looks like an object
if ($type =~ /[a-z_:]/) {
my $freezer = $s->{freezer};
! # UNIVERSAL::can should be used here, when we can require 5.004
! if ($freezer) {
! eval { $val->$freezer() };
! carp "WARNING(Freezer method call failed): $@" if $@;
! }
}
($realpack, $realtype, $id) =
(overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
! # keep a tab on it so that we dont fall into recursive pit
! if (exists $s->{seen}{$id}) {
! # if ($s->{expdepth} < $s->{level}) {
! if ($s->{purity} and $s->{level} > 0) {
! $out = ($realtype eq 'HASH') ? '{}' :
! ($realtype eq 'ARRAY') ? '[]' :
! "''" ;
! push @post, $name . " = " . $s->{seen}{$id}[0];
! }
! else {
! $out = $s->{seen}{$id}[0];
! if ($name =~ /^([\@\%])/) {
! my $start = $1;
! if ($out =~ /^\\$start/) {
! $out = substr($out, 1);
}
else {
! $out = $start . '{' . $out . '}';
! }
! }
}
- return $out;
- # }
- }
- else {
- # store our name
- $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) :
- ($realtype eq 'CODE' and
- $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) :
- $name ),
- $val ];
}
$s->{level}++;
--- 216,262 ----
# prep it, if it looks like an object
if ($type =~ /[a-z_:]/) {
my $freezer = $s->{freezer};
! $val->$freezer() if $freezer && UNIVERSAL::can($val, $freezer);
}
($realpack, $realtype, $id) =
(overload::StrVal($val) =~ /^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$/);
! # if it has a name, we need to either look it up, or keep a tab
! # on it so we know when we hit it later
! if (defined($name) and length($name)) {
! # keep a tab on it so that we dont fall into recursive pit
! if (exists $s->{seen}{$id}) {
! # if ($s->{expdepth} < $s->{level}) {
! if ($s->{purity} and $s->{level} > 0) {
! $out = ($realtype eq 'HASH') ? '{}' :
! ($realtype eq 'ARRAY') ? '[]' :
! "''" ;
! push @post, $name . " = " . $s->{seen}{$id}[0];
}
else {
! $out = $s->{seen}{$id}[0];
! if ($name =~ /^([\@\%])/) {
! my $start = $1;
! if ($out =~ /^\\$start/) {
! $out = substr($out, 1);
! }
! else {
! $out = $start . '{' . $out . '}';
! }
! }
! }
! return $out;
! # }
! }
! else {
! # store our name
! $s->{seen}{$id} = [ (($name =~ /^[@%]/) ? ('\\' . $name ) :
! ($realtype eq 'CODE' and
! $name =~ /^[*](.*)$/) ? ('\\&' . $1 ) :
! $name ),
! $val ];
}
}
$s->{level}++;
***************
*** 272,285 ****
if ($realtype eq 'SCALAR') {
if ($realpack) {
! $out .= 'do{\\(my $o = ' . $s->_dump($$val, "") . ')}';
}
else {
! $out .= '\\' . $s->_dump($$val, "");
}
}
elsif ($realtype eq 'GLOB') {
! $out .= '\\' . $s->_dump($$val, "");
}
elsif ($realtype eq 'ARRAY') {
my($v, $pad, $mname);
--- 270,283 ----
if ($realtype eq 'SCALAR') {
if ($realpack) {
! $out .= 'do{\\(my $o = ' . $s->_dump($$val, "\${$name}") . ')}';
}
else {
! $out .= '\\' . $s->_dump($$val, "\${$name}");
}
}
elsif ($realtype eq 'GLOB') {
! $out .= '\\' . $s->_dump($$val, "*{$name}");
}
elsif ($realtype eq 'ARRAY') {
my($v, $pad, $mname);
***************
*** 287,293 ****
$out .= ($name =~ /^\@/) ? '(' : '[';
$pad = $s->{sep} . $s->{pad} . $s->{apad};
($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) :
! ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
$mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
for $v (@$val) {
$sname = $mname . '[' . $i . ']';
--- 285,293 ----
$out .= ($name =~ /^\@/) ? '(' : '[';
$pad = $s->{sep} . $s->{pad} . $s->{apad};
($name =~ /^\@(.*)$/) ? ($mname = "\$" . $1) :
! # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
! ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
! ($mname = $name . '->');
$mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
for $v (@$val) {
$sname = $mname . '[' . $i . ']';
***************
*** 303,310 ****
$out .= ($name =~ /^\%/) ? '(' : '{';
$pad = $s->{sep} . $s->{pad} . $s->{apad};
$lpad = $s->{apad};
! ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
! ($name =~ /[]}]$/) ? ($mname = $name) : ($mname = $name . '->');
$mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
while (($k, $v) = each %$val) {
my $nk = $s->_dump($k, "");
--- 303,312 ----
$out .= ($name =~ /^\%/) ? '(' : '{';
$pad = $s->{sep} . $s->{pad} . $s->{apad};
$lpad = $s->{apad};
! ($name =~ /^\%(.*)$/) ? ($mname = "\$" . $1) :
! # omit -> if $foo->[0]->{bar}, but not ${$foo->[0]}->{bar}
! ($name =~ /^\\?[\%\@\*\$][^{].*[]}]$/) ? ($mname = $name) :
! ($mname = $name . '->');
$mname .= '->' if $mname =~ /^\*.+\{[A-Z]+\}$/;
while (($k, $v) = each %$val) {
my $nk = $s->_dump($k, "");
***************
*** 324,331 ****
$out .= ($name =~ /^\%/) ? ')' : '}';
}
elsif ($realtype eq 'CODE') {
! $out .= '"DUMMY"';
! $out = 'sub { ' . $out . ' }';
carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
}
else {
--- 326,332 ----
$out .= ($name =~ /^\%/) ? ')' : '}';
}
elsif ($realtype eq 'CODE') {
! $out .= 'sub { "DUMMY" }';
carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
}
else {
***************
*** 347,357 ****
if ($name ne '') {
($id) = ("$ref" =~ /\(([^\(]*)\)$/);
if (exists $s->{seen}{$id}) {
! $out = $s->{seen}{$id}[0];
! return $out;
}
else {
! $s->{seen}{$id} = ["\\$name", $val];
}
}
if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob
--- 348,362 ----
if ($name ne '') {
($id) = ("$ref" =~ /\(([^\(]*)\)$/);
if (exists $s->{seen}{$id}) {
! if ($s->{seen}{$id}[2]) {
! $out = $s->{seen}{$id}[0];
! #warn "[<$out]\n";
! return "\${$out}";
! }
}
else {
! #warn "[>\\$name]\n";
! $s->{seen}{$id} = ["\\$name", $ref];
}
}
if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) { # glob
***************
*** 368,388 ****
my $k;
local ($s->{level}) = 0;
for $k (qw(SCALAR ARRAY HASH)) {
# _dump can push into @post, so we hold our place using $postlen
my $postlen = scalar @post;
$post[$postlen] = "\*$sname = ";
local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
! $post[$postlen] .= $s->_dump(*{$name}{$k}, "\*$sname\{$k\}");
}
}
$out .= '*' . $sname;
}
elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number
$out .= $val;
}
else { # string
if ($s->{useqq}) {
! $out .= qquote($val);
}
else {
$val =~ s/([\\\'])/\\$1/g;
--- 373,400 ----
my $k;
local ($s->{level}) = 0;
for $k (qw(SCALAR ARRAY HASH)) {
+ my $gval = *$val{$k};
+ next unless defined $gval;
+ next if $k eq "SCALAR" && ! defined $$gval; # always there
+
# _dump can push into @post, so we hold our place using $postlen
my $postlen = scalar @post;
$post[$postlen] = "\*$sname = ";
local ($s->{apad}) = " " x length($post[$postlen]) if $s->{indent} >= 2;
! $post[$postlen] .= $s->_dump($gval, "\*$sname\{$k\}");
}
}
$out .= '*' . $sname;
}
+ elsif (!defined($val)) {
+ $out .= "undef";
+ }
elsif ($val =~ /^-?[1-9]\d{0,8}$/) { # safe decimal number
$out .= $val;
}
else { # string
if ($s->{useqq}) {
! $out .= qquote($val, $s->{useqq});
}
else {
$val =~ s/([\\\'])/\\$1/g;
***************
*** 390,399 ****
}
}
}
!
! # if we made it this far, $id was added to seen list at current
! # level, so remove it to get deep copies
! delete($s->{seen}{$id}) if $id and $s->{deepcopy};
return $out;
}
--- 402,417 ----
}
}
}
! if ($id) {
! # if we made it this far, $id was added to seen list at current
! # level, so remove it to get deep copies
! if ($s->{deepcopy}) {
! delete($s->{seen}{$id});
! }
! elsif ($name) {
! $s->{seen}{$id}[2] = 1;
! }
! }
return $out;
}
***************
*** 493,514 ****
defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
}
# put a string value in double quotes
sub qquote {
local($_) = shift;
! s/([\\\"\@\$\%])/\\$1/g;
! s/\a/\\a/g;
! s/[\b]/\\b/g;
! s/\t/\\t/g;
! s/\n/\\n/g;
! s/\f/\\f/g;
! s/\r/\\r/g;
! s/\e/\\e/g;
!
! # this won't work!
! # s/([^\a\b\t\n\f\r\e\038-\176])/'\\'.sprintf('%03o',ord($1))/eg;
! s/([\000-\006\013\016-\032\034-\037\177\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
! return "\"$_\"";
}
1;
--- 511,551 ----
defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
}
+ # used by qquote below
+ my %esc = (
+ "\a" => "\\a",
+ "\b" => "\\b",
+ "\t" => "\\t",
+ "\n" => "\\n",
+ "\f" => "\\f",
+ "\r" => "\\r",
+ "\e" => "\\e",
+ );
+
# put a string value in double quotes
sub qquote {
local($_) = shift;
! s/([\\\"\@\$])/\\$1/g;
! return qq("$_") unless /[^\040-\176]/; # fast exit
!
! my $high = shift || "";
! s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
!
! # no need for 3 digits in escape for these
! s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
!
! s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
! if ($high eq "iso8859") {
! s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
! } elsif ($high eq "utf8") {
! # use utf8;
! # $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
! } elsif ($high eq "8bit") {
! # leave it as it is
! } else {
! s/([\0-\037\177-\377])/'\\'.sprintf('%03o',ord($1))/eg;
! }
! return qq("$_");
}
1;
***************
*** 954,960 ****
=head1 VERSION
! Version 2.09 (9 July 1998)
=head1 SEE ALSO
--- 991,997 ----
=head1 VERSION
! Version 2.10 (31 Oct 1998)
=head1 SEE ALSO
diff -c 'perl5.005_02/ext/Data/Dumper/Dumper.xs' 'perl5.005_03/ext/Data/Dumper/Dumper.xs'
Index: ./ext/Data/Dumper/Dumper.xs
*** ./ext/Data/Dumper/Dumper.xs Sun Aug 2 02:01:28 1998
--- ./ext/Data/Dumper/Dumper.xs Thu Nov 26 21:43:08 1998
***************
*** 2,9 ****
#include "perl.h"
#include "XSUB.h"
! static SV *freezer;
! static SV *toaster;
static I32 num_q _((char *s, STRLEN slen));
static I32 esc_q _((char *dest, char *src, STRLEN slen));
--- 2,20 ----
#include "perl.h"
#include "XSUB.h"
! #include "patchlevel.h"
!
! #if PATCHLEVEL < 5
! # ifndef PL_sv_undef
! # define PL_sv_undef sv_undef
! # endif
! # ifndef ERRSV
! # define ERRSV GvSV(errgv)
! # endif
! # ifndef newSVpvn
! # define newSVpvn newSVpv
! # endif
! #endif
static I32 num_q _((char *s, STRLEN slen));
static I32 esc_q _((char *dest, char *src, STRLEN slen));
***************
*** 84,90 ****
sv_x(SV *sv, register char *str, STRLEN len, I32 n)
{
if (sv == Nullsv)
! sv = newSVpv("", 0);
else
assert(SvTYPE(sv) >= SVt_PV);
--- 95,101 ----
sv_x(SV *sv, register char *str, STRLEN len, I32 n)
{
if (sv == Nullsv)
! sv = newSVpvn("", 0);
else
assert(SvTYPE(sv) >= SVt_PV);
***************
*** 121,131 ****
U32 i;
char *c, *r, *realpack, id[128];
SV **svp;
! SV *sv;
SV *blesspad = Nullsv;
! SV *ipad;
! SV *ival;
! AV *seenentry;
char *iname;
STRLEN inamelen, idlen = 0;
U32 flags;
--- 132,140 ----
U32 i;
char *c, *r, *realpack, id[128];
SV **svp;
! SV *sv, *ipad, *ival;
SV *blesspad = Nullsv;
! AV *seenentry = Nullav;
char *iname;
STRLEN inamelen, idlen = 0;
U32 flags;
***************
*** 139,148 ****
if (SvGMAGICAL(val))
mg_get(val);
- if (val == &PL_sv_undef || !SvOK(val)) {
- sv_catpvn(retval, "undef", 5);
- return 1;
- }
if (SvROK(val)) {
if (SvOBJECT(SvRV(val)) && freezer &&
--- 148,153 ----
***************
*** 152,160 ****
XPUSHs(val); PUTBACK;
i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR);
SPAGAIN;
! if (SvTRUE(GvSV(PL_errgv)))
warn("WARNING(Freezer method call failed): %s",
! SvPVX(GvSV(PL_errgv)));
else if (i)
val = newSVsv(POPs);
PUTBACK; FREETMPS; LEAVE;
--- 157,165 ----
XPUSHs(val); PUTBACK;
i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR);
SPAGAIN;
! if (SvTRUE(ERRSV))
warn("WARNING(Freezer method call failed): %s",
! SvPVX(ERRSV));
else if (i)
val = newSVsv(POPs);
PUTBACK; FREETMPS; LEAVE;
***************
*** 171,237 ****
realpack = HvNAME(SvSTASH(ival));
else
realpack = Nullch;
! if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) &&
! (sv = *svp) && SvROK(sv) &&
! (seenentry = (AV*)SvRV(sv))) {
! SV *othername;
! if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) {
! if (purity && *levelp > 0) {
! SV *postentry;
!
! if (realtype == SVt_PVHV)
! sv_catpvn(retval, "{}", 2);
! else if (realtype == SVt_PVAV)
! sv_catpvn(retval, "[]", 2);
! else
! sv_catpvn(retval, "''", 2);
! postentry = newSVpv(name, namelen);
! sv_catpvn(postentry, " = ", 3);
! sv_catsv(postentry, othername);
! av_push(postav, postentry);
! }
! else {
! if (name[0] == '@' || name[0] == '%') {
! if ((SvPVX(othername))[0] == '\\' &&
! (SvPVX(othername))[1] == name[0]) {
! sv_catpvn(retval, SvPVX(othername)+1, SvCUR(othername)-1);
}
! else {
! sv_catpvn(retval, name, 1);
! sv_catpvn(retval, "{", 1);
sv_catsv(retval, othername);
- sv_catpvn(retval, "}", 1);
- }
}
! else
! sv_catsv(retval, othername);
}
- return 1;
- }
- else {
- warn("ref name not found for %s", id);
- return 0;
- }
- }
- else { /* store our name and continue */
- SV *namesv;
- if (name[0] == '@' || name[0] == '%') {
- namesv = newSVpv("\\", 1);
- sv_catpvn(namesv, name, namelen);
}
! else if (realtype == SVt_PVCV && name[0] == '*') {
! namesv = newSVpv("\\", 2);
! sv_catpvn(namesv, name, namelen);
! (SvPVX(namesv))[1] = '&';
}
- else
- namesv = newSVpv(name, namelen);
- seenentry = newAV();
- av_push(seenentry, namesv);
- (void)SvREFCNT_inc(val);
- av_push(seenentry, val);
- (void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
- SvREFCNT_dec(seenentry);
}
(*levelp)++;
--- 176,252 ----
realpack = HvNAME(SvSTASH(ival));
else
realpack = Nullch;
!
! /* if it has a name, we need to either look it up, or keep a tab
! * on it so we know when we hit it later
! */
! if (namelen) {
! if ((svp = hv_fetch(seenhv, id, idlen, FALSE))
! && (sv = *svp) && SvROK(sv) && (seenentry = (AV*)SvRV(sv)))
! {
! SV *othername;
! if ((svp = av_fetch(seenentry, 0, FALSE))
! && (othername = *svp))
! {
! if (purity && *levelp > 0) {
! SV *postentry;
!
! if (realtype == SVt_PVHV)
! sv_catpvn(retval, "{}", 2);
! else if (realtype == SVt_PVAV)
! sv_catpvn(retval, "[]", 2);
! else
! sv_catpvn(retval, "''", 2);
! postentry = newSVpvn(name, namelen);
! sv_catpvn(postentry, " = ", 3);
! sv_catsv(postentry, othername);
! av_push(postav, postentry);
! }
! else {
! if (name[0] == '@' || name[0] == '%') {
! if ((SvPVX(othername))[0] == '\\' &&
! (SvPVX(othername))[1] == name[0]) {
! sv_catpvn(retval, SvPVX(othername)+1,
! SvCUR(othername)-1);
! }
! else {
! sv_catpvn(retval, name, 1);
! sv_catpvn(retval, "{", 1);
! sv_catsv(retval, othername);
! sv_catpvn(retval, "}", 1);
! }
}
! else
sv_catsv(retval, othername);
}
! return 1;
! }
! else {
! warn("ref name not found for %s", id);
! return 0;
}
}
! else { /* store our name and continue */
! SV *namesv;
! if (name[0] == '@' || name[0] == '%') {
! namesv = newSVpvn("\\", 1);
! sv_catpvn(namesv, name, namelen);
! }
! else if (realtype == SVt_PVCV && name[0] == '*') {
! namesv = newSVpvn("\\", 2);
! sv_catpvn(namesv, name, namelen);
! (SvPVX(namesv))[1] = '&';
! }
! else
! namesv = newSVpvn(name, namelen);
! seenentry = newAV();
! av_push(seenentry, namesv);
! (void)SvREFCNT_inc(val);
! av_push(seenentry, val);
! (void)hv_store(seenhv, id, strlen(id),
! newRV((SV*)seenentry), 0);
! SvREFCNT_dec(seenentry);
}
}
(*levelp)++;
***************
*** 249,268 ****
}
}
! if (realtype <= SVt_PVBM || realtype == SVt_PVGV) { /* scalars */
! if (realpack && realtype != SVt_PVGV) { /* blessed */
sv_catpvn(retval, "do{\\(my $o = ", 13);
! DD_dump(ival, "", 0, retval, seenhv, postav,
! levelp, indent, pad, xpad, apad, sep,
freezer, toaster, purity, deepcopy, quotekeys, bless);
sv_catpvn(retval, ")}", 2);
! }
else {
sv_catpvn(retval, "\\", 1);
! DD_dump(ival, "", 0, retval, seenhv, postav,
! levelp, indent, pad, xpad, apad, sep,
freezer, toaster, purity, deepcopy, quotekeys, bless);
}
}
else if (realtype == SVt_PVAV) {
SV *totpad;
--- 264,297 ----
}
}
! if (realtype <= SVt_PVBM) { /* scalar ref */
! SV *namesv = newSVpvn("${", 2);
! sv_catpvn(namesv, name, namelen);
! sv_catpvn(namesv, "}", 1);
! if (realpack) { /* blessed */
sv_catpvn(retval, "do{\\(my $o = ", 13);
! DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
! postav, levelp, indent, pad, xpad, apad, sep,
freezer, toaster, purity, deepcopy, quotekeys, bless);
sv_catpvn(retval, ")}", 2);
! } /* plain */
else {
sv_catpvn(retval, "\\", 1);
! DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
! postav, levelp, indent, pad, xpad, apad, sep,
freezer, toaster, purity, deepcopy, quotekeys, bless);
}
+ SvREFCNT_dec(namesv);
+ }
+ else if (realtype == SVt_PVGV) { /* glob ref */
+ SV *namesv = newSVpvn("*{", 2);
+ sv_catpvn(namesv, name, namelen);
+ sv_catpvn(namesv, "}", 1);
+ sv_catpvn(retval, "\\", 1);
+ DD_dump(ival, SvPVX(namesv), SvCUR(namesv), retval, seenhv,
+ postav, levelp, indent, pad, xpad, apad, sep,
+ freezer, toaster, purity, deepcopy, quotekeys, bless);
+ SvREFCNT_dec(namesv);
}
else if (realtype == SVt_PVAV) {
SV *totpad;
***************
*** 280,286 ****
}
else {
sv_catpvn(retval, "[", 1);
! if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') {
iname[inamelen++] = '-'; iname[inamelen++] = '>';
iname[inamelen] = '\0';
}
--- 309,324 ----
}
else {
sv_catpvn(retval, "[", 1);
! /* omit "->" in $foo{bar}->[0], but not in ${$foo}->[0] */
! /*if (namelen > 0
! && name[namelen-1] != ']' && name[namelen-1] != '}'
! && (namelen < 4 || (name[1] != '{' && name[2] != '{')))*/
! if ((namelen > 0
! && name[namelen-1] != ']' && name[namelen-1] != '}')
! || (namelen > 4
! && (name[1] == '{'
! || (name[0] == '\\' && name[2] == '{'))))
! {
iname[inamelen++] = '-'; iname[inamelen++] = '>';
iname[inamelen] = '\0';
}
***************
*** 346,359 ****
I32 klen;
SV *hval;
! iname = newSVpv(name, namelen);
if (name[0] == '%') {
sv_catpvn(retval, "(", 1);
(SvPVX(iname))[0] = '$';
}
else {
sv_catpvn(retval, "{", 1);
! if (namelen > 0 && name[namelen-1] != ']' && name[namelen-1] != '}') {
sv_catpvn(iname, "->", 2);
}
}
--- 384,403 ----
I32 klen;
SV *hval;
! iname = newSVpvn(name, namelen);
if (name[0] == '%') {
sv_catpvn(retval, "(", 1);
(SvPVX(iname))[0] = '$';
}
else {
sv_catpvn(retval, "{", 1);
! /* omit "->" in $foo[0]->{bar}, but not in ${$foo}->{bar} */
! if ((namelen > 0
! && name[namelen-1] != ']' && name[namelen-1] != '}')
! || (namelen > 4
! && (name[1] == '{'
! || (name[0] == '\\' && name[2] == '{'))))
! {
sv_catpvn(iname, "->", 2);
}
}
***************
*** 472,504 ****
(void) sprintf(id, "0x%lx", (unsigned long)val);
if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) &&
(sv = *svp) && SvROK(sv) &&
! (seenentry = (AV*)SvRV(sv))) {
SV *othername;
! if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)) {
sv_catsv(retval, othername);
return 1;
}
}
else {
SV *namesv;
! namesv = newSVpv("\\", 1);
sv_catpvn(namesv, name, namelen);
seenentry = newAV();
av_push(seenentry, namesv);
! (void)SvREFCNT_inc(val);
! av_push(seenentry, val);
(void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
SvREFCNT_dec(seenentry);
}
}
!
if (SvIOK(val)) {
STRLEN len;
i = SvIV(val);
(void) sprintf(tmpbuf, "%d", i);
len = strlen(tmpbuf);
sv_catpvn(retval, tmpbuf, len);
- return 1;
}
else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
c = SvPV(val, i);
--- 516,551 ----
(void) sprintf(id, "0x%lx", (unsigned long)val);
if ((svp = hv_fetch(seenhv, id, (idlen = strlen(id)), FALSE)) &&
(sv = *svp) && SvROK(sv) &&
! (seenentry = (AV*)SvRV(sv)))
! {
SV *othername;
! if ((svp = av_fetch(seenentry, 0, FALSE)) && (othername = *svp)
! && (svp = av_fetch(seenentry, 2, FALSE)) && *svp && SvIV(*svp) > 0)
! {
! sv_catpvn(retval, "${", 2);
sv_catsv(retval, othername);
+ sv_catpvn(retval, "}", 1);
return 1;
}
}
else {
SV *namesv;
! namesv = newSVpvn("\\", 1);
sv_catpvn(namesv, name, namelen);
seenentry = newAV();
av_push(seenentry, namesv);
! av_push(seenentry, newRV(val));
(void)hv_store(seenhv, id, strlen(id), newRV((SV*)seenentry), 0);
SvREFCNT_dec(seenentry);
}
}
!
if (SvIOK(val)) {
STRLEN len;
i = SvIV(val);
(void) sprintf(tmpbuf, "%d", i);
len = strlen(tmpbuf);
sv_catpvn(retval, tmpbuf, len);
}
else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
c = SvPV(val, i);
***************
*** 522,542 ****
r[0] = '*'; strcpy(r+1, c);
i++;
}
if (purity) {
static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
static STRLEN sizes[] = { 8, 7, 6 };
SV *e;
! SV *nname = newSVpv("", 0);
! SV *newapad = newSVpv("", 0);
GV *gv = (GV*)val;
I32 j;
for (j=0; j<3; j++) {
e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv));
! if (e) {
I32 nlevel = 0;
! SV *postentry = newSVpv(r,i);
sv_setsv(nname, postentry);
sv_catpvn(nname, entries[j], sizes[j]);
--- 569,595 ----
r[0] = '*'; strcpy(r+1, c);
i++;
}
+ SvCUR_set(retval, SvCUR(retval)+i);
if (purity) {
static char *entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
static STRLEN sizes[] = { 8, 7, 6 };
SV *e;
! SV *nname = newSVpvn("", 0);
! SV *newapad = newSVpvn("", 0);
GV *gv = (GV*)val;
I32 j;
for (j=0; j<3; j++) {
e = ((j == 0) ? GvSV(gv) : (j == 1) ? (SV*)GvAV(gv) : (SV*)GvHV(gv));
! if (!e)
! continue;
! if (j == 0 && !SvOK(e))
! continue;
!
! {
I32 nlevel = 0;
! SV *postentry = newSVpvn(r,i);
sv_setsv(nname, postentry);
sv_catpvn(nname, entries[j], sizes[j]);
***************
*** 560,565 ****
--- 613,621 ----
SvREFCNT_dec(nname);
}
}
+ else if (val == &PL_sv_undef || !SvOK(val)) {
+ sv_catpvn(retval, "undef", 5);
+ }
else {
c = SvPV(val, i);
sv_grow(retval, SvCUR(retval)+3+2*i);
***************
*** 569,581 ****
++i;
r[i++] = '\'';
r[i] = '\0';
}
- SvCUR_set(retval, SvCUR(retval)+i);
}
! if (deepcopy && idlen)
! (void)hv_delete(seenhv, id, idlen, G_DISCARD);
!
return 1;
}
--- 625,642 ----
++i;
r[i++] = '\'';
r[i] = '\0';
+ SvCUR_set(retval, SvCUR(retval)+i);
}
}
! if (idlen) {
! if (deepcopy)
! (void)hv_delete(seenhv, id, idlen, G_DISCARD);
! else if (namelen && seenentry) {
! SV *mark = *av_fetch(seenentry, 2, TRUE);
! sv_setiv(mark,1);
! }
! }
return 1;
}
***************
*** 647,653 ****
terse = useqq = purity = deepcopy = 0;
quotekeys = 1;
! retval = newSVpv("", 0);
if (SvROK(href)
&& (hv = (HV*)SvRV((SV*)href))
&& SvTYPE(hv) == SVt_PVHV) {
--- 708,714 ----
terse = useqq = purity = deepcopy = 0;
quotekeys = 1;
! retval = newSVpvn("", 0);
if (SvROK(href)
&& (hv = (HV*)SvRV((SV*)href))
&& SvTYPE(hv) == SVt_PVHV) {
***************
*** 692,698 ****
imax = av_len(todumpav);
else
imax = -1;
! valstr = newSVpv("",0);
for (i = 0; i <= imax; ++i) {
SV *newapad;
--- 753,759 ----
imax = av_len(todumpav);
else
imax = -1;
! valstr = newSVpvn("",0);
for (i = 0; i <= imax; ++i) {
SV *newapad;
***************
*** 787,793 ****
if (gimme == G_ARRAY) {
XPUSHs(sv_2mortal(retval));
if (i < imax) /* not the last time thro ? */
! retval = newSVpv("",0);
}
}
SvREFCNT_dec(postav);
--- 848,854 ----
if (gimme == G_ARRAY) {
XPUSHs(sv_2mortal(retval));
if (i < imax) /* not the last time thro ? */
! retval = newSVpvn("",0);
}
}
SvREFCNT_dec(postav);
diff -c 'perl5.005_02/ext/Data/Dumper/Makefile.PL' 'perl5.005_03/ext/Data/Dumper/Makefile.PL'
Index: ./ext/Data/Dumper/Makefile.PL
*** ./ext/Data/Dumper/Makefile.PL Thu Jul 23 23:00:04 1998
--- ./ext/Data/Dumper/Makefile.PL Thu Nov 26 20:12:18 1998
***************
*** 7,11 ****
SUFFIX => 'gz',
DIST_DEFAULT => 'all tardist',
},
! MAN3PODS => ' ',
);
--- 7,11 ----
SUFFIX => 'gz',
DIST_DEFAULT => 'all tardist',
},
! MAN3PODS => {},
);
diff -c 'perl5.005_02/ext/Data/Dumper/Todo' 'perl5.005_03/ext/Data/Dumper/Todo'
Index: ./ext/Data/Dumper/Todo
*** ./ext/Data/Dumper/Todo Thu Jul 23 23:00:04 1998
--- ./ext/Data/Dumper/Todo Thu Nov 26 21:43:15 1998
***************
*** 29,32 ****
--- 29,34 ----
=item Implement redesign that allows various backends (Perl, Lisp,
some-binary-data-format, graph-description-languages, etc.)
+ =item Dump traversal in breadth-first order
+
=back
diff -c 'perl5.005_02/ext/DynaLoader/DynaLoader_pm.PL' 'perl5.005_03/ext/DynaLoader/DynaLoader_pm.PL'
Index: ./ext/DynaLoader/DynaLoader_pm.PL
*** ./ext/DynaLoader/DynaLoader_pm.PL Thu Jul 23 23:00:04 1998
--- ./ext/DynaLoader/DynaLoader_pm.PL Sat Oct 31 21:19:56 1998
***************
*** 101,107 ****
# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
! boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader);
if ($dl_debug) {
--- 101,108 ----
# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
! boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
! !defined(&dl_load_file);
if ($dl_debug) {
diff -c 'perl5.005_02/ext/DynaLoader/Makefile.PL' 'perl5.005_03/ext/DynaLoader/Makefile.PL'
Index: ./ext/DynaLoader/Makefile.PL
*** ./ext/DynaLoader/Makefile.PL Thu Jul 23 23:00:04 1998
--- ./ext/DynaLoader/Makefile.PL Thu Nov 26 20:12:26 1998
***************
*** 4,10 ****
NAME => 'DynaLoader',
LINKTYPE => 'static',
DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"',
! MAN3PODS => ' ', # Pods will be built by installman.
SKIP => [qw(dynamic dynamic_lib dynamic_bs)],
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'DynaLoader_pm.PL',
--- 4,10 ----
NAME => 'DynaLoader',
LINKTYPE => 'static',
DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"',
! MAN3PODS => {}, # Pods will be built by installman.
SKIP => [qw(dynamic dynamic_lib dynamic_bs)],
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'DynaLoader_pm.PL',
diff -c /dev/null 'perl5.005_03/ext/DynaLoader/dl_beos.xs'
Index: ext/DynaLoader/dl_beos.xs
*** ext/DynaLoader/dl_beos.xs Wed Dec 31 18:00:00 1969
--- ext/DynaLoader/dl_beos.xs Thu Mar 4 18:34:11 1999
***************
*** 0 ****
--- 1,115 ----
+ /*
+ * dl_beos.xs, by Tom Spindler
+ * based on dl_dlopen.xs, by Paul Marquess
+ * $Id:$
+ */
+
+ #include "EXTERN.h"
+ #include "perl.h"
+ #include "XSUB.h"
+
+ #include <be/kernel/image.h>
+ #include <OS.h>
+ #include <stdlib.h>
+ #include <limits.h>
+
+ #define dlerror() strerror(errno)
+
+ #include "dlutils.c" /* SaveError() etc */
+
+ static void
+ dl_private_init()
+ {
+ (void)dl_generic_private_init();
+ }
+
+ MODULE = DynaLoader PACKAGE = DynaLoader
+
+ BOOT:
+ (void)dl_private_init();
+
+
+ void *
+ dl_load_file(filename, flags=0)
+ char * filename
+ int flags
+ CODE:
+ { image_id bogo;
+ char *path;
+ path = malloc(PATH_MAX);
+ if (*filename != '/') {
+ getcwd(path, PATH_MAX);
+ strcat(path, "/");
+ strcat(path, filename);
+ } else {
+ strcpy(path, filename);
+ }
+
+ DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags));
+ bogo = load_add_on(path);
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
+ ST(0) = sv_newmortal() ;
+ if (bogo < 0) {
+ SaveError("%s", strerror(bogo));
+ PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
+ } else {
+ RETVAL = (void *) bogo;
+ sv_setiv( ST(0), (IV)RETVAL);
+ }
+ free(path);
+ }
+
+ void *
+ dl_find_symbol(libhandle, symbolname)
+ void * libhandle
+ char * symbolname
+ CODE:
+ status_t retcode;
+ void *adr = 0;
+ #ifdef DLSYM_NEEDS_UNDERSCORE
+ symbolname = form("_%s", symbolname);
+ #endif
+ RETVAL = NULL;
+ DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ "dl_find_symbol(handle=%lx, symbol=%s)\n",
+ (unsigned long) libhandle, symbolname));
+ retcode = get_image_symbol((image_id) libhandle, symbolname,
+ B_SYMBOL_TYPE_TEXT, (void **) &adr);
+ RETVAL = adr;
+ DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
+ " symbolref = %lx\n", (unsigned long) RETVAL));
+ ST(0) = sv_newmortal() ;
+ if (RETVAL == NULL) {
+ SaveError("%s", strerror(retcode)) ;
+ PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode));
+ } else
+ sv_setiv( ST(0), (IV)RETVAL);
+
+
+ void
+ dl_undef_symbols()
+ PPCODE:
+
+
+
+ # These functions should not need changing on any platform:
+
+ void
+ dl_install_xsub(perl_name, symref, filename="$Package")
+ char * perl_name
+ void * symref
+ char * filename
+ CODE:
+ DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
+ perl_name, (unsigned long) symref));
+ ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename)));
+
+
+ char *
+ dl_error()
+ CODE:
+ RETVAL = LastError ;
+ OUTPUT:
+ RETVAL
+
+ # end.
diff -c 'perl5.005_02/ext/DynaLoader/dl_cygwin32.xs' 'perl5.005_03/ext/DynaLoader/dl_cygwin32.xs'
Index: ./ext/DynaLoader/dl_cygwin32.xs
*** ./ext/DynaLoader/dl_cygwin32.xs Thu Jul 23 23:00:05 1998
--- ./ext/DynaLoader/dl_cygwin32.xs Thu Mar 4 18:34:11 1999
***************
*** 82,92 ****
int flags
PREINIT:
CODE:
! DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
! DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL){
SaveError("%d",GetLastError()) ;
--- 82,92 ----
int flags
PREINIT:
CODE:
! DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename));
RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ;
! DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL){
SaveError("%d",GetLastError()) ;
***************
*** 113,122 ****
void * libhandle
char * symbolname
CODE:
! DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
! DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
SaveError("%d",GetLastError()) ;
--- 113,122 ----
void * libhandle
char * symbolname
CODE:
! DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
libhandle, symbolname));
RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname);
! DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL));
ST(0) = sv_newmortal() ;
if (RETVAL == NULL)
SaveError("%d",GetLastError()) ;
***************
*** 138,144 ****
void * symref
char * filename
CODE:
! DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
--- 138,144 ----
void * symref
char * filename
CODE:
! DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
diff -c 'perl5.005_02/ext/DynaLoader/dl_mpeix.xs' 'perl5.005_03/ext/DynaLoader/dl_mpeix.xs'
Index: ./ext/DynaLoader/dl_mpeix.xs
*** ./ext/DynaLoader/dl_mpeix.xs Thu Jul 23 23:00:05 1998
--- ./ext/DynaLoader/dl_mpeix.xs Thu Nov 26 18:23:10 1998
***************
*** 2,7 ****
--- 2,8 ----
* Author: Mark Klein (mklein@dis.com)
* Version: 2.1, 1996/07/25
* Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu)
+ * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu)
*/
#include "EXTERN.h"
***************
*** 59,71 ****
",filename);
obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
memzero(obj, sizeof(t_mpe_dld));
! if (filename[0] == '.')
{
getcwd(buf,sizeof(buf));
! sprintf(obj->filename,"$%s/%s$",buf,filename);
}
else
! sprintf(obj->filename,"$%s$",filename);
DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj));
--- 60,72 ----
",filename);
obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
memzero(obj, sizeof(t_mpe_dld));
! if (filename[0] != '/')
{
getcwd(buf,sizeof(buf));
! sprintf(obj->filename," %s/%s ",buf,filename);
}
else
! sprintf(obj->filename," %s ",filename);
DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj));
***************
*** 90,100 ****
ST(0) = sv_newmortal() ;
errno = 0;
! sprintf(symname, "$%s$", symbolname);
HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
0, &datalen, 1, 0, 0);
! DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x\n", symaddr));
if (status != 0) {
SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
--- 91,101 ----
ST(0) = sv_newmortal() ;
errno = 0;
! sprintf(symname, " %s ", symbolname);
HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
0, &datalen, 1, 0, 0);
! DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));
if (status != 0) {
SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
diff -c 'perl5.005_02/ext/DynaLoader/dl_next.xs' 'perl5.005_03/ext/DynaLoader/dl_next.xs'
Index: ./ext/DynaLoader/dl_next.xs
*** ./ext/DynaLoader/dl_next.xs Thu Jul 23 23:00:05 1998
--- ./ext/DynaLoader/dl_next.xs Wed Dec 30 11:08:09 1998
***************
*** 172,177 ****
--- 172,178 ----
I32 i, psize;
char *result;
char **p;
+ STRLEN n_a;
/* Do not load what is already loaded into this process */
if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
***************
*** 182,188 ****
p = (char **) safemalloc(psize * sizeof(char*));
p[0] = path;
for(i=1; i<psize-1; i++) {
! p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), PL_na);
}
p[psize-1] = 0;
rld_success = rld_load(nxerr, (struct mach_header **)0, p,
--- 183,189 ----
p = (char **) safemalloc(psize * sizeof(char*));
p[0] = path;
for(i=1; i<psize-1; i++) {
! p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), n_a);
}
p[psize-1] = 0;
rld_success = rld_load(nxerr, (struct mach_header **)0, p,
diff -c 'perl5.005_02/ext/DynaLoader/dl_vms.xs' 'perl5.005_03/ext/DynaLoader/dl_vms.xs'
Index: ./ext/DynaLoader/dl_vms.xs
*** ./ext/DynaLoader/dl_vms.xs Thu Jul 23 23:00:06 1998
--- ./ext/DynaLoader/dl_vms.xs Thu Nov 26 20:52:57 1998
***************
*** 1,7 ****
/* dl_vms.xs
*
* Platform: OpenVMS, VAX or AXP
! * Author: Charles Bailey bailey@genetics.upenn.edu
* Revised: 12-Dec-1994
*
* Implementation Note
--- 1,7 ----
/* dl_vms.xs
*
* Platform: OpenVMS, VAX or AXP
! * Author: Charles Bailey bailey@newman.upenn.edu
* Revised: 12-Dec-1994
*
* Implementation Note
diff -c 'perl5.005_02/ext/Errno/Errno_pm.PL' 'perl5.005_03/ext/Errno/Errno_pm.PL'
Index: ./ext/Errno/Errno_pm.PL
*** ./ext/Errno/Errno_pm.PL Sun Aug 2 00:15:06 1998
--- ./ext/Errno/Errno_pm.PL Thu Mar 4 18:42:06 1999
***************
*** 4,10 ****
use vars qw($VERSION);
! $VERSION = "1.09";
my %err = ();
--- 4,10 ----
use vars qw($VERSION);
! $VERSION = "1.111";
my %err = ();
***************
*** 21,27 ****
sub process_file {
my($file) = @_;
! return unless defined $file;
local *FH;
if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
--- 21,27 ----
sub process_file {
my($file) = @_;
! return unless defined $file and -f $file;
local *FH;
if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) {
***************
*** 31,37 ****
}
} else {
unless(open(FH,"< $file")) {
! warn "Cannot open '$file'";
return;
}
}
--- 31,39 ----
}
} else {
unless(open(FH,"< $file")) {
! # This file could be a temporary file created by cppstdin
! # so only warn under -w, and return
! warn "Cannot open '$file'" if $^W;
return;
}
}
***************
*** 42,47 ****
--- 44,67 ----
close(FH);
}
+ my $cppstdin;
+
+ sub default_cpp {
+ unless (defined $cppstdin) {
+ use File::Spec;
+ $cppstdin = $Config{cppstdin};
+ my $upup_cppstdin = File::Spec->catfile(File::Spec->updir,
+ File::Spec->updir,
+ "cppstdin");
+ my $cppstdin_is_wrapper =
+ ($cppstdin eq 'cppstdin'
+ and -f $upup_cppstdin
+ and -x $upup_cppstdin);
+ $cppstdin = $upup_cppstdin if $cppstdin_is_wrapper;
+ }
+ return "$cppstdin $Config{cppflags} $Config{cppminus}";
+ }
+
sub get_files {
my %file = ();
# VMS keeps its include files in system libraries (well, except for Gcc)
***************
*** 56,61 ****
--- 76,84 ----
} elsif ($^O eq 'os390') {
# OS/390 C compiler doesn't generate #file or #line directives
$file{'/usr/include/errno.h'} = 1;
+ } elsif ($^O eq 'vmesa') {
+ # OS/390 C compiler doesn't generate #file or #line directives
+ $file{'../../vmesa/errno.h'} = 1;
} else {
open(CPPI,"> errno.c") or
die "Cannot open errno.c";
***************
*** 65,73 ****
close(CPPI);
# invoke CPP and read the output
!
! open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
! die "Cannot exec $Config{cpprun}";
my $pat;
if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) {
--- 88,101 ----
close(CPPI);
# invoke CPP and read the output
! if ($^O eq 'MSWin32') {
! open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
! die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
! } else {
! my $cpp = default_cpp();
! open(CPPO,"$cpp < errno.c |") or
! die "Cannot exec $cpp";
! }
my $pat;
if ($^O eq 'MSWin32' and $Config{cc} =~ /^bcc/i) {
***************
*** 77,83 ****
$pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
}
while(<CPPO>) {
! $file{$1} = 1 if /$pat/o;
}
close(CPPO);
}
--- 105,120 ----
$pat = '^#(?:line)?\s*\d+\s+"([^"]+)"';
}
while(<CPPO>) {
! if ($^O eq 'os2' or $^O eq 'MSWin32') {
! if (/$pat/o) {
! my $f = $1;
! $f =~ s,\\\\,/,g;
! $file{$f} = 1;
! }
! }
! else {
! $file{$1} = 1 if /$pat/o;
! }
}
close(CPPO);
}
***************
*** 87,92 ****
--- 124,133 ----
sub write_errno_pm {
my $err;
+ # quick sanity check
+
+ die "No error definitions found" unless keys %err;
+
# create the CPP input
open(CPPI,"> errno.c") or
***************
*** 107,120 ****
$cpp =~ s/sys\$input//i;
open(CPPO,"$cpp errno.c |") or
die "Cannot exec $Config{cppstdin}";
! } elsif(!$Config{'cpprun'} or $^O eq 'next') {
! # NeXT will do syntax checking unless it is reading from stdin
! my $cpp = "$Config{cppstdin} $Config{cppflags} $Config{cppminus}";
open(CPPO,"$cpp < errno.c |")
or die "Cannot exec $cpp";
- } else {
- open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
- die "Cannot exec $Config{cpprun}";
}
%err = ();
--- 148,160 ----
$cpp =~ s/sys\$input//i;
open(CPPO,"$cpp errno.c |") or
die "Cannot exec $Config{cppstdin}";
! } elsif ($^O eq 'MSWin32') {
! open(CPPO,"$Config{cpprun} $Config{cppflags} errno.c |") or
! die "Cannot run '$Config{cpprun} $Config{cppflags} errno.c'";
! } else {
! my $cpp = default_cpp();
open(CPPO,"$cpp < errno.c |")
or die "Cannot exec $cpp";
}
%err = ();
diff -c 'perl5.005_02/ext/Errno/Makefile.PL' 'perl5.005_03/ext/Errno/Makefile.PL'
Index: ./ext/Errno/Makefile.PL
*** ./ext/Errno/Makefile.PL Thu Jul 23 23:00:06 1998
--- ./ext/Errno/Makefile.PL Thu Nov 26 20:12:33 1998
***************
*** 1,10 ****
use ExtUtils::MakeMaker;
! @VMS = ($^O eq 'VMS') ? (MAN3PODS => ' ') : ();
WriteMakefile(
NAME => 'Errno',
VERSION_FROM => 'Errno_pm.PL',
PL_FILES => {'Errno_pm.PL'=>'Errno.pm'},
PM => {'Errno.pm' => '$(INST_LIBDIR)/Errno.pm'},
'clean' => {FILES => 'Errno.pm'},
--- 1,11 ----
use ExtUtils::MakeMaker;
! @VMS = ($^O eq 'VMS') ? (MAN3PODS => {}) : ();
WriteMakefile(
NAME => 'Errno',
VERSION_FROM => 'Errno_pm.PL',
+ MAN3PODS => {}, # Pods will be built by installman.
PL_FILES => {'Errno_pm.PL'=>'Errno.pm'},
PM => {'Errno.pm' => '$(INST_LIBDIR)/Errno.pm'},
'clean' => {FILES => 'Errno.pm'},
diff -c 'perl5.005_02/ext/Fcntl/Makefile.PL' 'perl5.005_03/ext/Fcntl/Makefile.PL'
Index: ./ext/Fcntl/Makefile.PL
*** ./ext/Fcntl/Makefile.PL Thu Jul 23 23:00:06 1998
--- ./ext/Fcntl/Makefile.PL Thu Nov 26 20:12:40 1998
***************
*** 1,7 ****
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Fcntl',
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'Fcntl.pm',
);
--- 1,7 ----
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Fcntl',
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'Fcntl.pm',
);
diff -c 'perl5.005_02/ext/GDBM_File/Makefile.PL' 'perl5.005_03/ext/GDBM_File/Makefile.PL'
Index: ./ext/GDBM_File/Makefile.PL
*** ./ext/GDBM_File/Makefile.PL Thu Jul 23 23:00:06 1998
--- ./ext/GDBM_File/Makefile.PL Thu Nov 26 20:12:45 1998
***************
*** 2,8 ****
WriteMakefile(
NAME => 'GDBM_File',
LIBS => ["-L/usr/local/lib -lgdbm", "-ldbm"],
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'GDBM_File.pm',
);
--- 2,8 ----
WriteMakefile(
NAME => 'GDBM_File',
LIBS => ["-L/usr/local/lib -lgdbm", "-ldbm"],
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'GDBM_File.pm',
);
diff -c /dev/null 'perl5.005_03/ext/GDBM_File/hints/sco.pl'
Index: ext/GDBM_File/hints/sco.pl
*** ext/GDBM_File/hints/sco.pl Wed Dec 31 18:00:00 1969
--- ext/GDBM_File/hints/sco.pl Thu Feb 11 18:05:47 1999
***************
*** 0 ****
--- 1,2 ----
+ # SCO OSR5 needs to link with libc.so again to have C<fsync> defined
+ $self->{LIBS} = ['-lgdbm -lc'];
diff -c 'perl5.005_02/ext/IO/IO.xs' 'perl5.005_03/ext/IO/IO.xs'
Index: ./ext/IO/IO.xs
*** ./ext/IO/IO.xs Thu Jul 23 23:00:06 1998
--- ./ext/IO/IO.xs Wed Dec 30 22:52:40 1998
***************
*** 111,117 ****
SV * pos
CODE:
char *p;
! if (handle && (p = SvPVx(pos, PL_na)) && PL_na == sizeof(Fpos_t))
#ifdef PerlIO
RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
#else
--- 111,118 ----
SV * pos
CODE:
char *p;
! STRLEN n_a;
! if (handle && (p = SvPVx(pos, n_a)) && n_a == sizeof(Fpos_t))
#ifdef PerlIO
RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
#else
diff -c 'perl5.005_02/ext/IO/Makefile.PL' 'perl5.005_03/ext/IO/Makefile.PL'
Index: ./ext/IO/Makefile.PL
*** ./ext/IO/Makefile.PL Thu Jul 23 23:00:06 1998
--- ./ext/IO/Makefile.PL Thu Nov 26 20:12:51 1998
***************
*** 1,7 ****
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'IO',
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'lib/IO/Handle.pm',
XS_VERSION => 1.15
--- 1,7 ----
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'IO',
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'lib/IO/Handle.pm',
XS_VERSION => 1.15
diff -c 'perl5.005_02/ext/IO/lib/IO/Pipe.pm' 'perl5.005_03/ext/IO/lib/IO/Pipe.pm'
Index: ./ext/IO/lib/IO/Pipe.pm
*** ./ext/IO/lib/IO/Pipe.pm Thu Jul 23 23:00:07 1998
--- ./ext/IO/lib/IO/Pipe.pm Wed Jan 13 20:55:53 1999
***************
*** 14,20 ****
use Carp;
use Symbol;
! $VERSION = "1.0901";
sub new {
my $type = shift;
--- 14,20 ----
use Carp;
use Symbol;
! $VERSION = "1.0902";
sub new {
my $type = shift;
***************
*** 96,102 ****
close ${*$me}[1];
bless $me, ref($fh);
! *{*$me} = *{*$fh}; # Alias self to handle
bless $fh; # Really wan't un-bless here
${*$me}{'io_pipe_pid'} = $pid
if defined $pid;
--- 96,102 ----
close ${*$me}[1];
bless $me, ref($fh);
! *$me = *$fh; # Alias self to handle
bless $fh; # Really wan't un-bless here
${*$me}{'io_pipe_pid'} = $pid
if defined $pid;
***************
*** 113,119 ****
close ${*$me}[0];
bless $me, ref($fh);
! *{*$me} = *{*$fh}; # Alias self to handle
bless $fh; # Really wan't un-bless here
${*$me}{'io_pipe_pid'} = $pid
if defined $pid;
--- 113,119 ----
close ${*$me}[0];
bless $me, ref($fh);
! *$me = *$fh; # Alias self to handle
bless $fh; # Really wan't un-bless here
${*$me}{'io_pipe_pid'} = $pid
if defined $pid;
***************
*** 177,186 ****
=head1 DESCRIPTION
! C<IO::Pipe> provides an interface to createing pipes between
processes.
! =head1 CONSTRCUTOR
=over 4
--- 177,186 ----
=head1 DESCRIPTION
! C<IO::Pipe> provides an interface to creating pipes between
processes.
! =head1 CONSTRUCTOR
=over 4
diff -c 'perl5.005_02/ext/IO/lib/IO/Seekable.pm' 'perl5.005_03/ext/IO/lib/IO/Seekable.pm'
Index: ./ext/IO/lib/IO/Seekable.pm
*** ./ext/IO/lib/IO/Seekable.pm Thu Jul 23 23:00:07 1998
--- ./ext/IO/lib/IO/Seekable.pm Tue Jan 5 20:18:27 1999
***************
*** 14,20 ****
=head1 DESCRIPTION
! C<IO::Seekable> does not have a constuctor of its own as is intended to
be inherited by other C<IO::Handle> based objects. It provides methods
which allow seeking of the file descriptors.
--- 14,20 ----
=head1 DESCRIPTION
! C<IO::Seekable> does not have a constructor of its own as it is intended to
be inherited by other C<IO::Handle> based objects. It provides methods
which allow seeking of the file descriptors.
diff -c 'perl5.005_02/ext/IO/lib/IO/Socket.pm' 'perl5.005_03/ext/IO/lib/IO/Socket.pm'
Index: ./ext/IO/lib/IO/Socket.pm
*** ./ext/IO/lib/IO/Socket.pm Thu Jul 23 23:00:07 1998
--- ./ext/IO/lib/IO/Socket.pm Tue Jan 5 20:18:29 1999
***************
*** 664,670 ****
=item peerpath()
! Returns the pathanme to the fifo at the peer end
=back
--- 664,670 ----
=item peerpath()
! Returns the pathname to the fifo at the peer end
=back
diff -c 'perl5.005_02/ext/IPC/SysV/Makefile.PL' 'perl5.005_03/ext/IPC/SysV/Makefile.PL'
Index: ./ext/IPC/SysV/Makefile.PL
Prereq: 1.3
*** ./ext/IPC/SysV/Makefile.PL Thu Jul 23 23:00:08 1998
--- ./ext/IPC/SysV/Makefile.PL Thu Nov 26 20:12:59 1998
***************
*** 22,27 ****
--- 22,28 ----
WriteMakefile(
VERSION_FROM => "SysV.pm",
NAME => "IPC::SysV",
+ MAN3PODS => {}, # Pods will be built by installman.
'dist' => {COMPRESS => 'gzip -9f',
SUFFIX => 'gz',
diff -c 'perl5.005_02/ext/IPC/SysV/Msg.pm' 'perl5.005_03/ext/IPC/SysV/Msg.pm'
Index: ./ext/IPC/SysV/Msg.pm
*** ./ext/IPC/SysV/Msg.pm Thu Jul 23 23:00:08 1998
--- ./ext/IPC/SysV/Msg.pm Sun Nov 8 10:55:16 1998
***************
*** 84,90 ****
}
sub rcv {
! @_ == 5 || croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
my $self = shift;
my $buf = "";
msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
--- 84,90 ----
}
sub rcv {
! @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
my $self = shift;
my $buf = "";
msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
***************
*** 95,101 ****
}
sub snd {
! @_ == 4 || croak '$msg->snd( TYPE, BUF, FLAGS )';
my $self = shift;
msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0);
}
--- 95,101 ----
}
sub snd {
! @_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )';
my $self = shift;
msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0);
}
diff -c 'perl5.005_02/ext/IPC/SysV/SysV.xs' 'perl5.005_03/ext/IPC/SysV/SysV.xs'
Index: ./ext/IPC/SysV/SysV.xs
*** ./ext/IPC/SysV/SysV.xs Tue Aug 4 21:30:03 1998
--- ./ext/IPC/SysV/SysV.xs Tue Feb 16 11:52:47 1999
***************
*** 4,35 ****
#include <sys/types.h>
#ifdef __linux__
! #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
#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>
#endif
MODULE=IPC::SysV PACKAGE=IPC::Msg::stat
--- 4,55 ----
#include <sys/types.h>
#ifdef __linux__
! # include <asm/page.h>
#endif
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
! #ifndef HAS_SEM
! # include <sys/ipc.h>
#endif
! # ifdef HAS_MSG
! # include <sys/msg.h>
! # endif
! # ifdef HAS_SHM
! # if defined(PERL_SCO) || 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(__sparc__) && (defined(__NetBSD__) || defined(__OpenBSD__))
! # undef SHMLBA /* not static: determined at boot time */
! # define SHMLBA getpagesize()
! # endif
! # endif
#endif
+
+ /* Required to get 'struct pte' for SHMLBA on ULTRIX. */
+ #if defined(__ultrix) || defined(__ultrix__) || defined(ultrix)
+ # include <machine/pte.h>
#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> /* move upwards under HAS_SHM? */
! #endif
!
! #ifndef S_IRWXU
! # ifdef S_IRUSR
! # define S_IRWXU (S_IRUSR|S_IWUSR|S_IWUSR)
! # define S_IRWXG (S_IRGRP|S_IWGRP|S_IWGRP)
! # define S_IRWXO (S_IROTH|S_IWOTH|S_IWOTH)
! # else
! # define S_IRWXU 0700
! # define S_IRWXG 0070
! # define S_IRWXO 0007
! # endif
#endif
MODULE=IPC::SysV PACKAGE=IPC::Msg::stat
diff -c 'perl5.005_02/ext/NDBM_File/Makefile.PL' 'perl5.005_03/ext/NDBM_File/Makefile.PL'
Index: ./ext/NDBM_File/Makefile.PL
*** ./ext/NDBM_File/Makefile.PL Thu Jul 23 23:00:08 1998
--- ./ext/NDBM_File/Makefile.PL Thu Nov 26 20:13:06 1998
***************
*** 2,8 ****
WriteMakefile(
NAME => 'NDBM_File',
LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"],
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'NDBM_File.pm',
);
--- 2,8 ----
WriteMakefile(
NAME => 'NDBM_File',
LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"],
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'NDBM_File.pm',
);
diff -c 'perl5.005_02/ext/ODBM_File/Makefile.PL' 'perl5.005_03/ext/ODBM_File/Makefile.PL'
Index: ./ext/ODBM_File/Makefile.PL
*** ./ext/ODBM_File/Makefile.PL Thu Jul 23 23:00:08 1998
--- ./ext/ODBM_File/Makefile.PL Thu Nov 26 20:13:13 1998
***************
*** 2,8 ****
WriteMakefile(
NAME => 'ODBM_File',
LIBS => ["-ldbm -lucb"],
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'ODBM_File.pm',
);
--- 2,8 ----
WriteMakefile(
NAME => 'ODBM_File',
LIBS => ["-ldbm -lucb"],
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'ODBM_File.pm',
);
diff -c 'perl5.005_02/ext/Opcode/Makefile.PL' 'perl5.005_03/ext/Opcode/Makefile.PL'
Index: ./ext/Opcode/Makefile.PL
*** ./ext/Opcode/Makefile.PL Thu Jul 23 23:00:09 1998
--- ./ext/Opcode/Makefile.PL Thu Nov 26 20:13:19 1998
***************
*** 1,7 ****
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Opcode',
! MAN3PODS => ' ',
VERSION_FROM => 'Opcode.pm',
XS_VERSION => '1.03'
);
--- 1,7 ----
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Opcode',
! MAN3PODS => {},
VERSION_FROM => 'Opcode.pm',
XS_VERSION => '1.03'
);
diff -c 'perl5.005_02/ext/Opcode/Opcode.xs' 'perl5.005_03/ext/Opcode/Opcode.xs'
Index: ./ext/Opcode/Opcode.xs
*** ./ext/Opcode/Opcode.xs Thu Jul 23 23:00:09 1998
--- ./ext/Opcode/Opcode.xs Wed Dec 30 11:08:43 1998
***************
*** 400,406 ****
}
else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
int b, j;
! char *bitmap = SvPV(bitspec,PL_na);
myopcode = 0;
for (b=0; b < opset_len; b++) {
U16 bits = bitmap[b];
--- 400,407 ----
}
else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) {
int b, j;
! STRLEN n_a;
! char *bitmap = SvPV(bitspec,n_a);
myopcode = 0;
for (b=0; b < opset_len; b++) {
U16 bits = bitmap[b];
diff -c 'perl5.005_02/ext/Opcode/Safe.pm' 'perl5.005_03/ext/Opcode/Safe.pm'
Index: ./ext/Opcode/Safe.pm
*** ./ext/Opcode/Safe.pm Thu Jul 23 23:00:09 1998
--- ./ext/Opcode/Safe.pm Thu Jan 21 19:03:55 1999
***************
*** 283,290 ****
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
compartment which contains a masked operator will cause the
compilation to fail with an error. The code will not be executed.
--- 283,290 ----
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 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 -c 'perl5.005_02/ext/Opcode/ops.pm' 'perl5.005_03/ext/Opcode/ops.pm'
Index: ./ext/Opcode/ops.pm
*** ./ext/Opcode/ops.pm Thu Jul 23 23:00:09 1998
--- ./ext/Opcode/ops.pm Thu Jan 21 19:03:55 1999
***************
*** 31,37 ****
=head1 DESCRIPTION
! Since the ops pragma currently has an irreversable 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
--- 31,37 ----
=head1 DESCRIPTION
! 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 -c 'perl5.005_02/ext/POSIX/Makefile.PL' 'perl5.005_03/ext/POSIX/Makefile.PL'
Index: ./ext/POSIX/Makefile.PL
*** ./ext/POSIX/Makefile.PL Thu Jul 23 23:00:09 1998
--- ./ext/POSIX/Makefile.PL Thu Nov 26 20:13:25 1998
***************
*** 2,8 ****
WriteMakefile(
NAME => 'POSIX',
($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])),
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'POSIX.pm',
);
--- 2,8 ----
WriteMakefile(
NAME => 'POSIX',
($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])),
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'POSIX.pm',
);
diff -c 'perl5.005_02/ext/POSIX/POSIX.pm' 'perl5.005_03/ext/POSIX/POSIX.pm'
Index: ./ext/POSIX/POSIX.pm
*** ./ext/POSIX/POSIX.pm Sat Aug 1 22:56:30 1998
--- ./ext/POSIX/POSIX.pm Mon Jan 25 20:07:38 1999
***************
*** 268,292 ****
sub closedir {
usage "closedir(dirhandle)" if @_ != 1;
! closedir($_[0]);
}
sub opendir {
usage "opendir(directory)" if @_ != 1;
my $dirhandle = gensym;
! opendir($dirhandle, $_[0])
? $dirhandle
: undef;
}
sub readdir {
usage "readdir(dirhandle)" if @_ != 1;
! readdir($_[0]);
}
sub rewinddir {
usage "rewinddir(dirhandle)" if @_ != 1;
! rewinddir($_[0]);
}
sub errno {
--- 268,292 ----
sub closedir {
usage "closedir(dirhandle)" if @_ != 1;
! CORE::closedir($_[0]);
}
sub opendir {
usage "opendir(directory)" if @_ != 1;
my $dirhandle = gensym;
! CORE::opendir($dirhandle, $_[0])
? $dirhandle
: undef;
}
sub readdir {
usage "readdir(dirhandle)" if @_ != 1;
! CORE::readdir($_[0]);
}
sub rewinddir {
usage "rewinddir(dirhandle)" if @_ != 1;
! CORE::rewinddir($_[0]);
}
sub errno {
***************
*** 301,342 ****
sub fcntl {
usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
! fcntl($_[0], $_[1], $_[2]);
}
sub getgrgid {
usage "getgrgid(gid)" if @_ != 1;
! getgrgid($_[0]);
}
sub getgrnam {
usage "getgrnam(name)" if @_ != 1;
! getgrnam($_[0]);
}
sub atan2 {
usage "atan2(x,y)" if @_ != 2;
! atan2($_[0], $_[1]);
}
sub cos {
usage "cos(x)" if @_ != 1;
! cos($_[0]);
}
sub exp {
usage "exp(x)" if @_ != 1;
! exp($_[0]);
}
sub fabs {
usage "fabs(x)" if @_ != 1;
! abs($_[0]);
}
sub log {
usage "log(x)" if @_ != 1;
! log($_[0]);
}
sub pow {
--- 301,342 ----
sub fcntl {
usage "fcntl(filehandle, cmd, arg)" if @_ != 3;
! CORE::fcntl($_[0], $_[1], $_[2]);
}
sub getgrgid {
usage "getgrgid(gid)" if @_ != 1;
! CORE::getgrgid($_[0]);
}
sub getgrnam {
usage "getgrnam(name)" if @_ != 1;
! CORE::getgrnam($_[0]);
}
sub atan2 {
usage "atan2(x,y)" if @_ != 2;
! CORE::atan2($_[0], $_[1]);
}
sub cos {
usage "cos(x)" if @_ != 1;
! CORE::cos($_[0]);
}
sub exp {
usage "exp(x)" if @_ != 1;
! CORE::exp($_[0]);
}
sub fabs {
usage "fabs(x)" if @_ != 1;
! CORE::abs($_[0]);
}
sub log {
usage "log(x)" if @_ != 1;
! CORE::log($_[0]);
}
sub pow {
***************
*** 346,367 ****
sub sin {
usage "sin(x)" if @_ != 1;
! sin($_[0]);
}
sub sqrt {
usage "sqrt(x)" if @_ != 1;
! sqrt($_[0]);
}
sub getpwnam {
usage "getpwnam(name)" if @_ != 1;
! getpwnam($_[0]);
}
sub getpwuid {
usage "getpwuid(uid)" if @_ != 1;
! getpwuid($_[0]);
}
sub longjmp {
--- 346,367 ----
sub sin {
usage "sin(x)" if @_ != 1;
! CORE::sin($_[0]);
}
sub sqrt {
usage "sqrt(x)" if @_ != 1;
! CORE::sqrt($_[0]);
}
sub getpwnam {
usage "getpwnam(name)" if @_ != 1;
! CORE::getpwnam($_[0]);
}
sub getpwuid {
usage "getpwuid(uid)" if @_ != 1;
! CORE::getpwuid($_[0]);
}
sub longjmp {
***************
*** 382,393 ****
sub kill {
usage "kill(pid, sig)" if @_ != 2;
! kill $_[1], $_[0];
}
sub raise {
usage "raise(sig)" if @_ != 1;
! kill $_[0], $$; # Is this good enough?
}
sub offsetof {
--- 382,393 ----
sub kill {
usage "kill(pid, sig)" if @_ != 2;
! CORE::kill $_[1], $_[0];
}
sub raise {
usage "raise(sig)" if @_ != 1;
! CORE::kill $_[0], $$; # Is this good enough?
}
sub offsetof {
***************
*** 480,491 ****
sub getc {
usage "getc(handle)" if @_ != 1;
! getc($_[0]);
}
sub getchar {
usage "getchar()" if @_ != 0;
! getc(STDIN);
}
sub gets {
--- 480,491 ----
sub getc {
usage "getc(handle)" if @_ != 1;
! CORE::getc($_[0]);
}
sub getchar {
usage "getchar()" if @_ != 0;
! CORE::getc(STDIN);
}
sub gets {
***************
*** 500,506 ****
sub printf {
usage "printf(pattern, args...)" if @_ < 1;
! printf STDOUT @_;
}
sub putc {
--- 500,506 ----
sub printf {
usage "printf(pattern, args...)" if @_ < 1;
! CORE::printf STDOUT @_;
}
sub putc {
***************
*** 517,533 ****
sub remove {
usage "remove(filename)" if @_ != 1;
! unlink($_[0]);
}
sub rename {
usage "rename(oldfilename, newfilename)" if @_ != 2;
! rename($_[0], $_[1]);
}
sub rewind {
usage "rewind(filehandle)" if @_ != 1;
! seek($_[0],0,0);
}
sub scanf {
--- 517,533 ----
sub remove {
usage "remove(filename)" if @_ != 1;
! CORE::unlink($_[0]);
}
sub rename {
usage "rename(oldfilename, newfilename)" if @_ != 2;
! CORE::rename($_[0], $_[1]);
}
sub rewind {
usage "rewind(filehandle)" if @_ != 1;
! CORE::seek($_[0],0,0);
}
sub scanf {
***************
*** 536,542 ****
sub sprintf {
usage "sprintf(pattern,args)" if @_ == 0;
! sprintf(shift,@_);
}
sub sscanf {
--- 536,542 ----
sub sprintf {
usage "sprintf(pattern,args)" if @_ == 0;
! CORE::sprintf(shift,@_);
}
sub sscanf {
***************
*** 565,571 ****
sub abs {
usage "abs(x)" if @_ != 1;
! abs($_[0]);
}
sub atexit {
--- 565,571 ----
sub abs {
usage "abs(x)" if @_ != 1;
! CORE::abs($_[0]);
}
sub atexit {
***************
*** 598,604 ****
sub exit {
usage "exit(status)" if @_ != 1;
! exit($_[0]);
}
sub free {
--- 598,604 ----
sub exit {
usage "exit(status)" if @_ != 1;
! CORE::exit($_[0]);
}
sub free {
***************
*** 640,646 ****
sub system {
usage "system(command)" if @_ != 1;
! system($_[0]);
}
sub memchr {
--- 640,646 ----
sub system {
usage "system(command)" if @_ != 1;
! CORE::system($_[0]);
}
sub memchr {
***************
*** 719,725 ****
sub strstr {
usage "strstr(big, little)" if @_ != 2;
! index($_[0], $_[1]);
}
sub strtok {
--- 719,725 ----
sub strstr {
usage "strstr(big, little)" if @_ != 2;
! CORE::index($_[0], $_[1]);
}
sub strtok {
***************
*** 728,798 ****
sub chmod {
usage "chmod(mode, filename)" if @_ != 2;
! chmod($_[0], $_[1]);
}
sub fstat {
usage "fstat(fd)" if @_ != 1;
local *TMP;
open(TMP, "<&$_[0]"); # Gross.
! my @l = stat(TMP);
close(TMP);
@l;
}
sub mkdir {
usage "mkdir(directoryname, mode)" if @_ != 2;
! mkdir($_[0], $_[1]);
}
sub stat {
usage "stat(filename)" if @_ != 1;
! stat($_[0]);
}
sub umask {
usage "umask(mask)" if @_ != 1;
! umask($_[0]);
}
sub wait {
usage "wait()" if @_ != 0;
! wait();
}
sub waitpid {
usage "waitpid(pid, options)" if @_ != 2;
! waitpid($_[0], $_[1]);
}
sub gmtime {
usage "gmtime(time)" if @_ != 1;
! gmtime($_[0]);
}
sub localtime {
usage "localtime(time)" if @_ != 1;
! localtime($_[0]);
}
sub time {
usage "time()" if @_ != 0;
! time;
}
sub alarm {
usage "alarm(seconds)" if @_ != 1;
! alarm($_[0]);
}
sub chdir {
usage "chdir(directory)" if @_ != 1;
! chdir($_[0]);
}
sub chown {
usage "chown(filename, uid, gid)" if @_ != 3;
! chown($_[0], $_[1], $_[2]);
}
sub execl {
--- 728,798 ----
sub chmod {
usage "chmod(mode, filename)" if @_ != 2;
! CORE::chmod($_[0], $_[1]);
}
sub fstat {
usage "fstat(fd)" if @_ != 1;
local *TMP;
open(TMP, "<&$_[0]"); # Gross.
! my @l = CORE::stat(TMP);
close(TMP);
@l;
}
sub mkdir {
usage "mkdir(directoryname, mode)" if @_ != 2;
! CORE::mkdir($_[0], $_[1]);
}
sub stat {
usage "stat(filename)" if @_ != 1;
! CORE::stat($_[0]);
}
sub umask {
usage "umask(mask)" if @_ != 1;
! CORE::umask($_[0]);
}
sub wait {
usage "wait()" if @_ != 0;
! CORE::wait();
}
sub waitpid {
usage "waitpid(pid, options)" if @_ != 2;
! CORE::waitpid($_[0], $_[1]);
}
sub gmtime {
usage "gmtime(time)" if @_ != 1;
! CORE::gmtime($_[0]);
}
sub localtime {
usage "localtime(time)" if @_ != 1;
! CORE::localtime($_[0]);
}
sub time {
usage "time()" if @_ != 0;
! CORE::time;
}
sub alarm {
usage "alarm(seconds)" if @_ != 1;
! CORE::alarm($_[0]);
}
sub chdir {
usage "chdir(directory)" if @_ != 1;
! CORE::chdir($_[0]);
}
sub chown {
usage "chown(filename, uid, gid)" if @_ != 3;
! CORE::chown($_[0], $_[1], $_[2]);
}
sub execl {
***************
*** 821,827 ****
sub fork {
usage "fork()" if @_ != 0;
! fork;
}
sub getcwd
--- 821,827 ----
sub fork {
usage "fork()" if @_ != 0;
! CORE::fork;
}
sub getcwd
***************
*** 861,872 ****
sub getlogin {
usage "getlogin()" if @_ != 0;
! getlogin();
}
sub getpgrp {
usage "getpgrp()" if @_ != 0;
! getpgrp($_[0]);
}
sub getpid {
--- 861,872 ----
sub getlogin {
usage "getlogin()" if @_ != 0;
! CORE::getlogin();
}
sub getpgrp {
usage "getpgrp()" if @_ != 0;
! CORE::getpgrp;
}
sub getpid {
***************
*** 876,882 ****
sub getppid {
usage "getppid()" if @_ != 0;
! getppid;
}
sub getuid {
--- 876,882 ----
sub getppid {
usage "getppid()" if @_ != 0;
! CORE::getppid;
}
sub getuid {
***************
*** 891,902 ****
sub link {
usage "link(oldfilename, newfilename)" if @_ != 2;
! link($_[0], $_[1]);
}
sub rmdir {
usage "rmdir(directoryname)" if @_ != 1;
! rmdir($_[0]);
}
sub setgid {
--- 891,906 ----
sub link {
usage "link(oldfilename, newfilename)" if @_ != 2;
! CORE::link($_[0], $_[1]);
}
sub rmdir {
usage "rmdir(directoryname)" if @_ != 1;
! CORE::rmdir($_[0]);
! }
!
! sub setbuf {
! redef "IO::Handle::setbuf()";
}
sub setgid {
***************
*** 909,926 ****
$< = $_[0];
}
sub sleep {
usage "sleep(seconds)" if @_ != 1;
! sleep($_[0]);
}
sub unlink {
usage "unlink(filename)" if @_ != 1;
! unlink($_[0]);
}
sub utime {
usage "utime(filename, atime, mtime)" if @_ != 3;
! utime($_[1], $_[2], $_[0]);
}
--- 913,934 ----
$< = $_[0];
}
+ sub setvbuf {
+ redef "IO::Handle::setvbuf()";
+ }
+
sub sleep {
usage "sleep(seconds)" if @_ != 1;
! CORE::sleep($_[0]);
}
sub unlink {
usage "unlink(filename)" if @_ != 1;
! CORE::unlink($_[0]);
}
sub utime {
usage "utime(filename, atime, mtime)" if @_ != 3;
! CORE::utime($_[1], $_[2], $_[0]);
}
diff -c 'perl5.005_02/ext/POSIX/POSIX.pod' 'perl5.005_03/ext/POSIX/POSIX.pod'
Index: ./ext/POSIX/POSIX.pod
*** ./ext/POSIX/POSIX.pod Thu Jul 23 23:00:10 1998
--- ./ext/POSIX/POSIX.pod Sat Nov 7 15:41:30 1998
***************
*** 1009,1021 ****
Synopsis:
! strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1. The
! year (C<year>) is given in years since 1900. I.e. The year 1995 is 95; the
year 2001 is 101. Consult your system's C<strftime()> manpage for details
! about these and the other arguments.
The string for Tuesday, December 12, 1995.
--- 1009,1022 ----
Synopsis:
! strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
The month (C<mon>), weekday (C<wday>), and yearday (C<yday>) begin at zero.
I.e. January is 0, not 1; Sunday is 0, not 1; January 1st is 0, not 1. The
! year (C<year>) is given in years since 1900. I.e., the year 1995 is 95; the
year 2001 is 101. Consult your system's C<strftime()> manpage for details
! about these and the other arguments. The given arguments are made consistent
! by calling C<mktime()> before calling your system's C<strftime()> function.
The string for Tuesday, December 12, 1995.
diff -c 'perl5.005_02/ext/POSIX/POSIX.xs' 'perl5.005_03/ext/POSIX/POSIX.xs'
Index: ./ext/POSIX/POSIX.xs
*** ./ext/POSIX/POSIX.xs Sat Aug 1 23:03:23 1998
--- ./ext/POSIX/POSIX.xs Thu Mar 4 18:34:14 1999
***************
*** 10,17 ****
# undef open
# undef setmode
# define open PerlLIO_open3
- # undef TAINT_PROPER
- # define TAINT_PROPER(a)
#endif
#include <ctype.h>
#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
--- 10,15 ----
***************
*** 2569,2575 ****
CODE:
{
int i;
! RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t));
sigemptyset(RETVAL);
for (i = 1; i < items; i++)
sigaddset(RETVAL, SvIV(ST(i)));
--- 2567,2573 ----
CODE:
{
int i;
! New(0, RETVAL, 1, sigset_t);
sigemptyset(RETVAL);
for (i = 1; i < items; i++)
sigaddset(RETVAL, SvIV(ST(i)));
***************
*** 2581,2587 ****
DESTROY(sigset)
POSIX::SigSet sigset
CODE:
! safefree((char *)sigset);
SysRet
sigaddset(sigset, sig)
--- 2579,2585 ----
DESTROY(sigset)
POSIX::SigSet sigset
CODE:
! Safefree(sigset);
SysRet
sigaddset(sigset, sig)
***************
*** 2615,2621 ****
CODE:
{
#ifdef I_TERMIOS
! RETVAL = (struct termios*)safemalloc(sizeof(struct termios));
#else
not_here("termios");
RETVAL = 0;
--- 2613,2619 ----
CODE:
{
#ifdef I_TERMIOS
! New(0, RETVAL, 1, struct termios);
#else
not_here("termios");
RETVAL = 0;
***************
*** 2629,2635 ****
POSIX::Termios termios_ref
CODE:
#ifdef I_TERMIOS
! safefree((char *)termios_ref);
#else
not_here("termios");
#endif
--- 2627,2633 ----
POSIX::Termios termios_ref
CODE:
#ifdef I_TERMIOS
! Safefree(termios_ref);
#else
not_here("termios");
#endif
***************
*** 3181,3190 ****
sig_name[sig],
strlen(sig_name[sig]),
TRUE);
/* Remember old handler name if desired. */
if (oldaction) {
! char *hand = SvPVx(*sigsvp, PL_na);
svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
sv_setpv(*svp, *hand ? hand : "DEFAULT");
}
--- 3179,3189 ----
sig_name[sig],
strlen(sig_name[sig]),
TRUE);
+ STRLEN n_a;
/* Remember old handler name if desired. */
if (oldaction) {
! char *hand = SvPVx(*sigsvp, n_a);
svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
sv_setpv(*svp, *hand ? hand : "DEFAULT");
}
***************
*** 3195,3201 ****
svp = hv_fetch(action, "HANDLER", 7, FALSE);
if (!svp)
croak("Can't supply an action without a HANDLER");
! sv_setpv(*sigsvp, SvPV(*svp, PL_na));
mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
act.sa_handler = sighandler;
--- 3194,3200 ----
svp = hv_fetch(action, "HANDLER", 7, FALSE);
if (!svp)
croak("Can't supply an action without a HANDLER");
! sv_setpv(*sigsvp, SvPV(*svp, n_a));
mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
act.sa_handler = sighandler;
***************
*** 3234,3240 ****
sigset = (sigset_t*) tmp;
}
else {
! sigset = (sigset_t*)safemalloc(sizeof(sigset_t));
sv_setptrobj(*svp, sigset, "POSIX::SigSet");
}
*sigset = oact.sa_mask;
--- 3233,3239 ----
sigset = (sigset_t*) tmp;
}
else {
! New(0, sigset, 1, sigset_t);
sv_setptrobj(*svp, sigset, "POSIX::SigSet");
}
*sigset = oact.sa_mask;
***************
*** 3256,3262 ****
sigprocmask(how, sigset, oldsigset = 0)
int how
POSIX::SigSet sigset
! POSIX::SigSet oldsigset
SysRet
sigsuspend(signal_mask)
--- 3255,3274 ----
sigprocmask(how, sigset, oldsigset = 0)
int how
POSIX::SigSet sigset
! POSIX::SigSet oldsigset = NO_INIT
! INIT:
! if ( items < 3 ) {
! oldsigset = 0;
! }
! else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
! IV tmp = SvIV((SV*)SvRV(ST(2)));
! oldsigset = (POSIX__SigSet) tmp;
! }
! else {
! New(0, oldsigset, 1, sigset_t);
! sigemptyset(oldsigset);
! sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
! }
SysRet
sigsuspend(signal_mask)
***************
*** 3591,3597 ****
RETVAL
char *
! strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
char * fmt
int sec
int min
--- 3603,3609 ----
RETVAL
char *
! strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
char * fmt
int sec
int min
***************
*** 3617,3624 ****
mytm.tm_wday = wday;
mytm.tm_yday = yday;
mytm.tm_isdst = isdst;
len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
! ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
}
void
--- 3629,3673 ----
mytm.tm_wday = wday;
mytm.tm_yday = yday;
mytm.tm_isdst = isdst;
+ (void) mktime(&mytm);
len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm);
! /*
! ** The following is needed to handle to the situation where
! ** tmpbuf overflows. Basically we want to allocate a buffer
! ** and try repeatedly. The reason why it is so complicated
! ** is that getting a return value of 0 from strftime can indicate
! ** one of the following:
! ** 1. buffer overflowed,
! ** 2. illegal conversion specifier, or
! ** 3. the format string specifies nothing to be returned(not
! ** an error). This could be because format is an empty string
! ** or it specifies %p that yields an empty string in some locale.
! ** If there is a better way to make it portable, go ahead by
! ** all means.
! */
! if ( ( len > 0 && len < sizeof(tmpbuf) )
! || ( len == 0 && strlen(fmt) == 0 ) ) {
! ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
! } else {
! /* Possibly buf overflowed - try again with a bigger buf */
! int bufsize = strlen(fmt) + sizeof(tmpbuf);
! char* buf;
! int buflen;
!
! New(0, buf, bufsize, char);
! while( buf ) {
! buflen = strftime(buf, bufsize, fmt, &mytm);
! if ( buflen > 0 && buflen < bufsize ) break;
! bufsize *= 2;
! Renew(buf, bufsize, char);
! }
! if ( buf ) {
! ST(0) = sv_2mortal(newSVpv(buf, buflen));
! Safefree(buf);
! } else {
! ST(0) = sv_2mortal(newSVpv(tmpbuf, len));
! }
! }
}
void
diff -c /dev/null 'perl5.005_03/ext/POSIX/hints/dynixptx.pl'
Index: ext/POSIX/hints/dynixptx.pl
*** ext/POSIX/hints/dynixptx.pl Wed Dec 31 18:00:00 1969
--- ext/POSIX/hints/dynixptx.pl Sun Nov 29 18:20:36 1998
***************
*** 0 ****
--- 1,4 ----
+ # Need to add an extra '-lc' to the end to work around a DYNIX/ptx bug
+ # PR#227670 - linker error on fpgetround()
+
+ $self->{LIBS} = ['-ldb -lm -lc'];
diff -c /dev/null 'perl5.005_03/ext/POSIX/hints/mint.pl'
Index: ext/POSIX/hints/mint.pl
*** ext/POSIX/hints/mint.pl Wed Dec 31 18:00:00 1969
--- ext/POSIX/hints/mint.pl Thu Jan 28 19:13:52 1999
***************
*** 0 ****
--- 1,2 ----
+ $self->{CCFLAGS} = $Config{ccflags} . ' -DNO_LOCALECONV_GROUPING -DNO_LOCALECONV_MON_GROUPING';
+
diff -c 'perl5.005_02/ext/SDBM_File/Makefile.PL' 'perl5.005_03/ext/SDBM_File/Makefile.PL'
Index: ./ext/SDBM_File/Makefile.PL
*** ./ext/SDBM_File/Makefile.PL Thu Jul 23 23:00:12 1998
--- ./ext/SDBM_File/Makefile.PL Thu Nov 26 20:13:32 1998
***************
*** 12,18 ****
WriteMakefile(
NAME => 'SDBM_File',
MYEXTLIB => $myextlib,
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'SDBM_File.pm',
DEFINE => $define,
--- 12,18 ----
WriteMakefile(
NAME => 'SDBM_File',
MYEXTLIB => $myextlib,
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'SDBM_File.pm',
DEFINE => $define,
diff -c 'perl5.005_02/ext/SDBM_File/sdbm/sdbm.c' 'perl5.005_03/ext/SDBM_File/sdbm/sdbm.c'
Index: ./ext/SDBM_File/sdbm/sdbm.c
*** ./ext/SDBM_File/sdbm/sdbm.c Tue Aug 4 15:09:27 1998
--- ./ext/SDBM_File/sdbm/sdbm.c Thu Mar 4 18:34:14 1999
***************
*** 437,442 ****
--- 437,443 ----
dirb = c / DBLKSIZ;
if (dirb != db->dirbno) {
+ (void) memset(db->dirbuf, 0, DBLKSIZ);
if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
|| read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
return 0;
diff -c 'perl5.005_02/ext/Socket/Makefile.PL' 'perl5.005_03/ext/Socket/Makefile.PL'
Index: ./ext/Socket/Makefile.PL
*** ./ext/Socket/Makefile.PL Thu Jul 23 23:00:14 1998
--- ./ext/Socket/Makefile.PL Thu Nov 26 20:13:37 1998
***************
*** 2,7 ****
WriteMakefile(
NAME => 'Socket',
VERSION_FROM => 'Socket.pm',
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
);
--- 2,7 ----
WriteMakefile(
NAME => 'Socket',
VERSION_FROM => 'Socket.pm',
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes', # XXX remove later?
);
diff -c 'perl5.005_02/ext/Socket/Socket.pm' 'perl5.005_03/ext/Socket/Socket.pm'
Index: ./ext/Socket/Socket.pm
*** ./ext/Socket/Socket.pm Thu Jul 23 23:00:14 1998
--- ./ext/Socket/Socket.pm Sun Nov 29 18:21:01 1998
***************
*** 193,202 ****
--- 193,217 ----
AF_UNIX
AF_UNSPEC
AF_X25
+ MSG_CTLFLAGS
+ MSG_CTLIGNORE
+ MSG_CTRUNC
MSG_DONTROUTE
+ MSG_DONTWAIT
+ MSG_EOF
+ MSG_EOR
+ MSG_ERRQUEUE
+ MSG_FIN
MSG_MAXIOVLEN
+ MSG_NOSIGNAL
MSG_OOB
MSG_PEEK
+ MSG_PROXY
+ MSG_RST
+ MSG_SYN
+ MSG_TRUNC
+ MSG_URG
+ MSG_WAITALL
PF_802
PF_APPLETALK
PF_CCITT
***************
*** 221,226 ****
--- 236,246 ----
PF_UNIX
PF_UNSPEC
PF_X25
+ SCM_CONNECT
+ SCM_CREDENTIALS
+ SCM_CREDS
+ SCM_RIGHTS
+ SCM_TIMESTAMP
SOCK_DGRAM
SOCK_RAW
SOCK_RDM
diff -c 'perl5.005_02/ext/Socket/Socket.xs' 'perl5.005_03/ext/Socket/Socket.xs'
Index: ./ext/Socket/Socket.xs
*** ./ext/Socket/Socket.xs Thu Jul 23 23:00:14 1998
--- ./ext/Socket/Socket.xs Sat Dec 12 08:54:54 1998
***************
*** 330,371 ****
case 'L':
break;
case 'M':
if (strEQ(name, "MSG_CTRUNC"))
! #if defined(MSG_CTRUNC) || defined(HAS_GNULIBC) /* XXX it's an enum */
return MSG_CTRUNC;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_DONTROUTE"))
! #if defined(MSG_DONTROUTE) || defined(HAS_GNULIBC) /* XXX it's an enum */
return MSG_DONTROUTE;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_MAXIOVLEN"))
#ifdef MSG_MAXIOVLEN
return MSG_MAXIOVLEN;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_OOB"))
! #if defined(MSG_OOB) || defined(HAS_GNULIBC) /* XXX it's an enum */
return MSG_OOB;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_PEEK"))
! #if defined(MSG_PEEK) || defined(HAS_GNULIBC) /* XXX it's an enum */
return MSG_PEEK;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_PROXY"))
! #if defined(MSG_PROXY) || defined(HAS_GNULIBC) /* XXX it's an enum */
return MSG_PROXY;
#else
goto not_there;
#endif
break;
case 'N':
break;
--- 330,443 ----
case 'L':
break;
case 'M':
+ if (strEQ(name, "MSG_CTLFLAGS"))
+ #ifdef MSG_CTLFLAGS
+ return MSG_CTLFLAGS;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_CTLIGNORE"))
+ #ifdef MSG_CTLIGNORE
+ return MSG_CTLIGNORE;
+ #else
+ goto not_there;
+ #endif
if (strEQ(name, "MSG_CTRUNC"))
! #if defined(MSG_TRUNC) || defined(HAS_MSG_CTRUNC) /* might be an enum */
return MSG_CTRUNC;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_DONTROUTE"))
! #if defined(MSG_DONTROUTE) || defined(HAS_MSG_DONTROUTE) /* might be an enum */
return MSG_DONTROUTE;
#else
goto not_there;
#endif
+ if (strEQ(name, "MSG_DONTWAIT"))
+ #ifdef MSG_DONTWAIT
+ return MSG_DONTWAIT;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_EOF"))
+ #ifdef MSG_EOF
+ return MSG_EOF;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_EOR"))
+ #ifdef MSG_EOR
+ return MSG_EOR;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_ERRQUEUE"))
+ #ifdef MSG_ERRQUEUE
+ return MSG_ERRQUEUE;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_FIN"))
+ #ifdef MSG_FIN
+ return MSG_FIN;
+ #else
+ goto not_there;
+ #endif
if (strEQ(name, "MSG_MAXIOVLEN"))
#ifdef MSG_MAXIOVLEN
return MSG_MAXIOVLEN;
#else
goto not_there;
#endif
+ if (strEQ(name, "MSG_NOSIGNAL"))
+ #ifdef MSG_NOSIGNAL
+ return MSG_NOSIGNAL;
+ #else
+ goto not_there;
+ #endif
if (strEQ(name, "MSG_OOB"))
! #if defined(MSG_OOB) || defined(HAS_MSG_OOB) /* might be an enum */
return MSG_OOB;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_PEEK"))
! #if defined(MSG_PEEK) || defined(HAS_MSG_PEEK) /* might be an enum */
return MSG_PEEK;
#else
goto not_there;
#endif
if (strEQ(name, "MSG_PROXY"))
! #if defined(MSG_PROXY) || defined(HAS_MSG_PROXY) /* might be an enum */
return MSG_PROXY;
#else
goto not_there;
#endif
+ if (strEQ(name, "MSG_RST"))
+ #ifdef MSG_RST
+ return MSG_RST;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_SYN"))
+ #ifdef MSG_SYN
+ return MSG_SYN;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_TRUNC"))
+ #ifdef MSG_TRUNC
+ return MSG_TRUNC;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "MSG_WAITALL"))
+ #ifdef MSG_WAITALL
+ return MSG_WAITALL;
+ #else
+ goto not_there;
+ #endif
break;
case 'N':
break;
***************
*** 522,527 ****
--- 594,629 ----
case 'R':
break;
case 'S':
+ if (strEQ(name, "SCM_CONNECT"))
+ #ifdef SCM_CONNECT
+ return SCM_CONNECT;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "SCM_CREDENTIALS"))
+ #ifdef SCM_CREDENTIALS
+ return SCM_CREDENTIALS;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "SCM_CREDS"))
+ #ifdef SCM_CREDS
+ return SCM_CREDS;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "SCM_RIGHTS"))
+ #if defined(SCM_RIGHTS) || defined(HAS_SCM_RIGHTS) /* might be an enum */
+ return SCM_RIGHTS;
+ #else
+ goto not_there;
+ #endif
+ if (strEQ(name, "SCM_TIMESTAMP"))
+ #ifdef SCM_TIMESTAMP
+ return SCM_TIMESTAMP;
+ #else
+ goto not_there;
+ #endif
if (strEQ(name, "SOCK_DGRAM"))
#ifdef SOCK_DGRAM
return SOCK_DGRAM;
diff -c 'perl5.005_02/ext/Thread/Makefile.PL' 'perl5.005_03/ext/Thread/Makefile.PL'
Index: ./ext/Thread/Makefile.PL
*** ./ext/Thread/Makefile.PL Thu Jul 23 23:00:14 1998
--- ./ext/Thread/Makefile.PL Thu Nov 26 20:13:44 1998
***************
*** 2,7 ****
WriteMakefile(
NAME => 'Thread',
VERSION_FROM => 'Thread.pm',
! MAN3PODS => ' '
);
--- 2,7 ----
WriteMakefile(
NAME => 'Thread',
VERSION_FROM => 'Thread.pm',
! MAN3PODS => {}
);
diff -c 'perl5.005_02/ext/Thread/Thread.xs' 'perl5.005_03/ext/Thread/Thread.xs'
Index: ./ext/Thread/Thread.xs
*** ./ext/Thread/Thread.xs Sun Aug 2 01:09:57 1998
--- ./ext/Thread/Thread.xs Sat Mar 27 22:21:29 1999
***************
*** 115,132 ****
sv = POPs;
PUTBACK;
perl_call_sv(sv, G_ARRAY|G_EVAL);
SPAGAIN;
retval = SP - (PL_stack_base + oldmark);
SP = PL_stack_base + oldmark + 1;
if (SvCUR(thr->errsv)) {
MUTEX_LOCK(&thr->mutex);
thr->flags |= THRf_DID_DIE;
MUTEX_UNLOCK(&thr->mutex);
av_store(av, 0, &PL_sv_no);
av_store(av, 1, newSVsv(thr->errsv));
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
! thr, SvPV(thr->errsv, PL_na)));
} else {
DEBUG_S(STMT_START {
for (i = 1; i <= retval; i++) {
--- 115,135 ----
sv = POPs;
PUTBACK;
+ ENTER;
+ SAVETMPS;
perl_call_sv(sv, G_ARRAY|G_EVAL);
SPAGAIN;
retval = SP - (PL_stack_base + oldmark);
SP = PL_stack_base + oldmark + 1;
if (SvCUR(thr->errsv)) {
+ STRLEN n_a;
MUTEX_LOCK(&thr->mutex);
thr->flags |= THRf_DID_DIE;
MUTEX_UNLOCK(&thr->mutex);
av_store(av, 0, &PL_sv_no);
av_store(av, 1, newSVsv(thr->errsv));
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
! thr, SvPV(thr->errsv, n_a)));
} else {
DEBUG_S(STMT_START {
for (i = 1; i <= retval; i++) {
***************
*** 138,143 ****
--- 141,148 ----
for (i = 1; i <= retval; i++, SP++)
sv_setsv(*av_fetch(av, i, TRUE), SvREFCNT_inc(*SP));
}
+ FREETMPS;
+ LEAVE;
finishoff:
#if 0
***************
*** 174,180 ****
Safefree(PL_screamnext);
Safefree(PL_reg_start_tmp);
SvREFCNT_dec(PL_lastscream);
! /*SvREFCNT_dec(PL_defoutgv);*/
MUTEX_LOCK(&thr->mutex);
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
--- 179,185 ----
Safefree(PL_screamnext);
Safefree(PL_reg_start_tmp);
SvREFCNT_dec(PL_lastscream);
! SvREFCNT_dec(PL_defoutgv);
MUTEX_LOCK(&thr->mutex);
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
***************
*** 233,238 ****
--- 238,248 ----
savethread = thr;
thr = new_struct_thread(thr);
+ /* temporarily pretend to be the child thread in case the
+ * XPUSHs() below want to grow the child's stack. This is
+ * safe, since the other thread is not yet created, and we
+ * are the only ones who know about it */
+ SET_THR(thr);
SPAGAIN;
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: newthread (%p), tid is %u, preparing stack\n",
***************
*** 244,254 ****
XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
XPUSHs(SvREFCNT_inc(startsv));
PUTBACK;
#ifdef THREAD_CREATE
err = THREAD_CREATE(thr, threadstart);
#else
- /* On your marks... */
- MUTEX_LOCK(&thr->mutex);
/* Get set... */
sigfillset(&fullmask);
if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
--- 254,267 ----
XPUSHs(SvREFCNT_inc(*av_fetch(initargs, i, FALSE)));
XPUSHs(SvREFCNT_inc(startsv));
PUTBACK;
+
+ /* On your marks... */
+ SET_THR(savethread);
+ MUTEX_LOCK(&thr->mutex);
+
#ifdef THREAD_CREATE
err = THREAD_CREATE(thr, threadstart);
#else
/* Get set... */
sigfillset(&fullmask);
if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
***************
*** 279,288 ****
#else
err = pthread_create(&thr->self, &attr, threadstart, (void*) thr);
#endif
- /* Go */
- MUTEX_UNLOCK(&thr->mutex);
#endif
if (err) {
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: create of %p failed %d\n",
savethread, thr, err));
--- 292,300 ----
#else
err = pthread_create(&thr->self, &attr, threadstart, (void*) thr);
#endif
#endif
if (err) {
+ MUTEX_UNLOCK(&thr->mutex);
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: create of %p failed %d\n",
savethread, thr, err));
***************
*** 295,310 ****
SvREFCNT_dec(startsv);
return NULL;
}
#ifdef THREAD_POST_CREATE
THREAD_POST_CREATE(thr);
#else
if (sigprocmask(SIG_SETMASK, &oldmask, 0))
croak("panic: sigprocmask");
#endif
sv = newSViv(thr->tid);
sv_magic(sv, thr->oursv, '~', 0, 0);
SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
! return sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
#else
croak("No threads in this perl");
return &PL_sv_undef;
--- 307,329 ----
SvREFCNT_dec(startsv);
return NULL;
}
+
#ifdef THREAD_POST_CREATE
THREAD_POST_CREATE(thr);
#else
if (sigprocmask(SIG_SETMASK, &oldmask, 0))
croak("panic: sigprocmask");
#endif
+
sv = newSViv(thr->tid);
sv_magic(sv, thr->oursv, '~', 0, 0);
SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE;
! sv = sv_bless(newRV_noinc(sv), gv_stashpv(classname, TRUE));
!
! /* Go */
! MUTEX_UNLOCK(&thr->mutex);
!
! return sv;
#else
croak("No threads in this perl");
return &PL_sv_undef;
***************
*** 371,377 ****
for (i = 1; i <= AvFILL(av); i++)
XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
} else {
! char *mess = SvPV(*av_fetch(av, 1, FALSE), PL_na);
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: join propagating die message: %s\n",
thr, mess));
--- 390,397 ----
for (i = 1; i <= AvFILL(av); i++)
XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE)));
} else {
! STRLEN n_a;
! char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a);
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: join propagating die message: %s\n",
thr, mess));
***************
*** 483,488 ****
--- 503,509 ----
croak("cond_wait for lock that we don't own\n");
}
MgOWNER(mg) = 0;
+ COND_SIGNAL(MgOWNERCONDP(mg));
COND_WAIT(MgCONDP(mg), MgMUTEXP(mg));
while (MgOWNER(mg))
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
diff -c 'perl5.005_02/ext/Thread/create.t' 'perl5.005_03/ext/Thread/create.t'
Index: ./ext/Thread/create.t
*** ./ext/Thread/create.t Thu Jul 23 23:00:15 1998
--- ./ext/Thread/create.t Sun Nov 1 22:24:36 1998
***************
*** 1,4 ****
! use Thread;
sub start_here {
my $i;
print "In start_here with args: @_\n";
--- 1,7 ----
! use Thread 'async';
! use Config;
! use Tie::Hash;
!
sub start_here {
my $i;
print "In start_here with args: @_\n";
***************
*** 7,12 ****
--- 10,21 ----
sleep 1;
}
}
+
+ async {
+ tie my(%h), 'Tie::StdHash';
+ %h = %Config;
+ print "running on $h{archname}\n";
+ };
print "Starting new thread now\n";
$t = new Thread \&start_here, qw(foo bar baz);
diff -c 'perl5.005_02/ext/attrs/Makefile.PL' 'perl5.005_03/ext/attrs/Makefile.PL'
Index: ./ext/attrs/Makefile.PL
*** ./ext/attrs/Makefile.PL Thu Jul 23 23:00:16 1998
--- ./ext/attrs/Makefile.PL Thu Nov 26 20:14:15 1998
***************
*** 2,7 ****
WriteMakefile(
NAME => 'attrs',
VERSION_FROM => 'attrs.pm',
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes'
);
--- 2,7 ----
WriteMakefile(
NAME => 'attrs',
VERSION_FROM => 'attrs.pm',
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes'
);
diff -c 'perl5.005_02/ext/attrs/attrs.xs' 'perl5.005_03/ext/attrs/attrs.xs'
Index: ./ext/attrs/attrs.xs
*** ./ext/attrs/attrs.xs Thu Jul 23 23:00:16 1998
--- ./ext/attrs/attrs.xs Wed Dec 30 11:12:33 1998
***************
*** 27,33 ****
if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
croak("can't set attributes outside a subroutine scope");
for (i = 1; i < items; i++) {
! char *attr = SvPV(ST(i), PL_na);
cv_flags_t flag = get_flag(attr);
if (!flag)
croak("invalid attribute name %s", attr);
--- 27,34 ----
if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv)))
croak("can't set attributes outside a subroutine scope");
for (i = 1; i < items; i++) {
! STRLEN n_a;
! char *attr = SvPV(ST(i), n_a);
cv_flags_t flag = get_flag(attr);
if (!flag)
croak("invalid attribute name %s", attr);
***************
*** 47,53 ****
sub = Nullsv;
}
else {
! char *name = SvPV(sub, PL_na);
sub = (SV*)perl_get_cv(name, FALSE);
}
if (!sub)
--- 48,55 ----
sub = Nullsv;
}
else {
! STRLEN n_a;
! char *name = SvPV(sub, n_a);
sub = (SV*)perl_get_cv(name, FALSE);
}
if (!sub)
diff -c 'perl5.005_02/ext/re/Makefile.PL' 'perl5.005_03/ext/re/Makefile.PL'
Index: ./ext/re/Makefile.PL
*** ./ext/re/Makefile.PL Thu Jul 23 23:00:16 1998
--- ./ext/re/Makefile.PL Thu Nov 26 20:14:24 1998
***************
*** 2,8 ****
WriteMakefile(
NAME => 're',
VERSION_FROM => 're.pm',
! MAN3PODS => ' ', # Pods will be built by installman.
XSPROTOARG => '-noprototypes',
OBJECT => 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)',
DEFINE => '-DPERL_EXT_RE_BUILD',
--- 2,8 ----
WriteMakefile(
NAME => 're',
VERSION_FROM => 're.pm',
! MAN3PODS => {}, # Pods will be built by installman.
XSPROTOARG => '-noprototypes',
OBJECT => 're_exec$(OBJ_EXT) re_comp$(OBJ_EXT) re$(OBJ_EXT)',
DEFINE => '-DPERL_EXT_RE_BUILD',
diff -c 'perl5.005_02/ext/re/re.pm' 'perl5.005_03/ext/re/re.pm'
Index: ./ext/re/re.pm
*** ./ext/re/re.pm Tue Aug 4 21:33:43 1998
--- ./ext/re/re.pm Thu Jan 21 19:03:56 1999
***************
*** 41,51 ****
other transformations.
When C<use re 'eval'> is in effect, a regex is allowed to contain
! C<(?{ ... })> zero-width assertions even if regular expression contains
! variable interpolation. That is normally disallowed, since it is a
potential security risk. Note that this pragma is ignored when the regular
expression is obtained from tainted data, i.e. evaluation is always
! disallowed with tainted regular expresssions. See L<perlre/(?{ code })>.
For the purpose of this pragma, interpolation of precompiled regular
expressions (i.e., the result of C<qr//>) is I<not> considered variable
--- 41,51 ----
other transformations.
When C<use re 'eval'> is in effect, a regex is allowed to contain
! C<(?{ ... })> zero-width assertions even if the regex contains
! variable interpolation. This is normally disallowed, since it is a
potential security risk. Note that this pragma is ignored when the regular
expression is obtained from tainted data, i.e. evaluation is always
! disallowed with tainted regular expressions. See L<perlre/(?{ code })>.
For the purpose of this pragma, interpolation of precompiled regular
expressions (i.e., the result of C<qr//>) is I<not> considered variable
diff -c 'perl5.005_02/form.h' 'perl5.005_03/form.h'
Index: ./form.h
*** ./form.h Thu Jul 23 23:00:16 1998
--- ./form.h Sat Mar 27 11:57:09 1999
***************
*** 1,6 ****
/* form.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* form.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/global.sym' 'perl5.005_03/global.sym'
Index: ./global.sym
*** ./global.sym Tue Aug 4 15:16:12 1998
--- ./global.sym Sat Jan 16 12:13:37 1999
***************
*** 276,281 ****
--- 276,282 ----
do_trans
do_vecset
do_vop
+ dofile
dofindlabel
dopoptoeval
dounwind
***************
*** 312,317 ****
--- 313,319 ----
get_no_modify
get_opargs
get_specialsv_list
+ get_vtbl
gp_free
gp_ref
gv_AVadd
***************
*** 914,919 ****
--- 916,922 ----
save_freeop
save_freepv
save_freesv
+ save_generic_svref
save_gp
save_hash
save_helem
diff -c 'perl5.005_02/gv.c' 'perl5.005_03/gv.c'
Index: ./gv.c
*** ./gv.c Tue Aug 4 15:07:44 1998
--- ./gv.c Sat Mar 27 19:16:55 1999
***************
*** 1,6 ****
/* gv.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* gv.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 107,117 ****
GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
GvNAME(gv) = savepvn(name, len);
GvNAMELEN(gv) = len;
! if (multi)
GvMULTI_on(gv);
if (doproto) { /* Replicate part of newSUB here. */
SvIOK_off(gv);
ENTER;
start_subparse(0,0); /* Create CV in compcv. */
GvCV(gv) = PL_compcv;
LEAVE;
--- 107,118 ----
GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
GvNAME(gv) = savepvn(name, len);
GvNAMELEN(gv) = len;
! if (multi || doproto) /* doproto means it _was_ mentioned */
GvMULTI_on(gv);
if (doproto) { /* Replicate part of newSUB here. */
SvIOK_off(gv);
ENTER;
+ /* XXX unsafe for threads if eval_owner isn't held */
start_subparse(0,0); /* Create CV in compcv. */
GvCV(gv) = PL_compcv;
LEAVE;
***************
*** 122,130 ****
CvSTASH(GvCV(gv)) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(GvCV(gv)) = 0;
! if (!CvMUTEXP(GvCV(gv)))
New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
! MUTEX_INIT(CvMUTEXP(GvCV(gv)));
#endif /* USE_THREADS */
if (proto) {
sv_setpv((SV*)GvCV(gv), proto);
--- 123,132 ----
CvSTASH(GvCV(gv)) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(GvCV(gv)) = 0;
! if (!CvMUTEXP(GvCV(gv))) {
New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
! MUTEX_INIT(CvMUTEXP(GvCV(gv)));
! }
#endif /* USE_THREADS */
if (proto) {
sv_setpv((SV*)GvCV(gv), proto);
***************
*** 614,625 ****
IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
}
break;
-
- case 'a':
- case 'b':
- if (len == 1)
- GvMULTI_on(gv);
- break;
case 'E':
if (strnEQ(name, "EXPORT", 6))
GvMULTI_on(gv);
--- 616,621 ----
***************
*** 747,752 ****
--- 743,749 ----
case '/':
case '|':
case '\001':
+ case '\003':
case '\004':
case '\005':
case '\006':
***************
*** 850,856 ****
SvREFCNT(io) = 1;
SvOBJECT_on(io);
iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
! if (!iogv)
iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
return io;
--- 847,854 ----
SvREFCNT(io) = 1;
SvOBJECT_on(io);
iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
! /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
! if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
return io;
***************
*** 991,996 ****
--- 989,995 ----
MAGIC* mg=mg_find((SV*)stash,'c');
AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
AMT amt;
+ STRLEN n_a;
if (mg && amtp->was_ok_am == PL_amagic_generation
&& amtp->was_ok_sub == PL_sub_generation)
***************
*** 1038,1044 ****
default:
if (!SvROK(sv)) {
if (!SvOK(sv)) break;
! gv = gv_fetchmethod(stash, SvPV(sv, PL_na));
if (gv) cv = GvCV(gv);
break;
}
--- 1037,1043 ----
default:
if (!SvROK(sv)) {
if (!SvOK(sv)) break;
! gv = gv_fetchmethod(stash, SvPV(sv, n_a));
if (gv) cv = GvCV(gv);
break;
}
***************
*** 1099,1105 ****
GV *ngv;
DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
! SvPV(GvSV(gv), PL_na), cp, HvNAME(stash)) );
if (!SvPOK(GvSV(gv))
|| !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
FALSE)))
--- 1098,1104 ----
GV *ngv;
DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
! SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
if (!SvPOK(GvSV(gv))
|| !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
FALSE)))
diff -c 'perl5.005_02/gv.h' 'perl5.005_03/gv.h'
Index: ./gv.h
*** ./gv.h Thu Jul 23 23:00:18 1998
--- ./gv.h Sat Mar 27 11:57:04 1999
***************
*** 1,6 ****
/* gv.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* gv.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/handy.h' 'perl5.005_03/handy.h'
Index: ./handy.h
*** ./handy.h Sun Aug 2 00:15:06 1998
--- ./handy.h Sat Mar 27 11:57:02 1999
***************
*** 1,6 ****
/* handy.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* handy.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/hints/aix.sh' 'perl5.005_03/hints/aix.sh'
Index: ./hints/aix.sh
*** ./hints/aix.sh Thu Jul 23 23:00:18 1998
--- ./hints/aix.sh Sun Mar 28 11:28:09 1999
***************
*** 19,24 ****
--- 19,28 ----
usemymalloc='n'
+ # Intuiting the existence of system calls under AIX is difficult,
+ # at best; the safest technique is to find them empirically.
+ usenm='undef'
+
so="a"
dlext="so"
***************
*** 63,102 ****
# symbol: boot_$(EXP) can it be auto-generated?
case "$osvers" in
3*)
! lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc'
;;
*)
! lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc'
!
! ;;
esac
! if [ "X$usethreads" = "X$define" ]; then
! ccflags="$ccflags -DNEED_PTHREAD_INIT"
! case "$cc" in
! xlc_r | cc_r)
! ;;
! cc | '')
! cc=xlc_r # Let us be stricter.
! ;;
! *)
! cat >&4 <<EOM
! Unknown C compiler '$cc'.
! For pthreads you should use the AIX C compilers xlc_r or cc_r.
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 libraries wanted
! # 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="$*"
! fi
--- 67,117 ----
# symbol: boot_$(EXP) can it be auto-generated?
case "$osvers" in
3*)
! lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc'
;;
*)
! lddlflags='-bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc'
! ;;
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
! cc_r) ;;
! cc|xlc_r)
! echo >&4 "Switching cc to cc_r because of POSIX threads."
! # xlc_r has been known to produce buggy code in AIX 4.3.2.
! # (e.g. pragma/overload core dumps)
! # --jhi@iki.fi
! cc=cc_r
! ;;
! '')
! cc=cc_r
! ;;
! *)
! cat >&4 <<EOM
! For pthreads you should use the AIX C compiler 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 -c 'perl5.005_02/hints/apollo.sh' 'perl5.005_03/hints/apollo.sh'
Index: ./hints/apollo.sh
*** ./hints/apollo.sh Thu Jul 23 23:00:18 1998
--- ./hints/apollo.sh Wed Mar 17 18:06:00 1999
***************
*** 1,13 ****
# Info from Johann Klasek <jk@auto.tuwien.ac.at>
# Merged by Andy Dougherty <doughera@lafcol.lafayette.edu>
! # Last revised Fri Jun 2 11:21:27 EDT 1995
# uname -a looks like
# DomainOS newton 10.4.1 bsd4.3 425t
# We want to use both BSD includes and some of the features from the
# /sys5 includes.
! ccflags="$ccflags -A cpu,mathchip -I/usr/include -I/sys5/usr/include"
# These adjustments are necessary (why?) to compile malloc.c.
freetype='void'
--- 1,17 ----
# Info from Johann Klasek <jk@auto.tuwien.ac.at>
# Merged by Andy Dougherty <doughera@lafcol.lafayette.edu>
! # Last revised Tue Mar 16 19:12:22 EET 1999 by
! # Jarkko Hietaniemi <jhi@iki.fi>
# uname -a looks like
# DomainOS newton 10.4.1 bsd4.3 425t
# We want to use both BSD includes and some of the features from the
# /sys5 includes.
! ccflags="$ccflags -A cpu,mathchip -I`pwd`/apollo -I/usr/include -I/sys5/usr/include"
!
! # When Apollo runs a script with "#!", it sets argv[0] to the script name.
! toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"'
# These adjustments are necessary (why?) to compile malloc.c.
freetype='void'
diff -c 'perl5.005_02/hints/beos.sh' 'perl5.005_03/hints/beos.sh'
Index: ./hints/beos.sh
Prereq: 1.1
*** ./hints/beos.sh Sat Jul 25 21:17:47 1998
--- ./hints/beos.sh Thu Jan 28 21:18:08 1999
***************
*** 1,11 ****
# BeOS hints file
# $Id: beos.sh,v 1.1 1998/02/16 03:51:45 dogcow Exp $
! if [ ! -f beos/nm ]; then mwcc -w all -o beos/nm beos/nm.c; fi
prefix="/boot/home/config"
! cpp="mwcc -e"
libpth='/boot/beos/system/lib /boot/home/config/lib'
usrinc='/boot/develop/headers/posix'
--- 1,12 ----
# BeOS hints file
# $Id: beos.sh,v 1.1 1998/02/16 03:51:45 dogcow Exp $
! if [ ! -f beos/nm ]; then mwcc -w all -o beos/nm beos/nm.c 2>/dev/null; fi
! # If this fails, that's all right - it's only for PPC.
prefix="/boot/home/config"
! #cpp="mwcc -e"
libpth='/boot/beos/system/lib /boot/home/config/lib'
usrinc='/boot/develop/headers/posix'
***************
*** 37,45 ****
# the array syserrlst[] is useless for the most part.
# large negative numbers really kind of suck in arrays.
! #d_socket='undef'
# Sockets really don't work with the current version of perl and the
# current BeOS sockets; I suspect that a new module a la GSAR's WIN32 port
# will be required.
export PATH="$PATH:$PWD/beos"
--- 38,53 ----
# the array syserrlst[] is useless for the most part.
# large negative numbers really kind of suck in arrays.
! d_socket='undef'
! d_gethbyaddr='undef'
! d_gethbyname='undef'
! d_getsbyname='undef'
!
! ld='gcc'
!
# Sockets really don't work with the current version of perl and the
# current BeOS sockets; I suspect that a new module a la GSAR's WIN32 port
# will be required.
+ # Of course, this may also change with R5.
export PATH="$PATH:$PWD/beos"
diff -c 'perl5.005_02/hints/dec_osf.sh' 'perl5.005_03/hints/dec_osf.sh'
Index: ./hints/dec_osf.sh
*** ./hints/dec_osf.sh Thu Jul 23 23:00:19 1998
--- ./hints/dec_osf.sh Thu Mar 25 23:45:35 1999
***************
*** 177,206 ****
;;
esac
- if [ "X$usethreads" = "X$define" ]; then
- # Threads interfaces changed with V4.0.
- case "$_DEC_uname_r" in
- *[123].*) libswanted="$libswanted pthreads mach exc c_r"
- ccflags="-threads $ccflags"
- ;;
- *) libswanted="$libswanted pthread exc"
- ccflags="-pthread $ccflags"
- ;;
- esac
- usemymalloc='n'
- fi
-
#
# Make embedding in things like INN and Apache more memory friendly.
# Keep it overridable on the Configure command line, though, so that
# "-Uuseshrplib" prevents this default.
#
! # This or the glibpth change above breaks the build. Commented out
! # for this snapshot.
! #case "$_DEC_cc_style.$useshrplib" in
! # new.) useshrplib="$define" ;;
! #esac
#
# Unset temporary variables no more needed.
--- 177,213 ----
;;
esac
#
# Make embedding in things like INN and Apache more memory friendly.
# Keep it overridable on the Configure command line, though, so that
# "-Uuseshrplib" prevents this default.
#
! case "$_DEC_cc_style.$useshrplib" in
! new.) useshrplib="$define" ;;
! 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]*)
! # 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.
***************
*** 216,222 ****
#
# 19-Dec-1997 Spider Boardman <spider@Orb.Nashua.NH.US>
#
! # * Newer Digial UNIX compilers enforce signaling for NaN without
# -ieee. Added -fprm d at the same time since it's friendlier for
# embedding.
#
--- 223,229 ----
#
# 19-Dec-1997 Spider Boardman <spider@Orb.Nashua.NH.US>
#
! # * Newer Digital UNIX compilers enforce signaling for NaN without
# -ieee. Added -fprm d at the same time since it's friendlier for
# embedding.
#
diff -c 'perl5.005_02/hints/dos_djgpp.sh' 'perl5.005_03/hints/dos_djgpp.sh'
Index: ./hints/dos_djgpp.sh
*** ./hints/dos_djgpp.sh Thu Jul 23 23:00:19 1998
--- ./hints/dos_djgpp.sh Sun Jan 24 08:47:35 1999
***************
*** 52,59 ****
eagain='EAGAIN'
rd_nodata='-1'
! if [ "X$usethreads" = "X$define" ]; then
! set `echo X "$libswanted "| sed -e 's/ c / gthreads c /'`
! shift
! libswanted="$*"
! fi
--- 52,65 ----
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 -c 'perl5.005_02/hints/dynixptx.sh' 'perl5.005_03/hints/dynixptx.sh'
Index: ./hints/dynixptx.sh
*** ./hints/dynixptx.sh Thu Jul 23 23:00:19 1998
--- ./hints/dynixptx.sh Thu Nov 26 09:28:12 1998
***************
*** 1,5 ****
--- 1,9 ----
# Sequent Dynix/Ptx v. 4 hints
# Created 1996/03/15 by Brad Howerter, bhower@wgc.woodward.com
+
+ # Modified 1998/11/10 by Martin J. Bligh, mbligh@sequent.com
+ # to incorporate work done by Kurtis D. Rader & myself.
+
# Use Configure -Dcc=gcc to use gcc.
# cc wants -G for dynamic loading
***************
*** 15,24 ****
# Configure defaults to usenm='y', which doesn't work very well
usenm='n'
! # Reported by bruce@aps.org ("Bruce P. Schuck") as needed for
! # DYNIX/ptx 4.0 V4.2.1 to get socket i/o to work
! # Not defined by default in case they break other versions.
! # These probably need to be worked into a piece of code that
! # checks for the need for this setting.
! # cppflags='-Wc,+abi-socket -I/usr/local/include'
! # ccflags='-Wc,+abi-socket -I/usr/local/include'
--- 19,59 ----
# Configure defaults to usenm='y', which doesn't work very well
usenm='n'
! # for performance, apparently this makes a huge difference (~krader)
!
! d_vfork='define'
! optimize='-Wc,-O3 -W0,-xstring'
!
! # We override d_socket because it's very hard for Configure to get it right
! # in Dynix/Ptx, for several reasons.
! # (1) the socket interface is in libsocket.so -- this wouldn't be so hard
! # for Configure to fathom...but it gets more tangled.
! # (2) if the system has been patched there can be libsocket.so.1.FOO.BAR,
! # the FOO.BAR being the old version of the system before the patching.
! # Configure picks up the old broken version.
! # (3) libsocket.so points to either libsocket.so.1 (v4.2)
! # or libsocket.so.1.1 (v4.4) The socket call in libsocket.so.1.1
! # (BSD socket library) is called bsd_socket(), and has a macro wrapper
! # to hide this.
! # This information kindly provided by Martin J. Bligh of Sequent.
! # As he puts it:
! # "Sequent has unusual capabilities, taking it above and beyond
! # the complexity of any other vendor" :-)
! #
! # Jarkko Hietaniemi November 1998
!
! case "$osvers" in
! 4.4*) # configure doesn't find sockets, as they're in libsocket, not libc
! d_socket='define'
! d_oldsock='undef'
! d_sockpair='define'
! ;;
! 4.2*) # on ptx/TCP 4.2, we can use BSD sockets, but they're not the default.
! cppflags='-Wc,+bsd-socket'
! ccflags='-Wc,+bsd-socket'
! ldflags='-Wc,+bsd-socket'
! d_socket='define'
! d_oldsock='undef'
! d_sockpair='define'
! ;;
! esac
diff -c 'perl5.005_02/hints/freebsd.sh' 'perl5.005_03/hints/freebsd.sh'
Index: ./hints/freebsd.sh
*** ./hints/freebsd.sh Thu Jul 23 23:00:19 1998
--- ./hints/freebsd.sh Thu Feb 11 18:05:48 1999
***************
*** 23,28 ****
--- 23,32 ----
# Andy Dougherty <doughera@lafcol.lafayette.edu>
# Date: Tue Mar 10 16:07:00 EST 1998
#
+ # Support for FreeBSD/ELF
+ # Ollivier Robert <roberto@keltia.freenix.fr>
+ # Date: Wed Sep 2 16:22:12 CEST 1998
+ #
# The two flags "-fpic -DPIC" are used to indicate a
# will-be-shared object. Configure will guess the -fpic, (and the
# -DPIC is not used by perl proper) but the full define is included to
***************
*** 95,106 ****
case "$osvers" in
0.*|1.0*) ;;
! 3.0*) if [ -e /usr/lib/aout ]; then
libpth="/usr/lib/aout /usr/local/lib /usr/lib"
glibpth="/usr/lib/aout /usr/local/lib /usr/lib"
fi
- cccdlflags='-DPIC -fpic'
lddlflags='-Bshareable'
;;
*) cccdlflags='-DPIC -fpic'
--- 99,119 ----
case "$osvers" in
0.*|1.0*) ;;
! 3.*|4.0*)
! objformat=`/usr/bin/objformat`
! if [ x$objformat = xelf ]; then
! libpth="/usr/lib /usr/local/lib"
! glibpth="/usr/lib /usr/local/lib"
! ldflags="-Wl,-E "
! lddlflags="-shared "
! else
! if [ -e /usr/lib/aout ]; then
libpth="/usr/lib/aout /usr/local/lib /usr/lib"
glibpth="/usr/lib/aout /usr/local/lib /usr/lib"
fi
lddlflags='-Bshareable'
+ fi
+ cccdlflags='-DPIC -fpic'
;;
*) cccdlflags='-DPIC -fpic'
***************
*** 118,155 ****
EOM
! # XXX EXPERIMENTAL A.D. 03/09/1998
! # XXX This script UU/usethreads.cbu will get 'called-back' by Configure
! # XXX after it has prompted the user for whether to use threads.
! cat > UU/usethreads.cbu <<'EOSH'
case "$usethreads" in
! $define)
! case "$osvers" in
! 3.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 $uname_r. 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 $uname_r supports POSIX threads or not. Consider
! upgrading to the latest STABLE release.
EOM
! exit 1
! ;;
! esac
! ;;
esac
! EOSH
! # XXX EXPERIMENTAL --end of call-back
--- 131,221 ----
EOM
! # From: Anton Berezin <tobez@plab.ku.dk>
! # To: perl5-porters@perl.org
! # Subject: [PATCH 5.005_54] Configure - hints/freebsd.sh signal handler type
! # Date: 30 Nov 1998 19:46:24 +0100
! # Message-ID: <864srhhvcv.fsf@lion.plab.ku.dk>
!
! signal_t='void'
! d_voidsig='define'
!
! # set libperl.so.X.X for 2.2.X
! case "$osvers" in
! 2.2*)
! # unfortunately this code gets executed before
! # the equivalent in the main Configure so we copy a little
! # from Configure XXX Configure should be fixed.
! if $test -r $src/patchlevel.h;then
! patchlevel=`awk '/define[ ]+PATCHLEVEL/ {print $3}' $src/patchlevel.h`
! subversion=`awk '/define[ ]+SUBVERSION/ {print $3}' $src/patchlevel.h`
! else
! patchlevel=0
! subversion=0
! fi
! libperl="libperl.so.$patchlevel.$subversion"
! unset patchlevel
! unset subversion
! ;;
! 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]*)
! lc_r=`/sbin/ldconfig -r|grep ':-lc_r'|awk '{print $NF}'`
! case "$osvers" in
! 2.2.8*|3.*|4.*)
! if [ ! -r "$lc_r" ]; then
! cat <<EOM >&4
! POSIX threads should be supported by FreeBSD $osvers --
! but your system is missing the shared libc_r.
! (/sbin/ldconfig -r doesn't find any).
!
! Consider using the latest STABLE release.
EOM
! exit 1
! fi
! ldflags="-pthread $ldflags"
! ;;
! 2.2*)
! cat <<EOM >&4
! POSIX threads are not supported well by FreeBSD $osvers.
!
! Please consider upgrading to at least FreeBSD 2.2.8,
! or preferably to 3.something.
!
! (While 2.2.7 does have pthreads, it has some problems
! with the combination of threads and pipes and therefore
! many Perl tests will either hang or fail.)
EOM
! exit 1
! ;;
! *) cat <<EOM >&4
! I did not know that FreeBSD $osvers supports POSIX threads.
!
! Feel free to tell perlbug@perl.com otherwise.
! EOM
! exit 1
! ;;
! esac
!
! 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
!
! case "$osvers" in
! 2.2.8*)
! # ... but this does not apply for 2.2.8 - we know it's safe
! libc="$lc_r"
! usenm=true
! ;;
! esac
!
! unset lc_r
esac
! EOCBU
diff -c /dev/null 'perl5.005_03/hints/gnu.sh'
Index: hints/gnu.sh
*** hints/gnu.sh Wed Dec 31 18:00:00 1969
--- hints/gnu.sh Thu Feb 11 18:05:48 1999
***************
*** 0 ****
--- 1,33 ----
+ # hints/gnu.sh
+ # Last modified: Thu Dec 10 20:47:28 CET 1998
+ # Mark Kettenis <kettenis@phys.uva.nl>
+
+ # libnsl is unusable on the Hurd.
+ # XXX remove this once SUNRPC is implemented.
+ set `echo X "$libswanted "| sed -e 's/ nsl / /'`
+ shift
+ libswanted="$*"
+
+ case "$optimize" in
+ '') optimize='-O2' ;;
+ esac
+
+ # Flags needed to produce shared libraries.
+ lddlflags='-shared'
+
+ # Flags needed by programs that use dynamic linking.
+ ccdlflags='-Wl,-E'
+
+ # The following routines are only available as stubs in GNU libc.
+ # XXX remove this once metaconf detects the GNU libc stubs.
+ d_msgctl='undef'
+ d_msgget='undef'
+ d_msgrcv='undef'
+ d_msgsnd='undef'
+ d_semctl='undef'
+ d_semget='undef'
+ d_semop='undef'
+ d_shmat='undef'
+ d_shmctl='undef'
+ d_shmdt='undef'
+ d_shmget='undef'
diff -c 'perl5.005_02/hints/hpux.sh' 'perl5.005_03/hints/hpux.sh'
Index: ./hints/hpux.sh
*** ./hints/hpux.sh Thu Jul 23 23:00:20 1998
--- ./hints/hpux.sh Wed Mar 3 20:35:36 1999
***************
*** 20,25 ****
--- 20,26 ----
# Distinguish between MC68020, MC68030, MC68040
# Don't assume every OS != 10 is < 10, (e.g., 11).
# From: Chuck Phillips <cdp@fc.hp.com>
+ # HP-UX 10 pthreads hints: Matthew T Harden <mthard@mthard1.monsanto.com>
# This version: August 15, 1997
# Current maintainer: Jeff Okamoto <okamoto@corp.hp.com>
***************
*** 80,85 ****
--- 81,96 ----
esac
else
ccflags="$ccflags -Aa" # The add-on compiler supports ANSI C
+ # cppstdin and cpprun need the -Aa option if you use the unbundled
+ # ANSI C compiler (*not* the bundled K&R compiler or gcc)
+ # [XXX this should be set automatically by Configure, but isn't yet.]
+ # [XXX This is reported not to work. You may have to edit config.sh.
+ # After running Configure, set cpprun and cppstdin in config.sh,
+ # run "Configure -S" and then "make".]
+ cpprun="${cc:-cc} -E -Aa"
+ cppstdin="$cpprun"
+ cppminus='-'
+ cpplast='-'
fi
# For HP's ANSI C compiler, up to "+O3" is safe for everything
# except shared libraries (PIC code). Max safe for PIC is "+O2".
***************
*** 128,133 ****
--- 139,198 ----
selecttype='int *'
fi
+ # 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 datestamp...
+ ccflags=" -D_POSIX_C_SOURCE=199506L $ccflags"
+ set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
+ shift
+ libswanted="$*"
+ ;;
+ esac
+ usemymalloc='n'
+ ;;
+ esac
+ EOCBU
# Remove bad libraries that will cause problems
# (This doesn't remove libraries that don't actually exist)
***************
*** 183,206 ****
# assembler of the form:
# (warning) Use of GR3 when frame >= 8192 may cause conflict.
# These warnings are harmless and can be safely ignored.
-
- #
- # cppstdin and cpprun need the -Aa option if you use the unbundled
- # ANSI C compiler (*not* the bundled K&R compiler or gcc)
- # [XXX this should be enabled automatically by Configure, but isn't yet.]
- # [XXX This is reported not to work. You may have to edit config.sh.
- # After running Configure, set cpprun and cppstdin in config.sh,
- # run "Configure -S" and then "make".]
- #
- case "$cppstdin" in
- '')
- case "$ccflags" in
- *-Aa*)
- cpprun="${cc:-cc} -E -Aa"
- cppstdin="$cpprun"
- cppminus='-'
- cpplast='-'
- ;;
- esac
- ;;
- esac
--- 248,250 ----
diff -c 'perl5.005_02/hints/irix_4.sh' 'perl5.005_03/hints/irix_4.sh'
Index: ./hints/irix_4.sh
*** ./hints/irix_4.sh Thu Jul 23 23:00:20 1998
--- ./hints/irix_4.sh Sun Jan 24 08:47:39 1999
***************
*** 22,24 ****
--- 22,35 ----
-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
+
diff -c 'perl5.005_02/hints/irix_5.sh' 'perl5.005_03/hints/irix_5.sh'
Index: ./hints/irix_5.sh
*** ./hints/irix_5.sh Thu Jul 23 23:00:20 1998
--- ./hints/irix_5.sh Sun Jan 24 08:47:39 1999
***************
*** 32,34 ****
--- 32,45 ----
# 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
+
diff -c 'perl5.005_02/hints/irix_6.sh' 'perl5.005_03/hints/irix_6.sh'
Index: ./hints/irix_6.sh
*** ./hints/irix_6.sh Thu Jul 23 23:00:20 1998
--- ./hints/irix_6.sh Sun Jan 24 08:47:41 1999
***************
*** 53,63 ****
case "`$cc -version 2>&1`" in
*7.0*) # Mongoose 7.0
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0"
! optimize='none'
;;
*7.1*|*7.2|*7.20) # Mongoose 7.1+
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0"
! optimize='-O3'
# This is a temporary fix for 5.005.
# Leave pp_ctl_cflags line at left margin for Configure. See
# hints/README.hints, especially the section
--- 53,63 ----
case "`$cc -version 2>&1`" in
*7.0*) # Mongoose 7.0
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1042,1048,1110,1116,1184 -OPT:Olimit=0"
! optimize='none'
;;
*7.1*|*7.2|*7.20) # Mongoose 7.1+
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0"
! optimize='-O3'
# This is a temporary fix for 5.005.
# Leave pp_ctl_cflags line at left margin for Configure. See
# hints/README.hints, especially the section
***************
*** 65,76 ****
pp_ctl_cflags='optimize=-O'
;;
*7.*) # Mongoose 7.2.1+
! ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=on"
! optimize='-O3'
;;
*6.2*) # Ragnarok 6.2
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184"
! optimize='none'
;;
*) # Be safe and not optimize
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0"
--- 65,76 ----
pp_ctl_cflags='optimize=-O'
;;
*7.*) # Mongoose 7.2.1+
! ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0:space=ON"
! optimize='-O3'
;;
*6.2*) # Ragnarok 6.2
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184"
! optimize='none'
;;
*) # Be safe and not optimize
ccflags="$ccflags -D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -OPT:Olimit=0"
***************
*** 78,86 ****
;;
esac
! ld=ld
# perl's malloc can return improperly aligned buffer
! usemymalloc='undef'
# NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker
ldflags=' -L/usr/local/lib32 -L/usr/local/lib'
cccdlflags=' '
--- 78,107 ----
;;
esac
! # this is to accommodate the 'modules' capability of the
! # 7.2 MIPSPro compilers, which allows for the compilers to be installed
! # in a nondefault location. Almost everything works as expected, but
! # /usr/include isn't caught properly. Hence see the /usr/include/pthread.h
! # change below to include TOOLROOT (a modules environment variable),
! # and the following code. Additional
! # code to accommodate the 'modules' environment should probably be added
! # here if possible, or be inserted as a ${TOOLROOT} reference before
! # absolute paths (again, see the pthread.h change below).
! # -- krishna@sgi.com, 8/23/98
!
! if [ "X${TOOLROOT}" != "X" ]; then
! # we cant set cppflags because it gets overwritten
! # we dont actually need $TOOLROOT/usr/include on the cc line cuz the
! # modules functionality already includes it but
! # XXX - how do I change cppflags in the hints file?
! ccflags="$ccflags -I${TOOLROOT}/usr/include"
! usrinc="${TOOLROOT}/usr/include"
! fi
!
! ld=$cc
# perl's malloc can return improperly aligned buffer
! # usemymalloc='undef'
! malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"'
# NOTE: -L/usr/lib32 -L/lib32 are automatically selected by the linker
ldflags=' -L/usr/local/lib32 -L/usr/local/lib'
cccdlflags=' '
***************
*** 138,159 ****
shift
libswanted="$*"
! if [ "X$usethreads" = "X$define" -o "X$usethreads" = "Xy" ]; then
! if test ! -f /usr/include/pthread.h -o ! -f /usr/lib/libpthread.so; then
! uname_r=`uname -r`
! case "`uname -r`" in
! 5*|6.0|6.1)
! echo >&4 "IRIX $uname_r does not have the POSIX threads."
! echo >&4 "You should upgrade to at least IRIX 6.2 with pthread patches."
! echo >&4 "Cannot continue, aborting."
! exit 1
! ;;
! 6.2)
! echo >&4 ""
! cat >&4 <<EOF
! IRIX 6.2 $uname_r can have the POSIX threads.
! The following IRIX patches (or their replacements) must, however, 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
--- 159,181 ----
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
***************
*** 163,190 ****
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.
- Cannot continue, aborting.
- EOF
- exit 1
- ;;
- 6.*|7.*)
- echo >&4 "IRIX $uname_r should have the POSIX threads."
- echo >&4 "But somehow you do not seem to have them installed."
- echo >&4 "Cannot continue, aborting."
- exit 1
- ;;
- esac
- unset uname_r
- fi
- # -lpthread needs to come before -lc but after other libraries such
- # as -lgdbm and such like. We assume here that -lc is present in
- # libswanted. If that fails to be true in future, then this can be
- # changed to add pthread to the very end of libswanted.
- set `echo X "$libswanted "| sed -e 's/ c / pthread /'`
- ld="${cc:-cc}"
- shift
- libswanted="$*"
- usemymalloc='n'
- fi
--- 185,211 ----
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
diff -c 'perl5.005_02/hints/irix_6_0.sh' 'perl5.005_03/hints/irix_6_0.sh'
Index: ./hints/irix_6_0.sh
*** ./hints/irix_6_0.sh Thu Jul 23 23:00:20 1998
--- ./hints/irix_6_0.sh Sun Jan 24 08:47:41 1999
***************
*** 42,51 ****
# shift
# libswanted="$*"
! if [ "X$usethreads" = "X$define" ]; then
! echo >&4 "IRIX 6.0 does not have POSIX threads."
! echo >&4 "You should upgrade to at least IRIX 6.3."
! echo >&4 "Cannot continue, aborting."
! exit 1
! fi
--- 42,54 ----
# 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
diff -c 'perl5.005_02/hints/irix_6_1.sh' 'perl5.005_03/hints/irix_6_1.sh'
Index: ./hints/irix_6_1.sh
*** ./hints/irix_6_1.sh Thu Jul 23 23:00:20 1998
--- ./hints/irix_6_1.sh Sun Jan 24 08:47:41 1999
***************
*** 42,50 ****
# shift
# libswanted="$*"
! if [ "X$usethreads" = "X$define" ]; then
! echo >&4 "IRIX 6.1 does not have POSIX threads."
! echo >&4 "You should upgrade to at least IRIX 6.3."
! echo >&4 "Cannot continue, aborting."
! exit 1
! fi
--- 42,54 ----
# 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
!
diff -c 'perl5.005_02/hints/linux.sh' 'perl5.005_03/hints/linux.sh'
Index: ./hints/linux.sh
*** ./hints/linux.sh Thu Jul 23 23:00:20 1998
--- ./hints/linux.sh Thu Feb 11 18:05:49 1999
***************
*** 18,23 ****
--- 18,44 ----
# No version of Linux supports setuid scripts.
d_suidsafe='undef'
+ # Debian and Red Hat, and perhaps other vendors, provide both runtime and
+ # development packages for some libraries. The runtime packages contain shared
+ # libraries with version information in their names (e.g., libgdbm.so.1.7.3);
+ # the development packages supplement this with versionless shared libraries
+ # (e.g., libgdbm.so).
+ #
+ # If you want to link against such a library, you must install the development
+ # version of the package.
+ #
+ # These packages use a -dev naming convention in both Debian and Red Hat:
+ # libgdbmg1 (non-development version of GNU libc 2-linked GDBM library)
+ # libgdbmg1-dev (development version of GNU libc 2-linked GDBM library)
+ # So make sure that for any libraries you wish to link Perl with under
+ # Debian or Red Hat you have the -dev packages installed.
+ #
+ # Some operating systems (e.g., Solaris 2.6) will link to a versioned shared
+ # library implicitly. For example, on Solaris, `ld foo.o -lgdbm' will find an
+ # appropriate version of libgdbm, if one is available; Linux, however, doesn't
+ # do the implicit mapping.
+ ignore_versioned_solibs='y'
+
# perl goes into the /usr tree. See the Filesystem Standard
# available via anonymous FTP at tsx-11.mit.edu in
# /pub/linux/docs/linux-standards/fsstnd.
***************
*** 187,215 ****
# Shimpei Yamashita <shimpei@socrates.patnet.caltech.edu>
# Message-Id: <33EF1634.B36B6500@pobox.com>
#
! # MkLinux (osname=linux,archname=ppc-linux), which differs slightly from other
! # linuces, needs special flags passed in order for dynamic loading to work.
# instead of the recommended:
# ccdlflags='-rdynamic'
#
# it should be:
# ccdlflags='-Wl,-E'
!
! # XXX EXPERIMENTAL A.D. 2/27/1998
! # XXX This script UU/usethreads.cbu will get 'called-back' by Configure
! # XXX after it has prompted the user for whether to use threads.
! cat > UU/usethreads.cbu <<'EOSH'
case "$usethreads" in
$define|true|[yY]*)
! ccflags="-D_REENTRANT $ccflags"
! # -lpthread needs to come before -lc but after other libraries such
! # as -lgdbm and such like. We assume here that -lc is present in
! # libswanted. If that fails to be true in future, then this can be
! # changed to add pthread to the very end of libswanted.
! set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
! shift
! libswanted="$*"
! ;;
esac
! EOSH
! # XXX EXPERIMENTAL --end of call-back
--- 208,238 ----
# Shimpei Yamashita <shimpei@socrates.patnet.caltech.edu>
# Message-Id: <33EF1634.B36B6500@pobox.com>
#
! # The DR2 of MkLinux (osname=linux,archname=ppc-linux) may need
! # special flags passed in order for dynamic loading to work.
# instead of the recommended:
+ #
# ccdlflags='-rdynamic'
#
# it should be:
# ccdlflags='-Wl,-E'
! #
! # So if your DR2 (DR3 came out summer 1998, consider upgrading)
! # has problems with dynamic loading, uncomment the
! # following three lines, make distclean, and re-Configure:
! #case "`uname -r | sed 's/^[0-9.-]*//'``arch`" in
! #'osfmach3ppc') ccdlflags='-Wl,-E' ;;
! #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="-D_REENTRANT $ccflags"
! set `echo X "$libswanted "| sed -e 's/ c / pthread c /'`
! shift
! libswanted="$*"
! ;;
esac
! EOCBU
diff -c /dev/null 'perl5.005_03/hints/mint.sh'
Index: hints/mint.sh
*** hints/mint.sh Wed Dec 31 18:00:00 1969
--- hints/mint.sh Thu Jan 28 19:13:55 1999
***************
*** 0 ****
--- 1,94 ----
+ # hints/mint.sh
+ #
+ # talk to gufl0000@stud.uni-sb.de if you want to change this file.
+ # Please read the README.mint file.
+ #
+ # misc stuff
+
+ case `uname -m` in
+ atarist*) archname="m68000-mint"
+ ;;
+ *) archname="m68k-mint"
+ ;;
+ esac
+
+ here=`pwd | tr -d '\015'`
+
+ cc='gcc'
+
+ # The weird include path is really to work around some bugs in
+ # broken system header files.
+ ccflags="-D__MINT__ -Uatarist -DDEBUGGING -I$here/../mint"
+
+ # libs
+
+ libpth="$prefix/lib /usr/lib /usr/local/lib"
+ glibpth="$libpth"
+ xlibpth="$libpth"
+
+ libswanted='gdbm socket port m'
+ so='none'
+
+ #
+ # compiler & linker flags
+ #
+ optimize='-O2 -fomit-frame-pointer -fno-defer-pop -fstrength-reduce'
+
+ # The setlocale function in the MiNTLib is actually a bad joke. We
+ # lend a workaround from Ultrix. If neither LC_ALL nor LANG is
+ # set in the environment, perl won't complain. If one is set to
+ # anything but "C" you will see a warning. Note that you can
+ # still use the GNU extension "$LANGUAGE" if you want to use
+ # the i18n features of some GNU packages.
+ util_cflags='ccflags="$ccflags -DLOCALE_ENVIRON_REQUIRED"'
+
+ #
+ # Some good answers to the questions in Configure:
+ usenm='true'
+ d_suidsafe='true'
+ clocktype='long'
+ usevfork='true'
+ d_fsetpos='fpos_t'
+ gidtype='gid_t'
+ groupstype='gid_t'
+ lseektype='long'
+ models='none'
+ modetype='mode_t'
+ sizetype='size_t'
+ timetype='time_t'
+ uidtype='uid_t'
+
+ # Don't remove that leading tab character (Configure Black Magic (TM)).
+ broken_pwd=
+ case "`/bin/pwd|tr -d xy|tr '\015\012' 'xy'`" in
+ *xy) broken_pwd=yes ;;
+ esac
+
+ if test X"$broken_pwd" = Xyes
+ then
+ echo " "
+ echo "*** Building fixed 'pwd'... (as described in README.mint) ***"
+ echo " "
+ cd mint
+ make pwd
+ cd ..
+ if test -x mint/pwd -a -w /usr/bin
+ then
+ echo " "
+ echo "*** Installing fixed 'pwd'... ***"
+ echo " "
+ cd mint
+ make install
+ cd ..
+ if cmp -s mint/pwd /usr/bin/pwd
+ then
+ echo "*** Installed fixed 'pwd' successfully. ***"
+ else
+ echo "*** Failed to install fixed 'pwd'. Aborting. ***"
+ exit 1
+ fi
+ else
+ echo "*** Cannot install fixed 'pwd'. Aborting. ***"
+ exit 1
+ fi
+ fi
diff -c 'perl5.005_02/hints/mpeix.sh' 'perl5.005_03/hints/mpeix.sh'
Index: ./hints/mpeix.sh
*** ./hints/mpeix.sh Thu Jul 23 23:00:20 1998
--- ./hints/mpeix.sh Thu Jan 28 19:13:55 1999
***************
*** 51,58 ****
# Linking.
#
lddlflags='-b'
! libs='-lbind -lsvipc -lsocket -lm -lc'
! loclibpth='/usr/local/lib /usr/contrib/lib /BIND/PUB/lib'
#
# External functions and data items.
#
--- 51,58 ----
# Linking.
#
lddlflags='-b'
! libs='-lbind -lsyslog -lcurses -lsvipc -lsocket -lm -lc'
! loclibpth='/usr/local/lib /usr/contrib/lib /BIND/PUB/lib /SYSLOG/PUB'
#
# External functions and data items.
#
diff -c 'perl5.005_02/hints/netbsd.sh' 'perl5.005_03/hints/netbsd.sh'
Index: ./hints/netbsd.sh
*** ./hints/netbsd.sh Thu Jul 23 23:00:21 1998
--- ./hints/netbsd.sh Sun Mar 14 15:01:09 1999
***************
*** 1,12 ****
# hints/netbsd.sh
#
! # talk to mrg@eterna.com.au 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.
case "$archname" in
'')
--- 1,11 ----
# hints/netbsd.sh
#
! # 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.
case "$archname" in
'')
***************
*** 19,52 ****
usedl="$undef"
;;
*)
! case `uname -m` in
! alpha|powerpc|pmax)
d_dlopen=$undef
! ;;
! # this doesn't work (yet).
! # alpha)
! # d_dlopen=$define
! # d_dlerror=$define
! # cccdlflags="-DPIC -fPIC $cccdlflags"
! # lddlflags="-shared $lddlflags"
! # ;;
! *)
d_dlopen=$define
d_dlerror=$define
# 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"
;;
esac
--- 18,43 ----
usedl="$undef"
;;
*)
! 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
! 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"
! else
! d_dlopen=$undef
! fi
;;
esac
***************
*** 55,79 ****
# 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.
case "$osvers" in
! 0.9*|1.0*|1.1*|1.2_*|1.2|1.2.*)
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.
case "$usevfork" in
'') usevfork=true ;;
esac
--- 46,76 ----
# 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.3.2.
case "$osvers" in
! 0.9*|1.[012]*|1.3|1.3.1)
d_setregid="$undef"
d_setreuid="$undef"
;;
esac
! # These are obsolete in any netbsd.
! d_setrgid="$undef"
! d_setruid="$undef"
!
! # 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'
+
+ # Recognize the NetBSD packages collection.
+ # GDBM might be here.
+ test -d /usr/pkg/lib && loclibpth="$loclibpth /usr/pkg/lib"
+ test -d /usr/pkg/include && locincpth="$locincpth /usr/pkg/include"
diff -c 'perl5.005_02/hints/next_3.sh' 'perl5.005_03/hints/next_3.sh'
Index: ./hints/next_3.sh
*** ./hints/next_3.sh Thu Jul 23 23:00:21 1998
--- ./hints/next_3.sh Sat Nov 21 12:45:41 1998
***************
*** 129,131 ****
--- 129,141 ----
# This is true whether we're on an HPPA machine or cross-compiling
# for one.
pp_cflags='optimize=""'
+
+ # The SysV IPC is optional (ftp://ftp.nluug.nl/pub/comp/next/SysVIPC/)
+ # Gerben_Wierda@RnA.nl
+ if [ -f /usr/local/lib/libIPC.a ]; then
+ libswanted="$libswanted IPC"
+ # As of Sep 1998 d_msg wasn't supported in that library,
+ # only d_sem and d_shm, but Configure should be able to
+ # figure that out. --jhi
+ # Note also the next3 ext/IPC/SysV hints file.
+ fi
diff -c 'perl5.005_02/hints/next_4.sh' 'perl5.005_03/hints/next_4.sh'
Index: ./hints/next_4.sh
*** ./hints/next_4.sh Thu Jul 23 23:00:21 1998
--- ./hints/next_4.sh Wed Nov 4 21:22:39 1998
***************
*** 12,18 ****
#
useposix='undef'
! libpth='/lib /usr/lib'
libswanted=' '
libc='/NextLibrary/Frameworks/System.framework/System'
--- 12,18 ----
#
useposix='undef'
! libpth='/lib /usr/lib /usr/local/lib'
libswanted=' '
libc='/NextLibrary/Frameworks/System.framework/System'
***************
*** 35,41 ****
#
# archs='m68k i386'
#
! archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'`
#
# leave the following part alone
--- 35,54 ----
#
# archs='m68k i386'
#
!
! # On m68k machines, toke.c cannot be compiled at all for i386 and it can
! # only be compiled for m68k itself without optimization (this is under
! # OPENSTEP 4.2).
! #
! if [ `hostinfo | grep 'NeXT Mach.*:' | sed 's/.*RELEASE_//'` = M68K ]
! then
! echo "Cross compilation is impossible on m68k hardware under OS 4"
! echo "Forcing architecture to m68k only"
! toke_cflags='optimize=""'
! archs='m68k'
! else
! archs=`/bin/lipo -info /usr/lib/libm.a | sed -n 's/^[^:]*:[^:]*: //p'`
! fi
#
# leave the following part alone
diff -c 'perl5.005_02/hints/openbsd.sh' 'perl5.005_03/hints/openbsd.sh'
Index: ./hints/openbsd.sh
*** ./hints/openbsd.sh Thu Jul 23 23:00:21 1998
--- ./hints/openbsd.sh Sat Feb 13 12:05:51 1999
***************
*** 48,51 ****
--- 48,61 ----
# Allow a command-line override, such as -Doptimize=-g
test "$optimize" || optimize='-O2'
+ # 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]*)
+ # any openbsd version dependencies with pthreads?
+ libswanted="$libswanted pthread"
+ esac
+ EOCBU
+
# end
diff -c 'perl5.005_02/hints/os2.sh' 'perl5.005_03/hints/os2.sh'
Index: ./hints/os2.sh
*** ./hints/os2.sh Thu Jul 23 23:00:21 1998
--- ./hints/os2.sh Sun Jan 24 08:47:47 1999
***************
*** 113,122 ****
aout_ar='ar'
aout_plibext='.a'
aout_lddlflags="-Zdll $ld_dll_optimize"
if [ $emxcrtrev -ge 50 ]; then
! aout_ldflags='-Zexe -Zsmall-conv -Zstack 32000'
else
! aout_ldflags='-Zexe -Zstack 32000'
fi
# To get into config.sh:
--- 113,123 ----
aout_ar='ar'
aout_plibext='.a'
aout_lddlflags="-Zdll $ld_dll_optimize"
+ # Cannot have 32000K stack: get SYS0170 ?!
if [ $emxcrtrev -ge 50 ]; then
! aout_ldflags='-Zexe -Zsmall-conv -Zstack 16000'
else
! aout_ldflags='-Zexe -Zstack 16000'
fi
# To get into config.sh:
***************
*** 249,263 ****
d_getprior='define'
d_setprior='define'
- if [ "X$usethreads" = "X$define" ]; then
- 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"
- fi
-
# The next two are commented. pdksh handles #!, extproc gives no path part.
# sharpbang='extproc '
# shsharp='false'
--- 250,255 ----
***************
*** 268,273 ****
--- 260,280 ----
# Copy pod:
cp ./README.os2 ./pod/perlos2.pod
+
+ # 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 install the external modules. We are in the ./hints directory.
diff -c 'perl5.005_02/hints/os390.sh' 'perl5.005_03/hints/os390.sh'
Index: ./hints/os390.sh
*** ./hints/os390.sh Sun Aug 2 00:15:07 1998
--- ./hints/os390.sh Sun Dec 13 10:19:23 1998
***************
*** 17,22 ****
--- 17,24 ----
# To get ANSI C, we need to use c89, and ld doesn't exist
cc='c89'
ld='c89'
+ # To link via definition side decks we need the dll option
+ cccdlflags='-W 0,dll,"langlvl(extended)"'
# c89 hides most of the useful header stuff, _ALL_SOURCE turns it on again,
# YYDYNAMIC ensures that the OS/390 yacc generated parser is reentrant.
# -DEBCDIC should come from Configure.
***************
*** 54,56 ****
--- 56,61 ----
esac
archobjs=ebcdic.o
+
+ # We have our own cppstdin.
+ echo 'cat >.$$.c; '"$cc"' -E -Wc,NOLOC ${1+"$@"} .$$.c; rm .$$.c' > cppstdin
diff -c 'perl5.005_02/hints/sco.sh' 'perl5.005_03/hints/sco.sh'
Index: ./hints/sco.sh
*** ./hints/sco.sh Thu Jul 23 23:00:21 1998
--- ./hints/sco.sh Thu Feb 11 18:05:49 1999
***************
*** 1,140 ****
! # sco.sh
# Courtesy of Joel Rosi-Schwartz <j.schwartz@agonet.it>
!
# Additional SCO version info from
# Peter Wolfe <wolfe@teloseng.com>
- # Last revised
# Fri Jul 19 14:54:25 EDT 1996
! # by Andy Dougherty <doughera@lafcol.lafayette.edu>
!
! # To use gcc, use sh Configure -Dcc=gcc
! # But gcc will *not* do dynamic laoding on 3.2.5,
! # for that use sh Configure -Dcc=icc
! # See below for more details.
# figure out what SCO version we are. The output of uname -X is
# something like:
# System = SCO_SV
# Node = xxxxx
# Release = 3.2v5.0.0
# KernelID = 95/08/08
! # Machine = Pentium
# BusType = ISA
# Serial = xxxxx
# Users = 5-user
# OEM# = 0
# Origin# = 1
! # NumCPU = 1
!
! # Use /bin/uname (because Gnu may be first on the path and
# it does not support -X) to figure out what SCO version we are:
! case `/bin/uname -X | egrep '^Release'` in
! *3.2v4.*) scorls=3 ;; # I don't know why this is 3 instead of 4 :-)
! *3.2v5.*) scorls=5 ;;
! *) scorls=3 ;; # this probabaly shouldn't happen
esac
# Try to use libintl.a since it has strcoll and strxfrm
libswanted="intl $libswanted"
# Try to use libdbm.nfs.a since it has dbmclose.
- #
if test -f /usr/lib/libdbm.nfs.a ; then
libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'`
fi
- set X $libswanted
- shift
- libswanted="$*"
# We don't want Xenix cross-development libraries
glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'`
xlibpth=''
! case "$cc" in
! *gcc*) ccflags="$ccflags -U M_XENIX"
! optimize="$optimize -O2"
! ;;
! scocc) ;;
!
! # On SCO 3.2v5 both cc and icc can build dynamic load, but cc core
! # dumps if optimised, so I am only setting this up for icc.
! # It is possible that some 3.2v4.2 system have icc, I seem to
! # recall it was available as a seperate product but I have no
! # knowledge if it can do dynamic loading and if so how.
! # Joel Rosi-Schwartz
! icc)# Apparently, SCO's cc gives rather verbose warnings
! # Set -w0 to turn them off.
! case $scorls in
! 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;;
! 5) ccflags="$ccflags -belf -w0 -U M_XENIX"
! optimize="-O1" # -g -O1 will not work
! # optimize="-O0" may be needed for pack test to pass.
! lddlflags='-G -L/usr/local/lib'
! ldflags=' -W l,-Bexport -L/usr/local/lib'
! dlext='so'
! dlsrc='dl_dlopen.xs'
! usedl='define'
! ;;
! esac
! ;;
!
! *) # Apparently, miniperl core dumps if -O is used.
! case "$optimize" in
! '') optimize=none ;;
! esac
! # Apparently, SCO's cc gives rather verbose warnings
! # Set -w0 to turn them off.
! case $scorls in
! 3) ccflags="$ccflags -W0 -quiet -U M_XENIX" ;;
! 5) ccflags="$ccflags -w0 -U M_XENIX -DPERL_SCO5" ;;
! esac
! ;;
! esac
! i_varargs=undef
!
# I have received one report that nm extraction doesn't work if you're
# using the scocc compiler. This system had the following 'myconfig'
# uname='xxx xxx 3.2 2 i386 '
# cc='scocc', optimize='-O'
! usenm='false'
# If you want to use nm, you'll probably have to use nm -p. The
# following does that for you:
nm_opt='-p'
# I have received one report that you can't include utime.h in
# pp_sys.c. Uncomment the following line if that happens to you:
# i_utime=undef
! # Apparently, some versions of SCO include both .so and .a libraries,
! # but they don't mix as they do on other ELF systems. The upshot is
! # that Configure finds -ldl (libdl.so) but 'ld' complains it can't
! # find libdl.a.
! # I don't know which systems have this feature, so I'll just remove
! # -dl from libswanted for all SCO systems until someone can figure
! # out how to get dynamic loading working on SCO.
! #
! # The output of uname -X on one such system was
! # System = SCO_SV
! # Node = xxxxx
! # Release = 3.2v5.0.0
! # KernelID = 95/08/08
! # Machine = Pentium
! # BusType = ISA
! # Serial = xxxxx
! # Users = 5-user
! # OEM# = 0
! # Origin# = 1
! # NumCPU = 1
! #
! # The 5.0.0 on the Release= line is probably the thing to watch.
! # Andy Dougherty <doughera@lafcol.lafayette.edu>
! # Thu Feb 1 15:06:56 EST 1996
! libswanted=`echo " $libswanted " | sed -e 's/ dl / /'`
! set X $libswanted
! shift
! libswanted="$*"
!
# Perl 5.003_05 and later try to include both <time.h> and <sys/select.h>
# in pp_sys.c, but that fails due to a redefinition of struct timeval.
# This will generate a WHOA THERE. Accept the default.
i_sysselct=$undef
--- 1,233 ----
! # sco.sh
# Courtesy of Joel Rosi-Schwartz <j.schwartz@agonet.it>
! ###############################################################
# Additional SCO version info from
# Peter Wolfe <wolfe@teloseng.com>
# Fri Jul 19 14:54:25 EDT 1996
! # and again Tue Sep 29 16:37:25 EDT 1998
! # by Andy Dougherty <doughera@lafayette.edu>
! # Mostly rewritten on
! # Tue Jan 19 23:00:00 CET 1999
! # by Francois Desarmenien <desar@club-internet.fr>
! ###############################################################
! #
! # To use cc, use sh Configure
! # To use gcc, use sh Configure -Dcc=gcc
! #
! # Default on 3.2v4 is to use static link (dynamic loading unsupported).
! # Default on 3.2v5 is to use dynamic loading.
! # To use static linkink instead, use to sh Configure -Dusedl=n
! #
! # Warning: - to use dynamic loading with gcc, you need gcc 2.8.0 or later
! # ******** - to compile with older releases of gcc, use Configure -Dusedl=n
! # or it wont compile properly
! #
! ###############################################################
! # NOTES:
! # -----
! #
! # I Have removed inclusion of ODBM_File for OSR5
! # because it core dumps and make tests fails.
! #
! # Support for icc compiler has been removed, because it 'breaks'
! # a lot of code :-(
! #
! # It's *always* a good idea to first make a static link to be sure to
! # have all symbols resolved with the current choice of libraries, since
! # with dynamic linking, unresolved symbols are allowed an will be detected
! # only at runtime (when you try to load the module or worse, when you call
! # the symbol)
! #
! # The best choice of compiler on OSR 5 (3.2v5.*) seems to be gcc >= 2.8.0:
! # -You cannot optimize with genuine sco cc (miniperl core dumps),
! # so Perl is faster if compiled with gcc.
! # -Even optimized for speed, gcc generated code is smaller (!!!)
! # -gcc is free
! # -I use ld to link which is distributed with the core OS distribution, so you
! # don't need to buy the developement kit, just find someone kind enough to
! # give you a binary release of gcc.
! #
! #
+ ###############################################################
# figure out what SCO version we are. The output of uname -X is
# something like:
# System = SCO_SV
# Node = xxxxx
# Release = 3.2v5.0.0
# KernelID = 95/08/08
! # Machine = Pentium
# BusType = ISA
# Serial = xxxxx
# Users = 5-user
# OEM# = 0
# Origin# = 1
! # NumCPU = 1
!
! # Use /bin/uname (because GNU uname may be first in $PATH and
# it does not support -X) to figure out what SCO version we are:
! # Matching '^Release' is broken by locale setting:
! # matching '3.2v' should be enough -- FD
! case `/bin/uname -X | egrep '3\.2v'` in
! *3.2v4.*) scorls=3 ;; # OSR 3
! *3.2v5.*) scorls=5 ;; # OSR 5
! *)
! # Future of SCO OSR is SCO UnixWare: there should not be new OSR releases
! echo "************************************************************" >&4
! echo "" >&4
! echo " sco.sh hints file only supports:" >&4
! echo "" >&4
! echo " - SCO Unix 3.2v4.x (OSR 3)" >&4
! echo " - SCO Unix 3.2v5.x (OSR 5)" >&4
! echo "" >&4
! echo "" >&4
! echo " For UnixWare, use svr4.sh hints instead" >&4
! echo "" >&4
! echo "***********************************************************" >&4
! exit
! ;;
esac
+ ###############################################################
+ # Common fixes for all compilers an releases:
+
+ ###############################################################
+ # What is true for SCO5 is true for SCO3 too today, so let's have a single
+ # symbol for both
+ ccflags="-U M_XENIX -D PERL_SCO"
+
+ ###############################################################
+ # Compilers options section:
+ if test "$scorls" = "3"
+ then
+ dlext=''
+ case "$cc" in
+ gcc) optimize='-O2' ;;
+ *) ccflags="$ccflags -W0 -quiet"
+ optimize='-O' ;;
+ esac
+ else
+ ###############################################################
+ # Need this in release 5 because of changed fpu exeption rules
+ ccflags="$ccflags -D PERL_SCO5"
+
+ ###############################################################
+ # In Release 5, always compile ELF objects
+ case "$cc" in
+ gcc)
+ ccflags="$ccflags -melf"
+ optimize='-O2'
+ ;;
+ *)
+ ccflags="$ccflags -w0 -belf"
+ optimize='-O0'
+ ;;
+ esac
+ ###############################################################
+ # Dynamic loading section:
+ #
+ # We use ld to build shared libraries as it is always available
+ # and seems to work better than GNU's one on SCO
+ #
+ # ccdlflags : must tell the linker to export all global symbols
+ # cccdlflags: must tell the compiler to generate relocatable code
+ # lddlflags : must tell the linker to output a shared library
+ #
+ # /usr/local/lib is added for convenience, since 'foreign' libraries
+ # are usually put there in sco
+ #
+ if test "$usedl" != "n"; then
+ ld='ld'
+ case "$cc" in
+ gcc)
+ ccdlflags='-Xlinker -Bexport -L/usr/local/lib'
+ cccdlflags='-fpic'
+ lddlflags='-G -L/usr/local/lib'
+ ;;
+ *)
+ ccdlflags='-Bexport -L/usr/local/lib'
+ cccdlflags='-Kpic'
+ lddlflags='-G -L/usr/local/lib'
+ ;;
+ esac
+
+ ###############################################################
+ # Use dynamic loading
+ usedl='define'
+ dlext='so'
+ dlsrc='dl_dlopen.xs'
+
+ ###############################################################
+ # Force to define those symbols, as they are #defines and not
+ # catched by Configure, and they are useful
+ d_dlopen='define'
+ d_dlerror='define'
+ fi
+ fi
+
+
+ ###############################################################
+ # Various hints, common to all releases, to have it work better:
+
+ ###############################################################
+ # We need to remove libdl, as libdl.so exists, but ld complains
+ # it can't find libdl.a ! Bug or feature ? :-)
+ libswanted=`echo " $libswanted " | sed -e 's/ dl / /'`
+ set X $libswanted
+ shift
+ libswanted="$*"
+
+ ###############################################################
# Try to use libintl.a since it has strcoll and strxfrm
libswanted="intl $libswanted"
+
+ ###############################################################
# Try to use libdbm.nfs.a since it has dbmclose.
if test -f /usr/lib/libdbm.nfs.a ; then
libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'`
+ set X $libswanted
+ shift
+ libswanted="$*"
+ fi
+
+ ###############################################################
+ # We disable ODBM_File if OSR5 because it's mostly broken
+ # but keep it for ODT3 as it seems to work.
+ if test "$scorls" = "5"; then
+ i_dbm='undef'
fi
+ ###############################################################
# We don't want Xenix cross-development libraries
glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'`
xlibpth=''
! ###############################################################
# I have received one report that nm extraction doesn't work if you're
# using the scocc compiler. This system had the following 'myconfig'
# uname='xxx xxx 3.2 2 i386 '
# cc='scocc', optimize='-O'
! # You can override this with Configure -Dusenm.
! case "$usenm" in
! '') usenm='false' ;;
! esac
+ ###############################################################
# If you want to use nm, you'll probably have to use nm -p. The
# following does that for you:
nm_opt='-p'
+ ###############################################################
# I have received one report that you can't include utime.h in
# pp_sys.c. Uncomment the following line if that happens to you:
# i_utime=undef
! ###############################################################
# Perl 5.003_05 and later try to include both <time.h> and <sys/select.h>
# in pp_sys.c, but that fails due to a redefinition of struct timeval.
# This will generate a WHOA THERE. Accept the default.
i_sysselct=$undef
+
+
+ ###############################################################
+ #END of hint file
diff -c 'perl5.005_02/hints/solaris_2.sh' 'perl5.005_03/hints/solaris_2.sh'
Index: ./hints/solaris_2.sh
*** ./hints/solaris_2.sh Sat Aug 1 23:50:40 1998
--- ./hints/solaris_2.sh Sun Jan 24 08:47:49 1999
***************
*** 261,285 ****
# XXX
EOSH
! if [ "X$usethreads" = "X$define" ]; then
! ccflags="-D_REENTRANT $ccflags"
! # -lpthread needs to come before -lc but after other libraries such
! # as -lgdbm and such like. We assume here that -lc is present in
! # libswanted. If that fails to be true in future, then this can be
! # changed to add pthread to the very end of libswanted.
! # 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>
--- 261,286 ----
# 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>
***************
*** 293,310 ****
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
! fi
# This is just a trick to include some useful notes.
cat > /dev/null <<'End_of_Solaris_Notes'
--- 294,313 ----
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 is just a trick to include some useful notes.
cat > /dev/null <<'End_of_Solaris_Notes'
diff -c 'perl5.005_02/hints/ultrix_4.sh' 'perl5.005_03/hints/ultrix_4.sh'
Index: ./hints/ultrix_4.sh
*** ./hints/ultrix_4.sh Thu Jul 23 23:00:22 1998
--- ./hints/ultrix_4.sh Thu Feb 11 18:05:49 1999
***************
*** 34,49 ****
*gcc*) ;;
*)
case "$osvers" in
! *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200" ;;
! *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3200"
# Prototypes sometimes cause compilation errors in 4.2.
prototype=undef
case "$myuname" in
*risc*) d_volatile=undef ;;
esac
;;
! *4.3*) ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 3200" ;;
! *) ccflags="$ccflags -std -Olimit 3200" ;;
esac
;;
esac
--- 34,49 ----
*gcc*) ;;
*)
case "$osvers" in
! *4.1*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3400" ;;
! *4.2*) ccflags="$ccflags -DLANGUAGE_C -Olimit 3400"
# Prototypes sometimes cause compilation errors in 4.2.
prototype=undef
case "$myuname" in
*risc*) d_volatile=undef ;;
esac
;;
! *4.3*) ccflags="$ccflags -std1 -DLANGUAGE_C -Olimit 3400" ;;
! *) ccflags="$ccflags -std -Olimit 3400" ;;
esac
;;
esac
diff -c /dev/null 'perl5.005_03/hints/uwin.sh'
Index: hints/uwin.sh
*** hints/uwin.sh Wed Dec 31 18:00:00 1969
--- hints/uwin.sh Mon Nov 23 19:02:20 1998
***************
*** 0 ****
--- 1,36 ----
+ #
+ # hint file for U/WIN (UNIX for Windows 95/NT)
+ #
+ # created for U/WIN version 1.55
+ # running under Windows NT 4.0 SP 3
+ # using MSVC++ 5.0 for the compiler
+ #
+ # created by Joe Buehler (jbuehler@hekimian.com)
+ #
+ # for information about U/WIN see www.gtlinc.com
+ #
+
+ #ccflags=-D_BSDCOMPAT
+ # confusion in Configure over preprocessor
+ cppstdin=`pwd`/cppstdin
+ cpprun=`pwd`/cppstdin
+ # pwd.h confuses Configure
+ d_pwcomment=undef
+ d_pwgecos=define
+ # work around case-insensitive file names
+ firstmakefile=GNUmakefile
+ # avoid compilation error
+ i_utime=undef
+ # compile/link flags
+ ldflags=-g
+ optimize=-g
+ static_ext="B Data/Dumper Fcntl IO IPC/SysV Opcode POSIX SDBM_File Socket attrs"
+ #static_ext=none
+ # dynamic loading needs work
+ usedl=undef
+ # perl malloc will not work
+ usemymalloc=n
+ # cannot use nm
+ usenm=undef
+ # vfork() is buggy (as of 1.55 anyway)
+ usevfork=false
diff -c 'perl5.005_02/hv.c' 'perl5.005_03/hv.c'
Index: ./hv.c
*** ./hv.c Thu Jul 23 23:00:23 1998
--- ./hv.c Sat Mar 27 11:57:00 1999
***************
*** 1,6 ****
/* hv.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* hv.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 18,24 ****
#ifndef PERL_OBJECT
static void hsplit _((HV *hv));
static void hfreeentries _((HV *hv));
! static HE* more_he _((void));
#endif
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
--- 18,24 ----
#ifndef PERL_OBJECT
static void hsplit _((HV *hv));
static void hfreeentries _((HV *hv));
! static void more_he _((void));
#endif
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
***************
*** 32,53 ****
new_he(void)
{
HE* he;
! if (PL_he_root) {
! he = PL_he_root;
! PL_he_root = HeNEXT(he);
! return he;
! }
! return more_he();
}
STATIC void
del_he(HE *p)
{
HeNEXT(p) = (HE*)PL_he_root;
PL_he_root = p;
}
! STATIC HE*
more_he(void)
{
register HE* he;
--- 32,56 ----
new_he(void)
{
HE* he;
! LOCK_SV_MUTEX;
! if (!PL_he_root)
! more_he();
! he = PL_he_root;
! PL_he_root = HeNEXT(he);
! UNLOCK_SV_MUTEX;
! return he;
}
STATIC void
del_he(HE *p)
{
+ LOCK_SV_MUTEX;
HeNEXT(p) = (HE*)PL_he_root;
PL_he_root = p;
+ UNLOCK_SV_MUTEX;
}
! STATIC void
more_he(void)
{
register HE* he;
***************
*** 60,66 ****
he++;
}
HeNEXT(he) = 0;
- return new_he();
}
STATIC HEK *
--- 63,68 ----
***************
*** 830,848 ****
newHVhv(HV *ohv)
{
register HV *hv;
- register XPVHV* xhv;
STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
hv = newHV();
while (hv_max && hv_max + 1 >= hv_fill * 2)
hv_max = hv_max / 2; /* Is always 2^n-1 */
! ((XPVHV*)SvANY(hv))->xhv_max = hv_max;
if (!hv_fill)
return hv;
#if 0
! if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) {
/* Quick way ???*/
}
else
--- 832,849 ----
newHVhv(HV *ohv)
{
register HV *hv;
STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
hv = newHV();
while (hv_max && hv_max + 1 >= hv_fill * 2)
hv_max = hv_max / 2; /* Is always 2^n-1 */
! HvMAX(hv) = hv_max;
if (!hv_fill)
return hv;
#if 0
! if (! SvTIED_mg((SV*)ohv, 'P')) {
/* Quick way ???*/
}
else
***************
*** 853,859 ****
HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
/* Slow way */
! hv_iterinit(hv);
while (entry = hv_iternext(ohv)) {
hv_store(hv, HeKEY(entry), HeKLEN(entry),
SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
--- 854,860 ----
HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
/* Slow way */
! hv_iterinit(ohv);
while (entry = hv_iternext(ohv)) {
hv_store(hv, HeKEY(entry), HeKLEN(entry),
SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
***************
*** 1014,1020 ****
xhv = (XPVHV*)SvANY(hv);
oldentry = entry = xhv->xhv_eiter;
! if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
SV *key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
--- 1015,1021 ----
xhv = (XPVHV*)SvANY(hv);
oldentry = entry = xhv->xhv_eiter;
! if (mg = SvTIED_mg((SV*)hv, 'P')) {
SV *key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
***************
*** 1149,1154 ****
--- 1150,1156 ----
} */
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
+ LOCK_STRTAB_MUTEX;
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
if (HeHASH(entry) != hash) /* strings can't be equal */
***************
*** 1168,1173 ****
--- 1170,1176 ----
}
break;
}
+ UNLOCK_STRTAB_MUTEX;
if (!found)
warn("Attempt to free non-existent shared string");
***************
*** 1193,1198 ****
--- 1196,1202 ----
*/
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
+ LOCK_STRTAB_MUTEX;
oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
if (HeHASH(entry) != hash) /* strings can't be equal */
***************
*** 1219,1224 ****
--- 1223,1229 ----
}
++HeVAL(entry); /* use value slot as REFCNT */
+ UNLOCK_STRTAB_MUTEX;
return HeKEY_hek(entry);
}
diff -c 'perl5.005_02/hv.h' 'perl5.005_03/hv.h'
Index: ./hv.h
*** ./hv.h Thu Jul 23 23:00:23 1998
--- ./hv.h Sat Mar 27 11:56:57 1999
***************
*** 1,6 ****
/* hv.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* hv.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/installman' 'perl5.005_03/installman'
Index: ./installman
*** ./installman Thu Jul 23 23:00:23 1998
--- ./installman Mon Nov 23 18:18:57 1998
***************
*** 134,140 ****
# Convert name from File/Basename.pm to File::Basename.3 format,
# if necessary.
$manpage =~ s#\.p(m|od)$##;
! if ($^O eq 'os2' || $^O eq 'amigaos') {
$manpage =~ s#/#.#g;
} else {
$manpage =~ s#/#::#g;
--- 134,140 ----
# Convert name from File/Basename.pm to File::Basename.3 format,
# if necessary.
$manpage =~ s#\.p(m|od)$##;
! if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin') {
$manpage =~ s#/#.#g;
} else {
$manpage =~ s#/#::#g;
diff -c 'perl5.005_02/installperl' 'perl5.005_03/installperl'
Index: ./installperl
*** ./installperl Thu Jul 23 23:00:24 1998
--- ./installperl Sat Jan 16 10:31:26 1999
***************
*** 220,225 ****
--- 220,230 ----
@corefiles = <*.h libperl*.*>;
# AIX needs perl.exp installed as well.
push(@corefiles,'perl.exp') if $^O eq 'aix';
+ if ($^O eq 'mpeix') {
+ # MPE needs mpeixish.h installed as well.
+ mkpath("$installarchlib/CORE/mpeix", 1, 0777);
+ push(@corefiles,'mpeix/mpeixish.h');
+ }
# If they have built sperl.o...
push(@corefiles,'sperl.o') if -f 'sperl.o';
}
***************
*** 251,257 ****
my $mainperl_is_instperl = 0;
! if (!$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR
&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
my($usrbinperl) = "$mainperldir/$perl$exe_ext";
my($instperl) = "$installbin/$perl$exe_ext";
--- 256,263 ----
my $mainperl_is_instperl = 0;
! if ($Config{installusrbinperl} eq 'define' &&
! !$versiononly && !$nonono && !$Is_W32 && !$Is_VMS && -t STDIN && -t STDERR
&& -w $mainperldir && ! samepath($mainperldir, $installbin)) {
my($usrbinperl) = "$mainperldir/$perl$exe_ext";
my($instperl) = "$installbin/$perl$exe_ext";
***************
*** 327,333 ****
# Install pod pages. Where? I guess in $installprivlib/pod.
! if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
mkpath("${installprivlib}/pod", 1, 0777);
# If Perl 5.003's perldiag.pod is there, rename it.
--- 333,339 ----
# Install pod pages. Where? I guess in $installprivlib/pod.
! unless ( $versiononly && !($installprivlib =~ m/\Q$]/)) { # as line 200
mkpath("${installprivlib}/pod", 1, 0777);
# If Perl 5.003's perldiag.pod is there, rename it.
***************
*** 564,571 ****
and chmod($name =~ /\.(so|$dlext)$/o ? 0555 : 0444,
"$installlib/$name");
}
- } elsif (-d $_) {
- mkpath("$installlib/$name", 1, 0777);
}
}
--- 570,575 ----
diff -c 'perl5.005_02/intrpvar.h' 'perl5.005_03/intrpvar.h'
Index: ./intrpvar.h
*** ./intrpvar.h Thu Jul 23 23:00:24 1998
--- ./intrpvar.h Sun Nov 1 21:07:30 1998
***************
*** 199,204 ****
--- 199,205 ----
#ifdef USE_THREADS
PERLVAR(Ithrsv, SV *) /* struct perl_thread for main thread */
PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */
+ PERLVAR(Istrtab_mutex, perl_mutex) /* Mutex for string table access */
#endif /* USE_THREADS */
PERLVARI(Ibytecode_iv_overflows,int, 0) /* from bytecode.h */
diff -c 'perl5.005_02/iperlsys.h' 'perl5.005_03/iperlsys.h'
Index: ./iperlsys.h
*** ./iperlsys.h Thu Jul 23 23:00:24 1998
--- ./iperlsys.h Thu Mar 4 18:34:16 1999
***************
*** 114,120 ****
virtual int Printf(PerlIO*, int &err, const char *,...) = 0;
virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0;
virtual long Tell(PerlIO*, int &err) = 0;
! virtual int Seek(PerlIO*, off_t, int, int &err) = 0;
virtual void Rewind(PerlIO*, int &err) = 0;
virtual PerlIO * Tmpfile(int &err) = 0;
virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0;
--- 114,120 ----
virtual int Printf(PerlIO*, int &err, const char *,...) = 0;
virtual int Vprintf(PerlIO*, int &err, const char *, va_list) = 0;
virtual long Tell(PerlIO*, int &err) = 0;
! virtual int Seek(PerlIO*, Off_t, int, int &err) = 0;
virtual void Rewind(PerlIO*, int &err) = 0;
virtual PerlIO * Tmpfile(int &err) = 0;
virtual int Getpos(PerlIO*, Fpos_t *, int &err) = 0;
***************
*** 322,331 ****
extern int PerlIO_vprintf _((PerlIO *, const char *, va_list));
#endif
#ifndef PerlIO_tell
! extern long PerlIO_tell _((PerlIO *));
#endif
#ifndef PerlIO_seek
! extern int PerlIO_seek _((PerlIO *,off_t,int));
#endif
#ifndef PerlIO_rewind
extern void PerlIO_rewind _((PerlIO *));
--- 322,331 ----
extern int PerlIO_vprintf _((PerlIO *, const char *, va_list));
#endif
#ifndef PerlIO_tell
! extern Off_t PerlIO_tell _((PerlIO *));
#endif
#ifndef PerlIO_seek
! extern int PerlIO_seek _((PerlIO *, Off_t, int));
#endif
#ifndef PerlIO_rewind
extern void PerlIO_rewind _((PerlIO *));
***************
*** 907,912 ****
--- 907,913 ----
#define PerlSock_inet_addr(c) inet_addr(c)
#define PerlSock_inet_ntoa(i) inet_ntoa(i)
#define PerlSock_listen(s, b) listen(s, b)
+ #define PerlSock_recv(s, b, l, f) recv(s, b, l, f)
#define PerlSock_recvfrom(s, b, l, f, from, fromlen) \
recvfrom(s, b, l, f, from, fromlen)
#define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t)
diff -c 'perl5.005_02/lib/AutoLoader.pm' 'perl5.005_03/lib/AutoLoader.pm'
Index: ./lib/AutoLoader.pm
*** ./lib/AutoLoader.pm Thu Jul 23 23:00:25 1998
--- ./lib/AutoLoader.pm Thu Jan 21 19:03:55 1999
***************
*** 178,184 ****
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
future calls to the subroutine will bypass the AUTOLOAD mechanism.
=head2 Subroutine Stubs
--- 178,184 ----
thus (presumably) defining the needed subroutine. AUTOLOAD will then
C<goto> the newly defined subroutine.
! 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,272 ****
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
create the individual files. L<ExtUtils::MakeMaker> will invoke
B<AutoSplit> automatically if B<AutoLoader> is used in a module source
file.
--- 266,272 ----
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 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 -c 'perl5.005_02/lib/AutoSplit.pm' 'perl5.005_03/lib/AutoSplit.pm'
Index: ./lib/AutoSplit.pm
*** ./lib/AutoSplit.pm Fri Aug 7 19:09:12 1998
--- ./lib/AutoSplit.pm Tue Dec 29 08:30:55 1998
***************
*** 11,17 ****
$Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime
);
! $VERSION = "1.0302";
@ISA = qw(Exporter);
@EXPORT = qw(&autosplit &autosplit_lib_modules);
@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
--- 11,17 ----
$Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime
);
! $VERSION = "1.0303";
@ISA = qw(Exporter);
@EXPORT = qw(&autosplit &autosplit_lib_modules);
@EXPORT_OK = qw($Verbose $Keep $Maxlen $CheckForAutoloader $CheckModTime);
***************
*** 219,225 ****
while (<IN>) {
# Skip pod text.
$fnr++;
! $in_pod = 1 if /^=/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/);
--- 219,225 ----
while (<IN>) {
# Skip pod text.
$fnr++;
! $in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/);
diff -c 'perl5.005_02/lib/Benchmark.pm' 'perl5.005_03/lib/Benchmark.pm'
Index: ./lib/Benchmark.pm
*** ./lib/Benchmark.pm Fri Aug 7 22:02:41 1998
--- ./lib/Benchmark.pm Sun Nov 29 18:22:12 1998
***************
*** 124,129 ****
--- 124,134 ----
Returns the difference between two Benchmark times as a Benchmark
object suitable for passing to timestr().
+ =item timesum ( T1, T2 )
+
+ Returns the sum of two Benchmark times as a Benchmark object suitable
+ for passing to timestr().
+
=item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] )
Returns a string that formats the times in the TIMEDIFF object in
***************
*** 291,296 ****
--- 296,310 ----
push(@r, $a->[$i] - $b->[$i]);
}
bless \@r;
+ }
+
+ sub timesum {
+ my($a, $b) = @_;
+ my @r;
+ for (my $i=0; $i < @$a; ++$i) {
+ push(@r, $a->[$i] + $b->[$i]);
+ }
+ bless \@r;
}
sub timestr {
diff -c 'perl5.005_02/lib/CGI.pm' 'perl5.005_03/lib/CGI.pm'
Index: ./lib/CGI.pm
Prereq: 1.32
*** ./lib/CGI.pm Thu Jul 23 23:00:29 1998
--- ./lib/CGI.pm Thu Feb 11 18:05:57 1999
***************
*** 15,25 ****
# listing the modifications you have made.
# The most recent version and complete docs are available at:
! # http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
! # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
! $CGI::revision = '$Id: CGI.pm,v 1.32 1998/05/28 21:55:43 lstein Exp lstein $';
! $CGI::VERSION='2.42';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
--- 15,24 ----
# listing the modifications you have made.
# The most recent version and complete docs are available at:
! # http://stein.cshl.org/WWW/software/CGI/
! $CGI::revision = '$Id: CGI.pm,v 1.5 1998/12/06 10:19:48 lstein Exp $';
! $CGI::VERSION='2.46';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
# UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
***************
*** 59,64 ****
--- 58,69 ----
# Change this to 1 to disable uploads entirely:
$DISABLE_UPLOADS = 0;
+ # Change this to 1 to suppress redundant HTTP headers
+ $HEADERS_ONCE = 0;
+
+ # separate the name=value pairs by semicolons rather than ampersands
+ $USE_PARAM_SEMICOLONS = 0;
+
# Other globals that you shouldn't worry about.
undef $Q;
$BEEN_THERE = 0;
***************
*** 116,123 ****
$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
# Turn on special checking for Doug MacEachern's modperl
! if (defined($ENV{'GATEWAY_INTERFACE'}) &&
! ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//))
{
$| = 1;
require Apache;
--- 121,129 ----
$IIS++ if defined($ENV{'SERVER_SOFTWARE'}) && $ENV{'SERVER_SOFTWARE'}=~/IIS/;
# Turn on special checking for Doug MacEachern's modperl
! if (exists $ENV{'GATEWAY_INTERFACE'}
! &&
! ($MOD_PERL = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl/))
{
$| = 1;
require Apache;
***************
*** 151,170 ****
tt u i b blockquote pre img a address cite samp dfn html head
base body Link nextid title meta kbd start_html end_html
input Select option comment/],
! ':html3'=>[qw/div table caption th td TR Tr sup sub strike applet Param
embed basefont style span layer ilayer font frameset frame script small big/],
':netscape'=>[qw/blink fontsize center/],
':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
submit reset defaults radio_group popup_menu button autoEscape
scrolling_list image_button start_form end_form startform endform
! start_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
! ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie dump
! raw_cookie request_method query_string accept user_agent remote_host
remote_addr referer server_name server_software server_port server_protocol
virtual_host remote_ident auth_type http use_named_parameters
save_parameters restore_parameters param_fetch
remote_user user_name header redirect import_names put Delete Delete_all url_param/],
':ssl' => [qw/https/],
':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
':html' => [qw/:html2 :html3 :netscape/],
':standard' => [qw/:html2 :html3 :form :cgi/],
--- 157,177 ----
tt u i b blockquote pre img a address cite samp dfn html head
base body Link nextid title meta kbd start_html end_html
input Select option comment/],
! ':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param
embed basefont style span layer ilayer font frameset frame script small big/],
':netscape'=>[qw/blink fontsize center/],
':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group
submit reset defaults radio_group popup_menu button autoEscape
scrolling_list image_button start_form end_form startform endform
! start_multipart_form end_multipart_form isindex tmpFileName uploadInfo URL_ENCODED MULTIPART/],
! ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie Dump
! raw_cookie request_method query_string Accept user_agent remote_host
remote_addr referer server_name server_software server_port server_protocol
virtual_host remote_ident auth_type http use_named_parameters
save_parameters restore_parameters param_fetch
remote_user user_name header redirect import_names put Delete Delete_all url_param/],
':ssl' => [qw/https/],
+ ':imagemap' => [qw/Area Map/],
':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
':html' => [qw/:html2 :html3 :netscape/],
':standard' => [qw/:html2 :html3 :form :cgi/],
***************
*** 206,211 ****
--- 213,219 ----
sub expand_tags {
my($tag) = @_;
+ return ("start_$1","end_$1") if $tag=~/^(?:\*|start_|end_)(.+)/;
my(@r);
return ($tag) unless $EXPORT_TAGS{$tag};
foreach (@{$EXPORT_TAGS{$tag}}) {
***************
*** 273,279 ****
$name = $p[0];
}
! return () unless defined($name) && $self->{$name};
return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
}
--- 281,287 ----
$name = $p[0];
}
! return unless defined($name) && $self->{$name};
return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
}
***************
*** 315,320 ****
--- 323,329 ----
sub init {
my($self,$initializer) = @_;
my($query_string,$meth,$content_length,$fh,@lines) = ('','','','');
+ local($/) = "\n";
# if we get called more than once, we want to initialize
# ourselves from the original query (which may be gone
***************
*** 341,347 ****
&& $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|
&& !defined($initializer)
) {
! my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";]+)\"?/;
$self->read_multipart($boundary,$content_length);
last METHOD;
}
--- 350,356 ----
&& $ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|
&& !defined($initializer)
) {
! my($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=\"?([^\";,]+)\"?/;
$self->read_multipart($boundary,$content_length);
last METHOD;
}
***************
*** 496,502 ****
sub parse_params {
my($self,$tosplit) = @_;
! my(@pairs) = split('&',$tosplit);
my($param,$value);
foreach (@pairs) {
($param,$value) = split('=',$_,2);
--- 505,511 ----
sub parse_params {
my($self,$tosplit) = @_;
! my(@pairs) = split(/[&;]/,$tosplit);
my($param,$value);
foreach (@pairs) {
($param,$value) = split('=',$_,2);
***************
*** 526,536 ****
}
sub _make_tag_func {
! my $tagname = shift;
! return qq{
sub $tagname {
- # handle various cases in which we're called
- # most of this bizarre stuff is to avoid -w errors
shift if \$_[0] &&
(!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
(ref(\$_[0]) &&
--- 535,543 ----
}
sub _make_tag_func {
! my ($self,$tagname) = @_;
! my $func = qq#
sub $tagname {
shift if \$_[0] &&
(!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
(ref(\$_[0]) &&
***************
*** 542,553 ****
my(\@attr) = make_attributes( '',shift() );
\$attr = " \@attr" if \@attr;
}
my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
return \$tag unless \@_;
my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
return "\@result";
! }
! }
}
sub AUTOLOAD {
--- 549,568 ----
my(\@attr) = make_attributes( '',shift() );
\$attr = " \@attr" if \@attr;
}
+ #;
+ if ($tagname=~/start_(\w+)/i) {
+ $func .= qq! return "<\U$1\E\$attr>";} !;
+ } elsif ($tagname=~/end_(\w+)/i) {
+ $func .= qq! return "<\U/$1\E>"; } !;
+ } else {
+ $func .= qq#
my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
return \$tag unless \@_;
my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
return "\@result";
! }#;
! }
! return $func;
}
sub AUTOLOAD {
***************
*** 619,630 ****
$code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
if (!$code) {
if ($EXPORT{':any'} ||
$EXPORT{'-any'} ||
! $EXPORT{$func_name} ||
(%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
! && $EXPORT_OK{$func_name}) {
! $code = _make_tag_func($func_name);
}
}
die "Undefined subroutine $AUTOLOAD\n" unless $code;
--- 634,646 ----
$code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
if (!$code) {
+ (my $base = $func_name) =~ s/^(start_|end_)//i;
if ($EXPORT{':any'} ||
$EXPORT{'-any'} ||
! $EXPORT{$base} ||
(%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
! && $EXPORT_OK{$base}) {
! $code = $CGI::DefaultClass->_make_tag_func($func_name);
}
}
die "Undefined subroutine $AUTOLOAD\n" unless $code;
***************
*** 644,657 ****
my $self = shift;
my $compile = 0;
foreach (@_) {
! $NPH++, next if /^[:-]nph$/;
! $NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/;
! $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/;
! $EXPORT{$_}++, next if /^[:-]any$/;
! $compile++, next if /^[:-]compile$/;
! # This is probably extremely evil code -- to be deleted
! # some day.
if (/^[-]autoload$/) {
my($pkg) = caller(1);
*{"${pkg}::AUTOLOAD"} = sub {
--- 660,674 ----
my $self = shift;
my $compile = 0;
foreach (@_) {
! $HEADERS_ONCE++, next if /^[:-]unique_headers$/;
! $NPH++, next if /^[:-]nph$/;
! $NO_DEBUG++, next if /^[:-]no_?[Dd]ebug$/;
! $USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/;
! $PRIVATE_TEMPFILES++, next if /^[:-]private_tempfiles$/;
! $EXPORT{$_}++, next if /^[:-]any$/;
! $compile++, next if /^[:-]compile$/;
! # This is probably extremely evil code -- to be deleted some day.
if (/^[-]autoload$/) {
my($pkg) = caller(1);
*{"${pkg}::AUTOLOAD"} = sub {
***************
*** 978,984 ****
unless (exists($self->{'.url_param'})) {
$self->{'.url_param'}={}; # empty hash
if ($ENV{QUERY_STRING} =~ /=/) {
! my(@pairs) = split('&',$ENV{QUERY_STRING});
my($param,$value);
foreach (@pairs) {
($param,$value) = split('=',$_,2);
--- 995,1001 ----
unless (exists($self->{'.url_param'})) {
$self->{'.url_param'}={}; # empty hash
if ($ENV{QUERY_STRING} =~ /=/) {
! my(@pairs) = split(/[&;]/,$ENV{QUERY_STRING});
my($param,$value);
foreach (@pairs) {
($param,$value) = split('=',$_,2);
***************
*** 1043,1048 ****
--- 1060,1066 ----
$filehandle = to_filehandle($filehandle);
my($param);
local($,) = ''; # set print field separator back to a sane value
+ local($\) = ''; # set output line separator to a sane value
foreach $param ($self->param) {
my($escaped_param) = escape($param);
my($value);
***************
*** 1141,1158 ****
my($self,@p) = self_or_default(@_);
my(@header);
my($type,$status,$cookie,$target,$expires,$nph,@other) =
! $self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
$nph ||= $NPH;
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
foreach (@other) {
! next unless my($header,$value) = /([^\s=]+)=\"?([^\"]+)\"?/;
($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e;
}
! $type = $type || 'text/html';
# Maybe future compatibility. Maybe not.
my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
--- 1159,1179 ----
my($self,@p) = self_or_default(@_);
my(@header);
+ return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE;
+
my($type,$status,$cookie,$target,$expires,$nph,@other) =
! $self->rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
! STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
$nph ||= $NPH;
# rearrange() was designed for the HTML portion, so we
# need to fix it up a little.
foreach (@other) {
! next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/;
($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ": $value"/e;
}
! $type ||= 'text/html' unless defined($type);
# Maybe future compatibility. Maybe not.
my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
***************
*** 1164,1170 ****
if ($cookie) {
my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
foreach (@cookie) {
! push(@header,"Set-Cookie: " . (UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_));
}
}
# if the user indicates an expiration time, then we need
--- 1185,1192 ----
if ($cookie) {
my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
foreach (@cookie) {
! my $cs = UNIVERSAL::isa($_,'CGI::Cookie') ? $_->as_string : $_;
! push(@header,"Set-Cookie: $cs") if $cs ne '';
}
}
# if the user indicates an expiration time, then we need
***************
*** 1175,1181 ****
push(@header,"Date: " . expires(0,'http')) if $expires || $cookie;
push(@header,"Pragma: no-cache") if $self->cache();
push(@header,@other);
! push(@header,"Content-Type: $type");
my $header = join($CRLF,@header)."${CRLF}${CRLF}";
if ($MOD_PERL and not $nph) {
--- 1197,1203 ----
push(@header,"Date: " . expires(0,'http')) if $expires || $cookie;
push(@header,"Pragma: no-cache") if $self->cache();
push(@header,@other);
! push(@header,"Content-Type: $type") if $type ne '';
my $header = join($CRLF,@header)."${CRLF}${CRLF}";
if ($MOD_PERL and not $nph) {
***************
*** 1221,1226 ****
--- 1243,1249 ----
'-nph'=>$nph);
unshift(@o,'-Target'=>$target) if $target;
unshift(@o,'-Cookie'=>$cookie) if $cookie;
+ unshift(@o,'-Type'=>'');
return $self->header(@o);
}
END_OF_FUNC
***************
*** 1407,1412 ****
--- 1430,1440 ----
}
END_OF_FUNC
+ 'end_multipart_form' => <<'END_OF_FUNC',
+ sub end_multipart_form {
+ &endform;
+ }
+ END_OF_FUNC
#### Method: start_multipart_form
# synonym for startform
***************
*** 1459,1466 ****
$name = defined($name) ? $self->escapeHTML($name) : '';
my($s) = defined($size) ? qq/ SIZE=$size/ : '';
my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
! my($other) = @other ? " @other" : '';
! return qq/<INPUT TYPE="$tag" NAME="$name" VALUE="$current"$s$m$other>/;
}
END_OF_FUNC
--- 1487,1497 ----
$name = defined($name) ? $self->escapeHTML($name) : '';
my($s) = defined($size) ? qq/ SIZE=$size/ : '';
my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
! my($other) = @other ? " @other" : '';
! # this entered at cristy's request to fix problems with file upload fields
! # and WebTV -- not sure it won't break stuff
! my($value) = $current ne '' ? qq(VALUE="$current") : '';
! return qq/<INPUT TYPE="$tag" NAME="$name" $value$s$m$other>/;
}
END_OF_FUNC
***************
*** 1787,1798 ****
sub unescapeHTML {
my $string = ref($_[0]) ? $_[1] : $_[0];
return undef unless defined($string);
! $string=~s/&/&/ig;
! $string=~s/"/\"/ig;
! $string=~s/>/>/ig;
! $string=~s/</</ig;
! $string=~s/&#(\d+);/chr($1)/eg;
! $string=~s/&#[xX]([0-9a-fA-F]);/chr(hex($1))/eg;
return $string;
}
END_OF_FUNC
--- 1818,1834 ----
sub unescapeHTML {
my $string = ref($_[0]) ? $_[1] : $_[0];
return undef unless defined($string);
! # thanks to Randal Schwartz for the correct solution to this one
! $string=~ s[&(.*?);]{
! local $_ = $1;
! /^amp$/i ? "&" :
! /^quot$/i ? '"' :
! /^gt$/i ? ">" :
! /^lt$/i ? "<" :
! /^#(\d+)$/ ? chr($1) :
! /^#x([0-9a-f]+)$/i ? chr(hex($1)) :
! $_
! }gex;
return $string;
}
END_OF_FUNC
***************
*** 1867,1880 ****
} else {
$checked = $default;
}
- # If no check array is specified, check the first by default
- $checked = $values->[0] unless defined($checked) && $checked ne '';
- $name=$self->escapeHTML($name);
-
my(@elements,@values);
-
@values = $self->_set_values_and_labels($values,\$labels,$name);
my($other) = @other ? " @other" : '';
foreach (@values) {
my($checkit) = $checked eq $_ ? ' CHECKED' : '';
--- 1903,1915 ----
} else {
$checked = $default;
}
my(@elements,@values);
@values = $self->_set_values_and_labels($values,\$labels,$name);
+ # If no check array is specified, check the first by default
+ $checked = $values[0] unless defined($checked) && $checked ne '';
+ $name=$self->escapeHTML($name);
+
my($other) = @other ? " @other" : '';
foreach (@values) {
my($checkit) = $checked eq $_ ? ' CHECKED' : '';
***************
*** 2321,2327 ****
push(@pairs,"$eparam=$value");
}
}
! return join("&",@pairs);
}
END_OF_FUNC
--- 2356,2362 ----
push(@pairs,"$eparam=$value");
}
}
! return join($USE_PARAM_SEMICOLONS ? ';' : '&',@pairs);
}
END_OF_FUNC
***************
*** 2337,2344 ****
# declares a quantitative score for it.
# This handles MIME type globs correctly.
####
! 'accept' => <<'END_OF_FUNC',
! sub accept {
my($self,$search) = self_or_CGI(@_);
my(%prefs,$type,$pref,$pat);
--- 2372,2379 ----
# declares a quantitative score for it.
# This handles MIME type globs correctly.
####
! 'Accept' => <<'END_OF_FUNC',
! sub Accept {
my($self,$search) = self_or_CGI(@_);
my(%prefs,$type,$pref,$pat);
***************
*** 2758,2763 ****
--- 2793,2799 ----
chmod 0600,$tmp; # only the owner can tamper with it
my ($data);
+ local($\) = '';
while (defined($data = $buffer->read)) {
print $filehandle $data;
}
***************
*** 2841,2850 ****
'asString' => <<'END_OF_FUNC',
sub asString {
my $self = shift;
! my $i = $$self;
! $i=~ s/^\*(\w+::)+//; # get rid of package name
$i =~ s/\\(.)/$1/g;
return $i;
}
END_OF_FUNC
--- 2877,2894 ----
'asString' => <<'END_OF_FUNC',
sub asString {
my $self = shift;
! # get rid of package name
! (my $i = $$self) =~ s/^\*(\w+::)+//;
$i =~ s/\\(.)/$1/g;
return $i;
+ # BEGIN DEAD CODE
+ # This was an extremely clever patch that allowed "use strict refs".
+ # Unfortunately it relied on another bug that caused leaky file descriptors.
+ # The underlying bug has been fixed, so this no longer works. However
+ # "strict refs" still works for some reason.
+ # my $self = shift;
+ # return ${*{$self}{SCALAR}};
+ # END DEAD CODE
}
END_OF_FUNC
***************
*** 2861,2871 ****
my($pack,$name,$file,$delete) = @_;
require Fcntl unless defined &Fcntl::O_RDWR;
++$FH;
! *{$FH} = quotemeta($name);
! sysopen($FH,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL())
|| die "CGI open of $file: $!\n";
unlink($file) if $delete;
! return bless \*{$FH},$pack;
}
END_OF_FUNC
--- 2905,2916 ----
my($pack,$name,$file,$delete) = @_;
require Fcntl unless defined &Fcntl::O_RDWR;
++$FH;
! my $ref = \*{'Fh::' . quotemeta($name)};
! sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL())
|| die "CGI open of $file: $!\n";
unlink($file) if $delete;
! delete $Fh::{$FH};
! return bless $ref,$pack;
}
END_OF_FUNC
***************
*** 2883,2892 ****
package MultipartBuffer;
# how many bytes to read at a time. We use
! # a 5K buffer by default.
! $INITIAL_FILLUNIT = 1024 * 5;
! $TIMEOUT = 10*60; # 10 minute timeout
! $SPIN_LOOP_MAX = 1000; # bug fix for some Netscape servers
$CRLF=$CGI::CRLF;
#reuse the autoload function
--- 2928,2937 ----
package MultipartBuffer;
# how many bytes to read at a time. We use
! # a 4K buffer by default.
! $INITIAL_FILLUNIT = 1024 * 4;
! $TIMEOUT = 240*60; # 4 hour timeout for big files
! $SPIN_LOOP_MAX = 2000; # bug fix for some Netscape servers
$CRLF=$CGI::CRLF;
#reuse the autoload function
***************
*** 2930,2937 ****
# characters "--" PLUS the Boundary string
# BUG: IE 3.01 on the Macintosh uses just the boundary -- not
! # the two extra spaces. We do a special case here on the user-agent!!!!
! $boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12]; Mac');
} else { # otherwise we find it ourselves
my($old);
--- 2975,2982 ----
# characters "--" PLUS the Boundary string
# BUG: IE 3.01 on the Macintosh uses just the boundary -- not
! # the two extra hyphens. We do a special case here on the user-agent!!!!
! $boundary = "--$boundary" unless CGI::user_agent('MSIE 3\.0[12]; ?Mac');
} else { # otherwise we find it ourselves
my($old);
***************
*** 3088,3093 ****
--- 3133,3139 ----
\$self->{BUFFER},
$bytesToRead,
$bufferLength);
+ $self->{BUFFER} = '' unless defined $self->{BUFFER};
# An apparent bug in the Apache server causes the read()
# to return zero bytes repeatedly without blocking if the
***************
*** 3129,3135 ****
my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
unless ($TMPDIRECTORY) {
@TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
! "${SL}tmp","${SL}temp","${vol}${SL}Temporary Items",
"${SL}WWW_ROOT");
foreach (@TEMP) {
do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
--- 3175,3181 ----
my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
unless ($TMPDIRECTORY) {
@TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
! "C:${SL}temp","${SL}tmp","${SL}temp","${vol}${SL}Temporary Items",
"${SL}WWW_ROOT");
foreach (@TEMP) {
do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
***************
*** 3273,3282 ****
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
a simple "Hello World" HTML page:
! #!/usr/local/bin/pelr
use CGI; # load CGI routines
$q = new CGI; # create new CGI object
print $q->header, # create the HTTP header
--- 3319,3328 ----
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 how you create
a simple "Hello World" HTML page:
! #!/usr/local/bin/perl
use CGI; # load CGI routines
$q = new CGI; # create new CGI object
print $q->header, # create the HTTP header
***************
*** 3294,3300 ****
into our name space (usually the "standard" functions), and we don't
need to create the CGI object.
! #!/usr/local/bin/pelr
use CGI qw/:standard/; # load standard CGI routines
print header, # create the HTTP header
start_html('hello world'), # start the HTML
--- 3340,3346 ----
into our name space (usually the "standard" functions), and we don't
need to create the CGI object.
! #!/usr/local/bin/perl
use CGI qw/:standard/; # load standard CGI routines
print header, # create the HTTP header
start_html('hello world'), # start the HTML
***************
*** 3319,3325 ****
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
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:
--- 3365,3371 ----
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 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,3673 ****
$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 ":"
character as in ":html3" (for tags defined in the HTML 3 standard).
Here is a list of the function sets you can import:
--- 3713,3719 ----
$zipcode = param('zipcode');
More frequently, you'll import common sets of functions by referring
! 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,3725 ****
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:
use CGI qw/:standard :html3 gradient/;
print gradient({-start=>'red',-end=>'blue'});
--- 3765,3771 ----
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 immediately:
use CGI qw/:standard :html3 gradient/;
print gradient({-start=>'red',-end=>'blue'});
***************
*** 3799,3805 ****
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.
use CGI qw(-compile :standard :html3);
--- 3845,3851 ----
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 families you plan to use.
use CGI qw(-compile :standard :html3);
***************
*** 3819,3824 ****
--- 3865,3881 ----
to tell the server that the script is NPH. See the discussion
of NPH scripts below.
+ =item -newstyle_urls
+
+ Separate the name=value pairs in CGI parameter query strings with
+ semicolons rather than ampersands. For example:
+
+ ?name=fred;age=24;favorite_color=3
+
+ Semicolon-delimited query strings are always accepted, but will not be
+ emitted by self_url() and query_string() unless the -newstyle_urls
+ pragma is specified.
+
=item -autoload
This overrides the autoloader so that any function in your program
***************
*** 3859,3865 ****
the -private_tempfiles pragma will cause the temporary file to be unlinked as soon
as it is opened and before any data is written into it,
eliminating the risk of eavesdropping.
! n
=back
=head1 GENERATING DYNAMIC DOCUMENTS
--- 3916,3966 ----
the -private_tempfiles pragma will cause the temporary file to be unlinked as soon
as it is opened and before any data is written into it,
eliminating the risk of eavesdropping.
!
! =back
!
! =head2 SPECIAL FORMS FOR IMPORTING HTML-TAG FUNCTIONS
!
! Many of the methods generate HTML tags. As described below, tag
! functions automatically generate both the opening and closing tags.
! For example:
!
! print h1('Level 1 Header');
!
! produces
!
! <H1>Level 1 Header</H1>
!
! There will be some times when you want to produce the start and end
! tags yourself. In this case, you can use the form start_I<tag_name>
! and end_I<tag_name>, as in:
!
! print start_h1,'Level 1 Header',end_h1;
!
! With a few exceptions (described below), start_I<tag_name> and
! end_I<tag_name> functions are not generated automatically when you
! I<use CGI>. However, you can specify the tags you want to generate
! I<start/end> functions for by putting an asterisk in front of their
! name, or, alternatively, requesting either "start_I<tag_name>" or
! "end_I<tag_name>" in the import list.
!
! Example:
!
! use CGI qw/:standard *table start_ul/;
!
! In this example, the following functions are generated in addition to
! the standard ones:
!
! =over 4
!
! =item 1. start_table() (generates a <TABLE> tag)
!
! =item 2. end_table() (generates a </TABLE> tag)
!
! =item 3. start_ul() (generates a <UL> tag)
!
! =item 4. end_ul() (generates a </UL> tag)
!
=back
=head1 GENERATING DYNAMIC DOCUMENTS
***************
*** 4247,4252 ****
--- 4348,4372 ----
=back
+ =head2 MIXING POST AND URL PARAMETERS
+
+ $color = $query->url_param('color');
+
+ It is possible for a script to receive CGI parameters in the URL as
+ well as in the fill-out form by creating a form that POSTs to a URL
+ containing a query string (a "?" mark followed by arguments). The
+ B<param()> method will always return the contents of the POSTed
+ fill-out form, ignoring the URL's query string. To retrieve URL
+ parameters, call the B<url_param()> method. Use it in the same way as
+ B<param()>. The main difference is that it allows you to read the
+ parameters, but not set them.
+
+
+ Under no circumstances will the contents of the URL query string
+ interfere with similarly-named CGI parameters in POSTed forms. If you
+ try to mix a URL query string with a form submitted with the GET
+ method, the results will not be what you expect.
+
=head1 CREATING STANDARD HTML ELEMENTS:
CGI.pm defines general HTML shortcut methods for most, if not all of
***************
*** 4325,4331 ****
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
<IMG ALT="">. The difference is shown in these two pieces of code:
CODE RESULT
--- 4445,4451 ----
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 accommodate those who want to create tags of the form
<IMG ALT="">. The difference is shown in these two pieces of code:
CODE RESULT
***************
*** 4410,4420 ****
--- 4530,4550 ----
Tr
Link
Delete
+ Accept
+ Sub
In addition, start_html(), end_html(), start_form(), end_form(),
start_multipart_form() and all the fill-out form tags are special.
See their respective sections.
+ =head2 PRETTY-PRINTING HTML
+
+ By default, all the HTML produced by these functions comes out as one
+ long line without carriage returns or indentation. This is yuck, but
+ it does reduce the size of the documents by 10-20%. To get
+ pretty-printed output, please use L<CGI::Pretty>, a subclass
+ contributed by Brian Paulsen.
+
=head1 CREATING FILL-OUT FORMS:
I<General note> The various form-creating methods all return strings
***************
*** 4469,4475 ****
print $query->startform(-method=>$method,
-action=>$action,
! -encoding=>$encoding);
<... various form stuff ...>
print $query->endform;
--- 4599,4605 ----
print $query->startform(-method=>$method,
-action=>$action,
! -enctype=>$encoding);
<... various form stuff ...>
print $query->endform;
***************
*** 4484,4494 ****
method: POST
action: this script
! encoding: application/x-www-form-urlencoded
endform() returns the closing </FORM> tag.
! Startform()'s encoding method tells the browser how to package the various
fields of the form before sending the form to the server. Two
values are possible:
--- 4614,4624 ----
method: POST
action: this script
! enctype: application/x-www-form-urlencoded
endform() returns the closing </FORM> tag.
! Startform()'s enctype argument tells the browser how to package the various
fields of the form before sending the form to the server. Two
values are possible:
***************
*** 4671,4682 ****
The optional second parameter is the starting value for the field contents
to be used as the default file name (-default).
! The beta2 version of Netscape 2.0 currently doesn't pay any attention
! to this field, and so the starting value will always be blank. Worse,
! the field loses its "sticky" behavior and forgets its previous
! contents. The starting value field is called for in the HTML
! specification, however, and possibly later versions of Netscape will
! honor it.
=item 3.
--- 4801,4811 ----
The optional second parameter is the starting value for the field contents
to be used as the default file name (-default).
! For security reasons, browsers don't pay any attention to this field,
! and so the starting value will always be blank. Worse, the field
! loses its "sticky" behavior and forgets its previous contents. The
! starting value field is called for in the HTML specification, however,
! and possibly some browser will eventually provide support for it.
=item 3.
***************
*** 5093,5099 ****
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
unit.
=back
--- 5222,5228 ----
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
! interpretation of the radio buttons -- they're still a single named
unit.
=back
***************
*** 5157,5162 ****
--- 5286,5294 ----
form to its value from the last time the script was called,
NOT necessarily to the defaults.
+ Note that this conflicts with the Perl reset() built-in. Use
+ CORE::reset() to get the original reset function.
+
=head2 CREATING A DEFAULT BUTTON
print $query->defaults('button_label')
***************
*** 5263,5273 ****
non-Netscape browsers this form element will probably not even
display.
! =head1 NETSCAPE COOKIES
! Netscape browsers versions 1.1 and higher support a so-called
! "cookie" designed to help maintain state within a browser session.
! CGI.pm has several methods that support cookies.
A cookie is a name=value pair much like the named parameters in a CGI
query string. CGI scripts create one or more cookies and send
--- 5395,5406 ----
non-Netscape browsers this form element will probably not even
display.
! =head1 HTTP COOKIES
! Netscape browsers versions 1.1 and higher, and all versions of
! Internet Explorer, support a so-called "cookie" designed to help
! maintain state within a browser session. CGI.pm has several methods
! that support cookies.
A cookie is a name=value pair much like the named parameters in a CGI
query string. CGI scripts create one or more cookies and send
***************
*** 5285,5299 ****
This is a time/date string (in a special GMT format) that indicates
when a cookie expires. The cookie will be saved and returned to your
script until this expiration date is reached if the user exits
! Netscape and restarts it. If an expiration date isn't specified, the cookie
! will remain active until the user quits Netscape.
=item 2. a domain
This is a partial or complete domain name for which the cookie is
valid. The browser will return the cookie to any host that matches
the partial domain name. For example, if you specify a domain name
! of ".capricorn.com", then Netscape will return the cookie to
Web servers running on any of the machines "www.capricorn.com",
"www2.capricorn.com", "feckless.capricorn.com", etc. Domain names
must contain at least two periods to prevent attempts to match
--- 5418,5432 ----
This is a time/date string (in a special GMT format) that indicates
when a cookie expires. The cookie will be saved and returned to your
script until this expiration date is reached if the user exits
! the browser and restarts it. If an expiration date isn't specified, the cookie
! will remain active until the user quits the browser.
=item 2. a domain
This is a partial or complete domain name for which the cookie is
valid. The browser will return the cookie to any host that matches
the partial domain name. For example, if you specify a domain name
! of ".capricorn.com", then the browser will return the cookie to
Web servers running on any of the machines "www.capricorn.com",
"www2.capricorn.com", "feckless.capricorn.com", etc. Domain names
must contain at least two periods to prevent attempts to match
***************
*** 5318,5324 ****
=back
! The interface to Netscape cookies is the B<cookie()> method:
$cookie = $query->cookie(-name=>'sessionID',
-value=>'xyzzy',
--- 5451,5457 ----
=back
! The interface to HTTP cookies is the B<cookie()> method:
$cookie = $query->cookie(-name=>'sessionID',
-value=>'xyzzy',
***************
*** 5335,5341 ****
=item B<-name>
The name of the cookie (required). This can be any string at all.
! Although Netscape limits its cookie names to non-whitespace
alphanumeric characters, CGI.pm removes this restriction by escaping
and unescaping cookies behind the scenes.
--- 5468,5474 ----
=item B<-name>
The name of the cookie (required). This can be any string at all.
! Although browsers limit their cookie names to non-whitespace
alphanumeric characters, CGI.pm removes this restriction by escaping
and unescaping cookies behind the scenes.
***************
*** 5406,5424 ****
See the B<cookie.cgi> example script for some ideas on how to use
cookies effectively.
! B<NOTE:> There appear to be some (undocumented) restrictions on
! Netscape cookies. In Netscape 2.01, at least, I haven't been able to
! set more than three cookies at a time. There may also be limits on
! the length of cookies. If you need to store a lot of information,
! it's probably better to create a unique session ID, store it in a
! cookie, and use the session ID to locate an external file/database
! saved on the server's side of the connection.
!
! =head1 WORKING WITH NETSCAPE FRAMES
!
! It's possible for CGI.pm scripts to write into several browser
! panels and windows using Netscape's frame mechanism.
! There are three techniques for defining new frames programmatically:
=over 4
--- 5539,5549 ----
See the B<cookie.cgi> example script for some ideas on how to use
cookies effectively.
! =head1 WORKING WITH FRAMES
!
! It's possible for CGI.pm scripts to write into several browser panels
! and windows using the HTML 4 frame mechanism. There are three
! techniques for defining new frames programmatically:
=over 4
***************
*** 5441,5452 ****
print $q->header(-target=>'ResultsWindow');
! This will tell Netscape to load the output of your script into the
! frame named "ResultsWindow". If a frame of that name doesn't
! already exist, Netscape will pop up a new window and load your
! script's document into that. There are a number of magic names
! that you can use for targets. See the frame documents on Netscape's
! home pages for details.
=item 3. Specify the destination for the document in the <FORM> tag
--- 5566,5577 ----
print $q->header(-target=>'ResultsWindow');
! This will tell the browser to load the output of your script into the
! frame named "ResultsWindow". If a frame of that name doesn't already
! exist, the browser will pop up a new window and load your script's
! document into that. There are a number of magic names that you can
! use for targets. See the frame documents on Netscape's home pages for
! details.
=item 3. Specify the destination for the document in the <FORM> tag
***************
*** 5591,5603 ****
</UL>
</UL>
! You can pass a value of 'true' to dump() in order to get it to
! print the results out as plain text, suitable for incorporating
! into a <PRE> section.
!
! As a shortcut, as of version 1.56 you can interpolate the entire CGI
! object into a string and it will be replaced with the a nice HTML dump
! shown above:
$query=new CGI;
print "<H2>Current Values</H2> $query\n";
--- 5716,5723 ----
</UL>
</UL>
! As a shortcut, you can interpolate the entire CGI object into a string
! and it will be replaced with the a nice HTML dump shown above:
$query=new CGI;
print "<H2>Current Values</H2> $query\n";
***************
*** 5609,5632 ****
=over 4
! =item B<accept()>
! Return a list of MIME types that the remote browser
! accepts. If you give this method a single argument
! corresponding to a MIME type, as in
! $query->accept('text/html'), it will return a
! floating point value corresponding to the browser's
! preference for this type from 0.0 (don't want) to 1.0.
! Glob types (e.g. text/*) in the browser's accept list
! are handled correctly.
=item B<raw_cookie()>
Returns the HTTP_COOKIE variable, an HTTP extension implemented by
! Netscape browsers version 1.1 and higher. Cookies have a special
! format, and this method call just returns the raw form (?cookie
! dough). See cookie() for ways of setting and retrieving cooked
! cookies.
Called with no parameters, raw_cookie() returns the packed cookie
structure. You can separate it into individual cookies by splitting
--- 5729,5753 ----
=over 4
! =item B<Accept()>
!
! Return a list of MIME types that the remote browser accepts. If you
! give this method a single argument corresponding to a MIME type, as in
! $query->Accept('text/html'), it will return a floating point value
! corresponding to the browser's preference for this type from 0.0
! (don't want) to 1.0. Glob types (e.g. text/*) in the browser's accept
! list are handled correctly.
! Note that the capitalization changed between version 2.43 and 2.44 in
! order to avoid conflict with Perl's accept() function.
=item B<raw_cookie()>
Returns the HTTP_COOKIE variable, an HTTP extension implemented by
! Netscape browsers version 1.1 and higher, and all versions of Internet
! Explorer. Cookies have a special format, and this method call just
! returns the raw form (?cookie dough). See cookie() for ways of
! setting and retrieving cooked cookies.
Called with no parameters, raw_cookie() returns the packed cookie
structure. You can separate it into individual cookies by splitting
***************
*** 5708,5717 ****
=item B<user_name ()>
! Attempt to obtain the remote user's name, using a variety
! of different techniques. This only works with older browsers
! such as Mosaic. Netscape does not reliably report the user
! name!
=item B<request_method()>
--- 5829,5837 ----
=item B<user_name ()>
! Attempt to obtain the remote user's name, using a variety of different
! techniques. This only works with older browsers such as Mosaic.
! Newer browsers do not report the user name for privacy reasons!
=item B<request_method()>
***************
*** 5935,5948 ****
=head1 AUTHOR INFORMATION
! Copyright 1995-1997, Lincoln D. Stein. All rights reserved. It may
! be used and modified freely, but I do request that this copyright
! notice remain attached to the file. You may modify this module as you
! wish, but if you redistribute a modified version, please attach a note
! listing the modifications you have made.
! Address bug reports and comments to:
! lstein@genome.wi.mit.edu
=head1 CREDITS
--- 6055,6071 ----
=head1 AUTHOR INFORMATION
! Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
!
! This library is free software; you can redistribute it and/or modify
! it under the same terms as Perl itself.
! Address bug reports and comments to: lstein@cshl.org. When sending
! bug reports, please provide the version of CGI.pm, the version of
! Perl, the name and version of your Web server, and the name and
! version of the operating system you are using. If the problem is even
! remotely browser dependent, please provide information about the
! affected browers as well.
=head1 CREDITS
***************
*** 5962,5968 ****
=item Joergen Haegg (jh@axis.se)
! =item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu)
=item Richard Resnick (applepi1@aol.com)
--- 6085,6091 ----
=item Joergen Haegg (jh@axis.se)
! =item Laurent Delfosse (delfosse@delfosse.com)
=item Richard Resnick (applepi1@aol.com)
***************
*** 6054,6060 ****
-rows=>10,
-columns=>50);
! print "<P>",$query->reset;
print $query->submit('Action','Shout');
print $query->submit('Action','Scream');
print $query->endform;
--- 6177,6183 ----
-rows=>10,
-columns=>50);
! print "<P>",$query->Reset;
print $query->submit('Action','Shout');
print $query->submit('Action','Scream');
print $query->endform;
***************
*** 6095,6102 ****
=head1 SEE ALSO
L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
! L<CGI::Base>, L<CGI::Form>, L<CGI::Apache>, L<CGI::Switch>,
! L<CGI::Push>, L<CGI::Fast>
=cut
--- 6218,6225 ----
=head1 SEE ALSO
L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
! L<CGI::Base>, L<CGI::Form>, L<CGI::Push>, L<CGI::Fast>,
! L<CGI::Pretty>
=cut
diff -c 'perl5.005_02/lib/CGI/Apache.pm' 'perl5.005_03/lib/CGI/Apache.pm'
Index: ./lib/CGI/Apache.pm
*** ./lib/CGI/Apache.pm Thu Jul 23 23:00:29 1998
--- ./lib/CGI/Apache.pm Wed Jan 6 22:41:53 1999
***************
*** 78,84 ****
=head1 DESCRIPTION
When using the Perl-Apache API, your applications are faster, but the
! enviroment is different than CGI.
This module attempts to set-up that environment as best it can.
=head1 NOTE 1
--- 78,84 ----
=head1 DESCRIPTION
When using the Perl-Apache API, your applications are faster, but the
! environment is different than CGI.
This module attempts to set-up that environment as best it can.
=head1 NOTE 1
diff -c 'perl5.005_02/lib/CGI/Carp.pm' 'perl5.005_03/lib/CGI/Carp.pm'
Index: ./lib/CGI/Carp.pm
*** ./lib/CGI/Carp.pm Thu Jul 23 23:00:29 1998
--- ./lib/CGI/Carp.pm Sat Jan 23 17:44:44 1999
***************
*** 14,19 ****
--- 14,25 ----
warn "I'm confused";
die "I'm dying.\n";
+ use CGI::Carp qw(cluck);
+ cluck "I wouldn't do that if I were you";
+
+ use CGI::Carp qw(fatalsToBrowser);
+ die "Fatal error messages are now sent to browser";
+
=head1 DESCRIPTION
CGI scripts have a nasty habit of leaving warning messages in the error
***************
*** 155,165 ****
1.10 Patch from Chris Dean (ctdean@cogit.com) to allow
module to run correctly under mod_perl.
=head1 AUTHORS
! Lincoln D. Stein <lstein@genome.wi.mit.edu>. Feel free to redistribute
! this under the Perl Artistic License.
=head1 SEE ALSO
--- 161,181 ----
1.10 Patch from Chris Dean (ctdean@cogit.com) to allow
module to run correctly under mod_perl.
+ 1.11 Changed order of > and < escapes.
+
+ 1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
+
+ 1.13 Added cluck() to make the module orthogonal with Carp.
+ More mod_perl related fixes.
+
=head1 AUTHORS
! Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
!
! This library is free software; you can redistribute it and/or modify
! it under the same terms as Perl itself.
+ Address bug reports and comments to: lstein@cshl.org
=head1 SEE ALSO
***************
*** 174,184 ****
@ISA = qw(Exporter);
@EXPORT = qw(confess croak carp);
! @EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message);
$main::SIG{__WARN__}=\&CGI::Carp::warn;
$main::SIG{__DIE__}=\&CGI::Carp::die;
! $CGI::Carp::VERSION = '1.101';
$CGI::Carp::CUSTOM_MSG = undef;
# fancy import routine detects and handles 'errorWrap' specially.
--- 190,200 ----
@ISA = qw(Exporter);
@EXPORT = qw(confess croak carp);
! @EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message cluck);
$main::SIG{__WARN__}=\&CGI::Carp::warn;
$main::SIG{__DIE__}=\&CGI::Carp::die;
! $CGI::Carp::VERSION = '1.13';
$CGI::Carp::CUSTOM_MSG = undef;
# fancy import routine detects and handles 'errorWrap' specially.
***************
*** 194,200 ****
}
# These are the originals
- # XXX Why not just use CORE::die etc., instead of these two? GSAR
sub realwarn { CORE::warn(@_); }
sub realdie { CORE::die(@_); }
--- 210,215 ----
***************
*** 230,237 ****
# eval. These evals don't count when looking at the stack backtrace.
sub _longmess {
my $message = Carp::longmess();
! my $mod_perl = ($ENV{'GATEWAY_INTERFACE'}
! && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//);
$message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
return( $message );
}
--- 245,251 ----
# eval. These evals don't count when looking at the stack backtrace.
sub _longmess {
my $message = Carp::longmess();
! my $mod_perl = exists $ENV{MOD_PERL};
$message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
return( $message );
}
***************
*** 240,246 ****
my $message = shift;
my $time = scalar(localtime);
my($file,$line,$id) = id(1);
! $message .= " at $file line $line.\n" unless $message=~/\n$/;
&fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m;
my $stamp = stamp;
$message=~s/^/$stamp/gm;
--- 254,260 ----
my $message = shift;
my $time = scalar(localtime);
my($file,$line,$id) = id(1);
! $message .= " at $file line $line." unless $message=~/\n$/;
&fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m;
my $stamp = stamp;
$message=~s/^/$stamp/gm;
***************
*** 258,265 ****
local $^W=0;
eval <<EOF;
sub confess { CGI::Carp::die Carp::longmess \@_; }
! sub croak { CGI::Carp::die Carp::shortmess \@_; }
! sub carp { CGI::Carp::warn Carp::shortmess \@_; }
EOF
;
}
--- 272,280 ----
local $^W=0;
eval <<EOF;
sub confess { CGI::Carp::die Carp::longmess \@_; }
! sub croak { CGI::Carp::die Carp::shortmess \@_; }
! sub carp { CGI::Carp::warn Carp::shortmess \@_; }
! sub cluck { CGI::Carp::warn Carp::longmess \@_; }
EOF
;
}
***************
*** 269,275 ****
sub carpout {
my($in) = @_;
my($no) = fileno(to_filehandle($in));
! realdie "Invalid filehandle $in\n" unless defined $no;
open(SAVEERR, ">&STDERR");
open(STDERR, ">&$no") or
--- 284,290 ----
sub carpout {
my($in) = @_;
my($no) = fileno(to_filehandle($in));
! realdie("Invalid filehandle $in\n") unless defined $no;
open(SAVEERR, ">&STDERR");
open(STDERR, ">&$no") or
***************
*** 279,287 ****
# headers
sub fatalsToBrowser {
my($msg) = @_;
$msg=~s/>/>/g;
$msg=~s/</</g;
- $msg=~s/&/&/g;
$msg=~s/\"/"/g;
my($wm) = $ENV{SERVER_ADMIN} ?
qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
--- 294,302 ----
# headers
sub fatalsToBrowser {
my($msg) = @_;
+ $msg=~s/&/&/g;
$msg=~s/>/>/g;
$msg=~s/</</g;
$msg=~s/\"/"/g;
my($wm) = $ENV{SERVER_ADMIN} ?
qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
***************
*** 291,297 ****
and the time and date of the error.
END
;
! print STDOUT "Content-type: text/html\n\n";
if ($CUSTOM_MSG) {
if (ref($CUSTOM_MSG) eq 'CODE') {
--- 306,314 ----
and the time and date of the error.
END
;
! my $mod_perl = exists $ENV{MOD_PERL};
! print STDOUT "Content-type: text/html\n\n"
! unless $mod_perl;
if ($CUSTOM_MSG) {
if (ref($CUSTOM_MSG) eq 'CODE') {
***************
*** 302,314 ****
}
}
! print STDOUT <<END;
<H1>Software error:</H1>
<CODE>$msg</CODE>
<P>
! $outer_message;
END
;
}
# Cut and paste from CGI.pm so that we don't have the overhead of
--- 319,348 ----
}
}
! my $mess = <<END;
<H1>Software error:</H1>
<CODE>$msg</CODE>
<P>
! $outer_message
END
;
+
+ if ($mod_perl) {
+ my $r = Apache->request;
+ # If bytes have already been sent, then
+ # we print the message out directly.
+ # Otherwise we make a custom error
+ # handler to produce the doc for us.
+ if ($r->bytes_sent) {
+ $r->print($mess);
+ $r->exit;
+ } else {
+ $r->status(500);
+ $r->custom_response(500,$mess);
+ }
+ } else {
+ print STDOUT $mess;
+ }
}
# Cut and paste from CGI.pm so that we don't have the overhead of
diff -c 'perl5.005_02/lib/CGI/Cookie.pm' 'perl5.005_03/lib/CGI/Cookie.pm'
Index: ./lib/CGI/Cookie.pm
*** ./lib/CGI/Cookie.pm Thu Jul 23 23:00:29 1998
--- ./lib/CGI/Cookie.pm Sat Jan 23 17:44:44 1999
***************
*** 69,75 ****
my($key,$value) = split("=");
my(@values) = map CGI::unescape($_),split('&',$value);
$key = CGI::unescape($key);
! $results{$key} = $self->new(-name=>$key,-value=>\@values);
}
return \%results unless wantarray;
return %results;
--- 69,77 ----
my($key,$value) = split("=");
my(@values) = map CGI::unescape($_),split('&',$value);
$key = CGI::unescape($key);
! # A bug in Netscape can cause several cookies with same name to
! # appear. The FIRST one in HTTP_COOKIE is the most recent version.
! $results{$key} ||= $self->new(-name=>$key,-value=>\@values);
}
return \%results unless wantarray;
return %results;
***************
*** 399,411 ****
=head1 AUTHOR INFORMATION
! be used and modified freely, but I do request that this copyright
! notice remain attached to the file. You may modify this module as you
! wish, but if you redistribute a modified version, please attach a note
! listing the modifications you have made.
! Address bug reports and comments to:
! lstein@genome.wi.mit.edu
=head1 BUGS
--- 401,412 ----
=head1 AUTHOR INFORMATION
! Copyright 1997-1998, Lincoln D. Stein. All rights reserved.
! This library is free software; you can redistribute it and/or modify
! it under the same terms as Perl itself.
!
! Address bug reports and comments to: lstein@cshl.org
=head1 BUGS
diff -c 'perl5.005_02/lib/CGI/Fast.pm' 'perl5.005_03/lib/CGI/Fast.pm'
Index: ./lib/CGI/Fast.pm
*** ./lib/CGI/Fast.pm Thu Jul 23 23:00:30 1998
--- ./lib/CGI/Fast.pm Sat Jan 23 17:44:44 1999
***************
*** 16,22 ****
# The most recent version and complete docs are available at:
# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
! $CGI::Fast::VERSION='1.00a';
use CGI;
use FCGI;
--- 16,22 ----
# The most recent version and complete docs are available at:
# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
! $CGI::Fast::VERSION='1.01';
use CGI;
use FCGI;
***************
*** 34,42 ****
# New is slightly different in that it calls FCGI's
# accept() method.
sub new {
! return undef unless FCGI::accept() >= 0;
! my($self,@param) = @_;
! return $CGI::Q = $self->SUPER::new(@param);
}
1;
--- 34,44 ----
# New is slightly different in that it calls FCGI's
# accept() method.
sub new {
! my ($self, $initializer, @param) = @_;
! unless (defined $initializer) {
! return undef unless FCGI::accept() >= 0;
! }
! return $CGI::Q = $self->SUPER::new($initializer, @param);
}
1;
***************
*** 154,166 ****
=head1 AUTHOR INFORMATION
! be used and modified freely, but I do request that this copyright
! notice remain attached to the file. You may modify this module as you
! wish, but if you redistribute a modified version, please attach a note
! listing the modifications you have made.
! Address bug reports and comments to:
! lstein@genome.wi.mit.edu
=head1 BUGS
--- 156,167 ----
=head1 AUTHOR INFORMATION
! Copyright 1996-1998, Lincoln D. Stein. All rights reserved.
! This library is free software; you can redistribute it and/or modify
! it under the same terms as Perl itself.
!
! Address bug reports and comments to: lstein@cshl.org
=head1 BUGS
diff -c 'perl5.005_02/lib/CGI/Push.pm' 'perl5.005_03/lib/CGI/Push.pm'
Index: ./lib/CGI/Push.pm
*** ./lib/CGI/Push.pm Thu Jul 23 23:00:30 1998
--- ./lib/CGI/Push.pm Sat Jan 23 17:44:44 1999
***************
*** 14,21 ****
# listing the modifications you have made.
# The most recent version and complete docs are available at:
! # http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
! # ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
$CGI::Push::VERSION='1.01';
use CGI;
--- 14,20 ----
# listing the modifications you have made.
# The most recent version and complete docs are available at:
! # http://stein.cshl.org/WWW/software/CGI/
$CGI::Push::VERSION='1.01';
use CGI;
***************
*** 287,305 ****
Microsoft IIS. Users of other servers should see their documentation
for help.
- =head1 CAVEATS
-
- This is a new module. It hasn't been extensively tested.
-
=head1 AUTHOR INFORMATION
! be used and modified freely, but I do request that this copyright
! notice remain attached to the file. You may modify this module as you
! wish, but if you redistribute a modified version, please attach a note
! listing the modifications you have made.
! Address bug reports and comments to:
! lstein@genome.wi.mit.edu
=head1 BUGS
--- 286,299 ----
Microsoft IIS. Users of other servers should see their documentation
for help.
=head1 AUTHOR INFORMATION
! Copyright 1995-1998, Lincoln D. Stein. All rights reserved.
!
! This library is free software; you can redistribute it and/or modify
! it under the same terms as Perl itself.
! Address bug reports and comments to: lstein@cshl.org
=head1 BUGS
diff -c 'perl5.005_02/lib/CPAN.pm' 'perl5.005_03/lib/CPAN.pm'
Index: ./lib/CPAN.pm
Prereq: 1.226
*** ./lib/CPAN.pm Thu Jul 23 23:00:32 1998
--- ./lib/CPAN.pm Sun Mar 28 14:26:32 1999
***************
*** 1,24 ****
package CPAN;
! use vars qw{$Try_autoload $Revision
$META $Signal $Cwd $End
$Suppress_readline %Dontload
$Frontend $Defaultsite
! };
! $VERSION = '1.3901';
! # $Id: CPAN.pm,v 1.226 1998/07/08 22:29:29 k Exp k $
# only used during development:
$Revision = "";
! # $Revision = "[".substr(q$Revision: 1.226 $, 10)."]";
use Carp ();
use Config ();
use Cwd ();
use DirHandle;
use Exporter ();
! use ExtUtils::MakeMaker ();
use File::Basename ();
use File::Copy ();
use File::Find;
--- 1,25 ----
package CPAN;
! use vars qw{$Try_autoload
! $Revision
$META $Signal $Cwd $End
$Suppress_readline %Dontload
$Frontend $Defaultsite
! }; #};
! $VERSION = '1.48';
! # $Id: CPAN.pm,v 1.260 1999/03/06 19:31:02 k Exp $
# only used during development:
$Revision = "";
! # $Revision = "[".substr(q$Revision: 1.260 $, 10)."]";
use Carp ();
use Config ();
use Cwd ();
use DirHandle;
use Exporter ();
! use ExtUtils::MakeMaker (); # $SelfLoader::DEBUG=1;
use File::Basename ();
use File::Copy ();
use File::Find;
***************
*** 27,36 ****
use Safe ();
use Text::ParseWords ();
use Text::Wrap;
END { $End++; &cleanup; }
! %CPAN::DEBUG = qw(
CPAN 1
Index 2
InfoObj 4
--- 28,38 ----
use Safe ();
use Text::ParseWords ();
use Text::Wrap;
+ use File::Spec;
END { $End++; &cleanup; }
! %CPAN::DEBUG = qw[
CPAN 1
Index 2
InfoObj 4
***************
*** 45,51 ****
Eval 2048
Config 4096
Tarzip 8192
! );
$CPAN::DEBUG ||= 0;
$CPAN::Signal ||= 0;
--- 47,53 ----
Eval 2048
Config 4096
Tarzip 8192
! ];
$CPAN::DEBUG ||= 0;
$CPAN::Signal ||= 0;
***************
*** 56,68 ****
use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
use strict qw(vars);
! @CPAN::ISA = qw(CPAN::Debug Exporter MM); # MM will go away
! # soonish. Already version
! # 1.29 doesn't rely on
! # catfile and catdir being
! # available via
! # inheritance. Anything else
! # in danger?
@EXPORT = qw(
autobundle bundle expand force get
--- 58,64 ----
use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
use strict qw(vars);
! @CPAN::ISA = qw(CPAN::Debug Exporter);
@EXPORT = qw(
autobundle bundle expand force get
***************
*** 75,80 ****
--- 71,77 ----
$l =~ s/.*:://;
my(%EXPORT);
@EXPORT{@EXPORT} = '';
+ CPAN::Config->load unless $CPAN::Config_loaded++;
if (exists $EXPORT{$l}){
CPAN::Shell->$l(@_);
} else {
***************
*** 92,98 ****
--- 89,97 ----
#-> sub CPAN::shell ;
sub shell {
+ my($self) = @_;
$Suppress_readline ||= ! -t STDIN;
+ CPAN::Config->load unless $CPAN::Config_loaded++;
my $prompt = "cpan> ";
local($^W) = 1;
***************
*** 100,107 ****
require Term::ReadLine;
# import Term::ReadLine;
$term = Term::ReadLine->new('CPAN Monitor');
! $readline::rl_completion_function =
! $readline::rl_completion_function = 'CPAN::Complete::cpl';
}
no strict;
--- 99,118 ----
require Term::ReadLine;
# import Term::ReadLine;
$term = Term::ReadLine->new('CPAN Monitor');
! if ($term->ReadLine eq "Term::ReadLine::Gnu") {
! my $attribs = $term->Attribs;
! # $attribs->{completion_entry_function} =
! # $attribs->{'list_completion_function'};
! $attribs->{attempted_completion_function} = sub {
! &CPAN::Complete::gnu_cpl;
! }
! # $attribs->{completion_word} =
! # [qw(help me somebody to find out how
! # to use completion with GNU)];
! } else {
! $readline::rl_completion_function =
! $readline::rl_completion_function = 'CPAN::Complete::cpl';
! }
}
no strict;
***************
*** 109,114 ****
--- 120,126 ----
my $getcwd;
$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my $cwd = CPAN->$getcwd();
+ my $try_detect_readline = $term->ReadLine eq "Term::ReadLine::Stub";
my $rl_avail = $Suppress_readline ? "suppressed" :
($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
"available (try ``install Bundle::CPAN'')";
***************
*** 131,137 ****
$_ = "$continuation$_" if $continuation;
s/^\s+//;
next if /^$/;
! $_ = 'h' if $_ eq '?';
if (/^(?:q(?:uit)?|bye|exit)$/i) {
last;
} elsif (s/\\$//s) {
--- 143,149 ----
$_ = "$continuation$_" if $continuation;
s/^\s+//;
next if /^$/;
! $_ = 'h' if /^\s*\?/;
if (/^(?:q(?:uit)?|bye|exit)$/i) {
last;
} elsif (s/\\$//s) {
***************
*** 168,173 ****
--- 180,199 ----
}
} continue {
$Signal=0;
+ CPAN::Queue->nullify_queue;
+ if ($try_detect_readline) {
+ if ($CPAN::META->has_inst("Term::ReadLine::Gnu")
+ ||
+ $CPAN::META->has_inst("Term::ReadLine::Perl")
+ ) {
+ delete $INC{"Term/ReadLine.pm"};
+ my $redef;
+ local($SIG{__WARN__}) = CPAN::Shell::dotdot_onreload(\$redef);
+ require Term::ReadLine;
+ $CPAN::Frontend->myprint("\n$redef subroutines in Term::ReadLine redefined\n");
+ goto &shell;
+ }
+ }
}
}
***************
*** 230,236 ****
$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
install CPAN::WAIT
});
}
--- 256,262 ----
$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
install CPAN::WAIT
});
}
***************
*** 260,266 ****
if (defined($name=$INC{"$pkg.pm"}))
{
$name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
! $name = undef unless (-r $name);
}
unless (defined $name)
{
--- 286,292 ----
if (defined($name=$INC{"$pkg.pm"}))
{
$name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
! $name = undef unless (-r $name);
}
unless (defined $name)
{
***************
*** 275,281 ****
*$autoload = sub {};
$ok = 1;
} else {
! if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
eval {local $SIG{__DIE__};require $name};
}
if ($@){
--- 301,307 ----
*$autoload = sub {};
$ok = 1;
} else {
! if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
eval {local $SIG{__DIE__};require $name};
}
if ($@){
***************
*** 286,292 ****
}
}
} else {
! $ok = 1;
}
$@ = $save;
# my $lm = Carp::longmess();
--- 312,320 ----
}
}
} else {
!
! $ok = 1;
!
}
$@ = $save;
# my $lm = Carp::longmess();
***************
*** 303,309 ****
# $Try_autoload = 1;
if ($CPAN::Try_autoload) {
! my $p;
for $p (qw(
CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
--- 331,337 ----
# $Try_autoload = 1;
if ($CPAN::Try_autoload) {
! my $p;
for $p (qw(
CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
***************
*** 318,338 ****
@CPAN::Tarzip::ISA = qw(CPAN::Debug);
package CPAN::Queue;
! # currently only used to determine if we should or shouldn't announce
! # the availability of a new CPAN module
sub new {
my($class,$mod) = @_;
! # warn "Queue object for mod[$mod]";
! bless {mod => $mod}, $class;
}
! package CPAN;
- $META ||= CPAN->new; # In case we reeval ourselves we
- # need a ||
! # Do this after you have set up the whole inheritance
! CPAN::Config->load unless defined $CPAN::No_Config_is_ok;
1;
--- 346,472 ----
@CPAN::Tarzip::ISA = qw(CPAN::Debug);
package CPAN::Queue;
!
! # One use of the queue is to determine if we should or shouldn't
! # announce the availability of a new CPAN module
!
! # 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:
!
! # CPAN::Queue is the package where the queue is maintained. Dependencies
! # often have high priority and must be brought to the head of the queue,
! # possibly by jumping the queue if they are already there. My first code
! # attempt tried to be extremely correct. Whenever a module needed
! # immediate treatment, I either unshifted it to the front of the queue,
! # or, if it was already in the queue, I spliced and let it bypass the
! # others. This became a too correct model that made it impossible to put
! # an item more than once into the queue. Why would you need that? Well,
! # you need temporary duplicates as the manager of the queue is a loop
! # that
! #
! # (1) looks at the first item in the queue without shifting it off
! #
! # (2) cares for the item
! #
! # (3) removes the item from the queue, *even if its agenda failed and
! # even if the item isn't the first in the queue anymore* (that way
! # protecting against never ending queues)
! #
! # So if an item has prerequisites, the installation fails now, but we
! # want to retry later. That's easy if we have it twice in the queue.
! #
! # I also expect insane dependency situations where an item gets more
! # than two lives in the queue. Simplest example is triggered by 'install
! # Foo Foo Foo'. People make this kind of mistakes and I don't want to
! # get in the way. I wanted the queue manager to be a dumb servant, not
! # one that knows everything.
! #
! # Who would I tell in this model that the user wants to be asked before
! # processing? I can't attach that information to the module object,
! # because not modules are installed but distributions. So I'd have to
! # tell the distribution object that it should ask the user before
! # processing. Where would the question be triggered then? Most probably
! # in CPAN::Distribution::rematein.
! # Hope that makes sense, my head is a bit off:-) -- AK
!
! use vars qw{ @All };
!
sub new {
my($class,$mod) = @_;
! 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]";
! }
!
! sub nullify_queue {
! @All = ();
! }
!
! package CPAN;
!
! $META ||= CPAN->new; # In case we re-eval ourselves we need the ||
1;
***************
*** 356,367 ****
sub test;
#-> sub CPAN::all ;
! sub all {
my($mgr,$class) = @_;
CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
CPAN::Index->reload;
values %{ $META->{$class} };
}
# Called by shell, not in batch mode. Not clean XXX
#-> sub CPAN::checklock ;
--- 490,503 ----
sub test;
#-> sub CPAN::all ;
! sub all_objects {
my($mgr,$class) = @_;
+ CPAN::Config->load unless $CPAN::Config_loaded++;
CPAN->debug("mgr[$mgr] class[$class]") if $CPAN::DEBUG;
CPAN::Index->reload;
values %{ $META->{$class} };
}
+ *all = \&all_objects;
# Called by shell, not in batch mode. Not clean XXX
#-> sub CPAN::checklock ;
***************
*** 434,441 ****
$self->{LOCK} = $lockfile;
$fh->close;
$SIG{'TERM'} = sub {
! &cleanup;
! $CPAN::Frontend->mydie("Got SIGTERM, leaving");
};
$SIG{'INT'} = sub {
# no blocks!!!
--- 570,577 ----
$self->{LOCK} = $lockfile;
$fh->close;
$SIG{'TERM'} = sub {
! &cleanup;
! $CPAN::Frontend->mydie("Got SIGTERM, leaving");
};
$SIG{'INT'} = sub {
# no blocks!!!
***************
*** 491,503 ****
$file =~ s|/|\\|g if $^O eq 'MSWin32';
$file .= ".pm";
if ($INC{$file}) {
! # warn "$file in %INC"; #debug
return 1;
} elsif (eval { require $file }) {
# eval is good: if we haven't yet read the database it's
# perfect and if we have installed the module in the meantime,
# it tries again. The second require is only a NOOP returning
# 1 if we had success, otherwise it's retrying
$CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
if ($mod eq "CPAN::WAIT") {
push @CPAN::Shell::ISA, CPAN::WAIT;
--- 627,644 ----
$file =~ s|/|\\|g if $^O eq 'MSWin32';
$file .= ".pm";
if ($INC{$file}) {
! # checking %INC is wrong, because $INC{LWP} may be true
! # although $INC{"URI/URL.pm"} may have failed. But as
! # I really want to say "bla loaded OK", I have to somehow
! # cache results.
! ### warn "$file in %INC"; #debug
return 1;
} elsif (eval { require $file }) {
# eval is good: if we haven't yet read the database it's
# perfect and if we have installed the module in the meantime,
# it tries again. The second require is only a NOOP returning
# 1 if we had success, otherwise it's retrying
+
$CPAN::Frontend->myprint("CPAN: $mod loaded ok\n");
if ($mod eq "CPAN::WAIT") {
push @CPAN::Shell::ISA, CPAN::WAIT;
***************
*** 518,523 ****
--- 659,666 ----
});
sleep 2;
+ } else {
+ delete $INC{$file}; # if it inc'd LWP but failed during, say, URI
}
return 0;
}
***************
*** 537,552 ****
#-> sub CPAN::cleanup ;
sub cleanup {
! local $SIG{__DIE__} = '';
! my $i = 0; my $ineval = 0; my $sub;
! while ((undef,undef,undef,$sub) = caller(++$i)) {
! $ineval = 1, last if $sub eq '(eval)';
! }
! return if $ineval && !$End;
! return unless defined $META->{'LOCK'};
! return unless -f $META->{'LOCK'};
! unlink $META->{'LOCK'};
! $CPAN::Frontend->mywarn("Lockfile removed.\n");
}
package CPAN::CacheMgr;
--- 680,709 ----
#-> sub CPAN::cleanup ;
sub cleanup {
! # warn "cleanup called with arg[@_] End[$End] Signal[$Signal]";
! local $SIG{__DIE__} = '';
! my($message) = @_;
! my $i = 0;
! my $ineval = 0;
! if (
! 0 && # disabled, try reload cpan with it
! $] > 5.004_60 # thereabouts
! ) {
! $ineval = $^S;
! } else {
! my($subroutine);
! while ((undef,undef,undef,$subroutine) = caller(++$i)) {
! $ineval = 1, last if
! $subroutine eq '(eval)';
! }
! }
! return if $ineval && !$End;
! return unless defined $META->{'LOCK'};
! return unless -f $META->{'LOCK'};
! unlink $META->{'LOCK'};
! # require Carp;
! # Carp::cluck("DEBUGGING");
! $CPAN::Frontend->mywarn("Lockfile removed.\n");
}
package CPAN::CacheMgr;
***************
*** 597,603 ****
$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my($cwd) = CPAN->$getcwd();
chdir $dir or Carp::croak("Can't chdir to $dir: $!");
! my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir $dir: $!");
my(@entries);
for ($dh->read) {
next if $_ eq "." || $_ eq "..";
--- 754,761 ----
$getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
my($cwd) = CPAN->$getcwd();
chdir $dir or Carp::croak("Can't chdir to $dir: $!");
! my $dh = DirHandle->new(File::Spec->curdir)
! or Carp::croak("Couldn't opendir $dir: $!");
my(@entries);
for ($dh->read) {
next if $_ eq "." || $_ eq "..";
***************
*** 621,629 ****
my($Du) = 0;
find(
sub {
! $File::Find::prune++ if $CPAN::Signal;
! return if -l $_;
! $Du += -s _;
},
$dir
);
--- 779,793 ----
my($Du) = 0;
find(
sub {
! $File::Find::prune++ if $CPAN::Signal;
! return if -l $_;
! if ($^O eq 'MacOS') {
! require Mac::Files;
! my $cat = Mac::Files::FSpGetCatInfo($_);
! $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen();
! } else {
! $Du += (-s _);
! }
},
$dir
);
***************
*** 655,680 ****
my $self = {
ID => $CPAN::Config->{'build_dir'},
MAX => $CPAN::Config->{'build_cache'},
DU => 0
};
File::Path::mkpath($self->{ID});
my $dh = DirHandle->new($self->{ID});
bless $self, $class;
! my $e;
$CPAN::Frontend->myprint(
sprintf("Scanning cache %s for sizes\n",
$self->{ID}));
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;
--- 819,854 ----
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;
! $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;
}
package CPAN::Debug;
***************
*** 755,761 ****
unless (defined $configpm){
$configpm ||= $INC{"CPAN/MyConfig.pm"};
$configpm ||= $INC{"CPAN/Config.pm"};
! $configpm || Carp::confess(qq{
CPAN::Config::commit called without an argument.
Please specify a filename where to save the configuration or try
"o conf init" to have an interactive course through configing.
--- 929,935 ----
unless (defined $configpm){
$configpm ||= $INC{"CPAN/MyConfig.pm"};
$configpm ||= $INC{"CPAN/Config.pm"};
! $configpm || Carp::confess(q{
CPAN::Config::commit called without an argument.
Please specify a filename where to save the configuration or try
"o conf init" to have an interactive course through configing.
***************
*** 779,784 ****
--- 953,959 ----
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) {
***************
*** 823,828 ****
--- 998,1004 ----
sub load {
my($self) = shift;
my(@miss);
+ use Carp;
eval {require CPAN::Config;}; # We eval because of some
# MakeMaker problems
unless ($dot_cpan++){
***************
*** 887,897 ****
}
}
local($") = ", ";
! $CPAN::Frontend->myprint(qq{
We have to reconfigure CPAN.pm due to following uninitialized parameters:
@miss
! }) if $redo && ! $theycalled;
$CPAN::Frontend->myprint(qq{
$configpm initialized.
});
--- 1063,1073 ----
}
}
local($") = ", ";
! $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
We have to reconfigure CPAN.pm due to following uninitialized parameters:
@miss
! END
$CPAN::Frontend->myprint(qq{
$configpm initialized.
});
***************
*** 903,911 ****
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
)) {
push @miss, $_ unless defined $CPAN::Config->{$_};
}
--- 1079,1088 ----
sub not_loaded {
my(@miss);
for (qw(
! 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->{$_};
}
***************
*** 918,927 ****
delete $INC{'CPAN/Config.pm'};
}
- *h = \&help;
#-> sub CPAN::Config::help ;
sub help {
! $CPAN::Frontend->myprint(qq{
Known options:
defaults reload default config values from disk
commit commit session changes to disk
--- 1095,1103 ----
delete $INC{'CPAN/Config.pm'};
}
#-> sub CPAN::Config::help ;
sub help {
! $CPAN::Frontend->myprint(q[
Known options:
defaults reload default config values from disk
commit commit session changes to disk
***************
*** 937,943 ****
o conf urllist unshift ftp://ftp.foo.bar/
! });
undef; #don't reprint CPAN::Config
}
--- 1113,1119 ----
o conf urllist unshift ftp://ftp.foo.bar/
! ]);
undef; #don't reprint CPAN::Config
}
***************
*** 1024,1030 ****
#-> 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 CPAN::Shell::i ;
sub i {
--- 1200,1208 ----
#-> sub CPAN::Shell::d ;
sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
#-> sub CPAN::Shell::m ;
! sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
! $CPAN::Frontend->myprint(shift->format_result('Module',@_));
! }
#-> sub CPAN::Shell::i ;
sub i {
***************
*** 1139,1144 ****
--- 1317,1337 ----
}
}
+ sub dotdot_onreload {
+ my($ref) = shift;
+ sub {
+ if ( $_[0] =~ /Subroutine (\w+) redefined/ ) {
+ my($subr) = $1;
+ ++$$ref;
+ local($|) = 1;
+ # $CPAN::Frontend->myprint(".($subr)");
+ $CPAN::Frontend->myprint(".");
+ return;
+ }
+ warn @_;
+ };
+ }
+
#-> sub CPAN::Shell::reload ;
sub reload {
my($self,$command,@arg) = @_;
***************
*** 1148,1174 ****
CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
my $fh = FileHandle->new($INC{'CPAN.pm'});
local($/);
- undef $/;
$redef = 0;
! local($SIG{__WARN__})
! = sub {
! if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
! ++$redef;
! local($|) = 1;
! $CPAN::Frontend->myprint(".");
! return;
! }
! warn @_;
! };
eval <$fh>;
warn $@ if $@;
$CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
} elsif ($command =~ /index/) {
! CPAN::Index->force_reload;
} else {
! $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
! index re-reads the index files
! });
}
}
--- 1341,1356 ----
CPAN->debug("reloading the whole CPAN.pm") if $CPAN::DEBUG;
my $fh = FileHandle->new($INC{'CPAN.pm'});
local($/);
$redef = 0;
! local($SIG{__WARN__}) = dotdot_onreload(\$redef);
eval <$fh>;
warn $@ if $@;
$CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
} elsif ($command =~ /index/) {
! CPAN::Index->force_reload;
} else {
! $CPAN::Frontend->myprint(qq{cpan re-evals the CPAN.pm file
! index re-reads the index files\n});
}
}
***************
*** 1323,1328 ****
--- 1505,1511 ----
#-> sub CPAN::Shell::autobundle ;
sub autobundle {
my($self) = shift;
+ CPAN::Config->load unless $CPAN::Config_loaded++;
my(@bundle) = $self->_u_r_common("a",@_);
my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
File::Path::mkpath($todir);
***************
*** 1379,1385 ****
my $class = "CPAN::$type";
my $obj;
if (defined $regex) {
! for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all($class)) {
push @m, $obj
if
$obj->id =~ /$regex/i
--- 1562,1568 ----
my $class = "CPAN::$type";
my $obj;
if (defined $regex) {
! for $obj ( sort {$a->id cmp $b->id} $CPAN::META->all_objects($class)) {
push @m, $obj
if
$obj->id =~ /$regex/i
***************
*** 1500,1521 ****
CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
my($s,@s);
foreach $s (@some) {
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\[}.
$obj->as_string.
qq{\]}
) if $CPAN::DEBUG;
--- 1683,1705 ----
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::|) {
$obj = $CPAN::META->instance('CPAN::Bundle',$s);
} else {
$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\[}.
$obj->as_string.
qq{\]}
) if $CPAN::DEBUG;
***************
*** 1530,1536 ****
if ($]>=5.00303 && $obj->can('called_for')) {
$obj->called_for($s);
}
! $obj->$meth();
} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
$obj = $CPAN::META->instance('CPAN::Author',$s);
$CPAN::Frontend->myprint(
--- 1714,1722 ----
if ($]>=5.00303 && $obj->can('called_for')) {
$obj->called_for($s);
}
! 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(
***************
*** 1540,1546 ****
" ;-)\n"
);
} else {
! $CPAN::Frontend->myprint(qq{Warning: Cannot $meth $s, don\'t know what it is.
Try the command
i /$s/
--- 1726,1734 ----
" ;-)\n"
);
} else {
! $CPAN::Frontend
! ->myprint(qq{Warning: Cannot $meth $s, }.
! qq{don\'t know what it is.
Try the command
i /$s/
***************
*** 1548,1553 ****
--- 1736,1742 ----
to find objects with similar identifiers.
});
}
+ CPAN::Queue->delete_first($s);
}
}
***************
*** 1572,1606 ****
#-> sub CPAN::FTP::ftp_get ;
sub ftp_get {
! my($class,$host,$dir,$file,$target) = @_;
! $class->debug(
! qq[Going to fetch file [$file] from dir [$dir]
on host [$host] as local [$target]\n]
) if $CPAN::DEBUG;
! my $ftp = Net::FTP->new($host);
! return 0 unless defined $ftp;
! $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
! $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
! unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
! warn "Couldn't login on $host";
! return;
! }
! unless ( $ftp->cwd($dir) ){
! warn "Couldn't cwd $dir";
! return;
! }
! $ftp->binary;
! $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
! unless ( $ftp->get($file,$target) ){
! warn "Couldn't fetch $file from $host\n";
! return;
! }
! $ftp->quit; # it's ok if this fails
! return 1;
}
# 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,> ***************
--- 1761,1795 ----
#-> sub CPAN::FTP::ftp_get ;
sub ftp_get {
! my($class,$host,$dir,$file,$target) = @_;
! $class->debug(
! qq[Going to fetch file [$file] from dir [$dir]
on host [$host] as local [$target]\n]
) if $CPAN::DEBUG;
! my $ftp = Net::FTP->new($host);
! return 0 unless defined $ftp;
! $ftp->debug(1) if $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG;
! $class->debug(qq[Going to ->login("anonymous","$Config::Config{'cf_email'}")\n]);
! unless ( $ftp->login("anonymous",$Config::Config{'cf_email'}) ){
! warn "Couldn't login on $host";
! return;
! }
! unless ( $ftp->cwd($dir) ){
! warn "Couldn't cwd $dir";
! return;
! }
! $ftp->binary;
! $class->debug(qq[Going to ->get("$file","$target")\n]) if $CPAN::DEBUG;
! unless ( $ftp->get($file,$target) ){
! warn "Couldn't fetch $file from $host\n";
! return;
! }
! $ftp->quit; # it's ok if this fails
! return 1;
}
# 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,> ***************
***************
*** 1664,1669 ****
--- 1853,1872 ----
$self->debug("file[$file] aslocal[$aslocal] force[$force]")
if $CPAN::DEBUG;
+ if ($^O eq 'MacOS') {
+ my($name, $path) = File::Basename::fileparse($aslocal, '');
+ if (length($name) > 31) {
+ $name =~ s/(\.(readme(\.(gz|Z))?|(tar\.)?(gz|Z)|tgz|zip|pm\.(gz|Z)))$//;
+ my $suf = $1;
+ my $size = 31 - length($suf);
+ while (length($name) > $size) {
+ chop $name;
+ }
+ $name .= $suf;
+ $aslocal = File::Spec->catfile($path, $name);
+ }
+ }
+
return $aslocal if -f $aslocal && -r _ && !($force & 1);
my($restore) = 0;
if (-f $aslocal){
***************
*** 1679,1685 ****
to insufficient permissions.\n}) unless -w $aslocal_dir;
# Inheritance is not easier to manage than a few if/else branches
! if ($CPAN::META->has_inst('LWP')) {
require LWP::UserAgent;
unless ($Ua) {
$Ua = LWP::UserAgent->new;
--- 1882,1888 ----
to insufficient permissions.\n}) unless -w $aslocal_dir;
# Inheritance is not easier to manage than a few if/else branches
! if ($CPAN::META->has_inst('LWP::UserAgent')) {
require LWP::UserAgent;
unless ($Ua) {
$Ua = LWP::UserAgent->new;
***************
*** 1704,1710 ****
@reordered =
sort {
(substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
! <=>
(substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
or
defined($Thesite)
--- 1907,1913 ----
@reordered =
sort {
(substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
! <=>
(substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
or
defined($Thesite)
***************
*** 1713,1723 ****
<=>
($a == $Thesite)
} 0..$last;
-
- # ((grep { substr($CPAN::Config->{urllist}[$_],0,4)
- # eq "file" } 0..$last),
- # (grep { substr($CPAN::Config->{urllist}[$_],0,4)
- # ne "file" } 0..$last));
}
my($level,@levels);
if ($Themethod) {
--- 1916,1921 ----
***************
*** 1725,1730 ****
--- 1923,1929 ----
} else {
@levels = qw/easy hard hardest/;
}
+ @levels = qw/easy/ if $^O eq 'MacOS';
for $level (@levels) {
my $method = "host$level";
my @host_seq = $level eq "easy" ?
***************
*** 1732,1740 ****
@host_seq = (0) unless @host_seq;
my $ret = $self->$method(\@host_seq,$file,$aslocal);
if ($ret) {
! $Themethod = $level;
! $self->debug("level[$level]") if $CPAN::DEBUG;
! return $ret;
}
}
my(@mess);
--- 1931,1941 ----
@host_seq = (0) unless @host_seq;
my $ret = $self->$method(\@host_seq,$file,$aslocal);
if ($ret) {
! $Themethod = $level;
! $self->debug("level[$level]") if $CPAN::DEBUG;
! return $ret;
! } else {
! unlink $aslocal;
}
}
my(@mess);
***************
*** 1780,1787 ****
# fileurl = "file://" [ host | "localhost" ] "/" fpath
# Thanks to "Mark D. Baushke" <mdb@cisco.com> for
# the code
! ($l = $url) =~ s,^file://[^/]+,,; # discard the host part
! $l =~ s/^file://; # assume they meant file://localhost
}
if ( -f $l && -r _) {
$Thesite = $i;
--- 1981,1991 ----
# fileurl = "file://" [ host | "localhost" ] "/" fpath
# Thanks to "Mark D. Baushke" <mdb@cisco.com> for
# the code
! ($l = $url) =~ s|^file://[^/]*/|/|; # discard the host part
! $l =~ s|^file:||; # assume they
! # meant
! # file://localhost
! $l =~ s|^/|| unless -f $l; # e.g. /P:
}
if ( -f $l && -r _) {
$Thesite = $i;
***************
*** 1797,1806 ****
}
}
}
! if ($CPAN::META->has_inst('LWP')) {
$CPAN::Frontend->myprint("Fetching with LWP:
$url
");
my $res = $Ua->mirror($url, $aslocal);
if ($res->is_success) {
$Thesite = $i;
--- 2001,2014 ----
}
}
}
! if ($CPAN::META->has_inst('LWP')) {
$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;
***************
*** 1847,1853 ****
$CPAN::Frontend->myprint("Fetching with Net::FTP
$url.gz
");
! if (CPAN::FTP->ftp_get($host,
$dir,
"$getfile.gz",
$gz) &&
--- 2055,2061 ----
$CPAN::Frontend->myprint("Fetching with Net::FTP
$url.gz
");
! if (CPAN::FTP->ftp_get($host,
$dir,
"$getfile.gz",
$gz) &&
***************
*** 1864,1878 ****
}
sub hosthard {
! my($self,$host_seq,$file,$aslocal) = @_;
! # Came back if Net::FTP couldn't establish connection (or
! # failed otherwise) Maybe they are behind a firewall, but they
! # gave us a socksified (or other) ftp program...
!
! my($i);
! my($aslocal_dir) = File::Basename::dirname($aslocal);
! File::Path::mkpath($aslocal_dir);
HOSTHARD: for $i (@$host_seq) {
my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
unless ($self->is_reachable($url)) {
--- 2072,2088 ----
}
sub hosthard {
! my($self,$host_seq,$file,$aslocal) = @_;
! # Came back if Net::FTP couldn't establish connection (or
! # failed otherwise) Maybe they are behind a firewall, but they
! # gave us a socksified (or other) ftp program...
!
! my($i);
! my($devnull) = $CPAN::Config->{devnull} || "";
! # < /dev/null ";
! my($aslocal_dir) = File::Basename::dirname($aslocal);
! File::Path::mkpath($aslocal_dir);
HOSTHARD: for $i (@$host_seq) {
my $url = $CPAN::Config->{urllist}[$i] || $CPAN::Defaultsite;
unless ($self->is_reachable($url)) {
***************
*** 1894,1900 ****
}
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
my($f,$funkyftp);
! for $f ('lynx','ncftp') {
next unless exists $CPAN::Config->{$f};
$funkyftp = $CPAN::Config->{$f};
next unless defined $funkyftp;
--- 2104,2110 ----
}
$self->debug("localizing funkyftpwise[$url]") if $CPAN::DEBUG;
my($f,$funkyftp);
! for $f ('lynx','ncftpget','ncftp') {
next unless exists $CPAN::Config->{$f};
$funkyftp = $CPAN::Config->{$f};
next unless defined $funkyftp;
***************
*** 1903,1916 ****
my $aslocal_uncompressed;
($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
my($source_switch) = "";
! $source_switch = "-source" if $funkyftp =~ /\blynx$/;
! $source_switch = "-c" if $funkyftp =~ /\bncftp$/;
$CPAN::Frontend->myprint(
! qq{
! Trying with "$funkyftp $source_switch" to get
$url
! });
! my($system) = "$funkyftp $source_switch '$url' > ".
"$aslocal_uncompressed";
$self->debug("system[$system]") if $CPAN::DEBUG;
my($wstatus);
--- 2113,2126 ----
my $aslocal_uncompressed;
($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
my($source_switch) = "";
! $source_switch = " -source" if $funkyftp =~ /\blynx$/;
! $source_switch = " -c" if $funkyftp =~ /\bncftp$/;
$CPAN::Frontend->myprint(
! qq[
! Trying with "$funkyftp$source_switch" to get
$url
! ]);
! my($system) = "$funkyftp$source_switch '$url' $devnull > ".
"$aslocal_uncompressed";
$self->debug("system[$system]") if $CPAN::DEBUG;
my($wstatus);
***************
*** 1929,1964 ****
CPAN::Tarzip->gzip($aslocal_uncompressed,
"$aslocal_uncompressed.gz");
}
- $Thesite = $i;
- return $aslocal;
}
} elsif ($url !~ /\.gz$/) {
! my $gz = "$aslocal.gz";
! my $gzurl = "$url.gz";
! $CPAN::Frontend->myprint(
! qq{
! Trying with "$funkyftp $source_switch" to get
$url.gz
! });
! my($system) = "$funkyftp $source_switch '$url.gz' > ".
! "$aslocal_uncompressed.gz";
! $self->debug("system[$system]") if $CPAN::DEBUG;
! my($wstatus);
! if (($wstatus = system($system)) == 0
! &&
! -s "$aslocal_uncompressed.gz"
! ) {
! # test gzip integrity
! if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
! CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
! $aslocal);
! } else {
! rename $aslocal_uncompressed, $aslocal;
! }
! #line 1739
! $Thesite = $i;
! return $aslocal;
}
} else {
my $estatus = $wstatus >> 8;
my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : "";
--- 2139,2178 ----
CPAN::Tarzip->gzip($aslocal_uncompressed,
"$aslocal_uncompressed.gz");
}
}
+ $Thesite = $i;
+ return $aslocal;
} elsif ($url !~ /\.gz$/) {
! unlink $aslocal_uncompressed if
! -f $aslocal_uncompressed && -s _ == 0;
! my $gz = "$aslocal.gz";
! my $gzurl = "$url.gz";
! $CPAN::Frontend->myprint(
! qq[
! Trying with "$funkyftp$source_switch" to get
$url.gz
! ]);
! my($system) = "$funkyftp$source_switch '$url.gz' $devnull > ".
! "$aslocal_uncompressed.gz";
! $self->debug("system[$system]") if $CPAN::DEBUG;
! my($wstatus);
! if (($wstatus = system($system)) == 0
! &&
! -s "$aslocal_uncompressed.gz"
! ) {
! # test gzip integrity
! if (CPAN::Tarzip->gtest("$aslocal_uncompressed.gz")) {
! CPAN::Tarzip->gunzip("$aslocal_uncompressed.gz",
! $aslocal);
! } else {
! rename $aslocal_uncompressed, $aslocal;
}
+ $Thesite = $i;
+ return $aslocal;
+ } else {
+ unlink "$aslocal_uncompressed.gz" if
+ -f "$aslocal_uncompressed.gz";
+ }
} else {
my $estatus = $wstatus >> 8;
my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : "";
***************
*** 2047,2053 ****
$CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
nor does it have a default entry\n");
}
!
# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
# then and login manually to host, using e-mail as
# password.
--- 2261,2267 ----
$CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
nor does it have a default entry\n");
}
!
# OK, they don't have a valid ~/.netrc. Use 'ftp -n'
# then and login manually to host, using e-mail as
# password.
***************
*** 2085,2091 ****
Subprocess "|$command"
returned status $estatus (wstat $wstatus)
}) if $wstatus;
-
}
# find2perl needs modularization, too, all the following is stolen
--- 2299,2304 ----
***************
*** 2212,2217 ****
--- 2425,2451 ----
package CPAN::Complete;
+ sub gnu_cpl {
+ my($text, $line, $start, $end) = @_;
+ my(@perlret) = cpl($text, $line, $start);
+ # find longest common match. Can anybody show me how to peruse
+ # T::R::Gnu to have this done automatically? Seems expensive.
+ return () unless @perlret;
+ my($newtext) = $text;
+ for (my $i = length($text)+1;;$i++) {
+ last unless length($perlret[0]) && length($perlret[0]) >= $i;
+ my $try = substr($perlret[0],0,$i);
+ my @tries = grep {substr($_,0,$i) eq $try} @perlret;
+ # warn "try[$try]tries[@tries]";
+ if (@tries == @perlret) {
+ $newtext = $try;
+ } else {
+ last;
+ }
+ }
+ ($newtext,@perlret);
+ }
+
#-> sub CPAN::Complete::cpl ;
sub cpl {
my($word,$line,$pos) = @_;
***************
*** 2257,2263 ****
#-> sub CPAN::Complete::cplx ;
sub cplx {
my($class, $word) = @_;
! grep /^\Q$word\E/, map { $_->id } $CPAN::META->all($class);
}
#-> sub CPAN::Complete::cpl_any ;
--- 2491,2497 ----
#-> sub CPAN::Complete::cplx ;
sub cplx {
my($class, $word) = @_;
! grep /^\Q$word\E/, map { $_->id } $CPAN::META->all_objects($class);
}
#-> sub CPAN::Complete::cpl_any ;
***************
*** 2327,2352 ****
my $needshort = $^O eq "dos";
! $cl->rd_authindex($cl->reload_x(
! "authors/01mailrc.txt.gz",
! $needshort ? "01mailrc.gz" : "",
! $force));
$t2 = time;
$debug = "timing reading 01[".($t2 - $time)."]";
$time = $t2;
return if $CPAN::Signal; # this is sometimes lengthy
! $cl->rd_modpacks($cl->reload_x(
! "modules/02packages.details.txt.gz",
! $needshort ? "02packag.gz" : "",
! $force));
$t2 = time;
$debug .= "02[".($t2 - $time)."]";
$time = $t2;
return if $CPAN::Signal; # this is sometimes lengthy
! $cl->rd_modlist($cl->reload_x(
! "modules/03modlist.data.gz",
! $needshort ? "03mlist.gz" : "",
! $force));
$t2 = time;
$debug .= "03[".($t2 - $time)."]";
$time = $t2;
--- 2561,2595 ----
my $needshort = $^O eq "dos";
! $cl->rd_authindex($cl
! ->reload_x(
! "authors/01mailrc.txt.gz",
! $needshort ?
! File::Spec->catfile('authors', '01mailrc.gz') :
! File::Spec->catfile('authors', '01mailrc.txt.gz'),
! $force));
$t2 = time;
$debug = "timing reading 01[".($t2 - $time)."]";
$time = $t2;
return if $CPAN::Signal; # this is sometimes lengthy
! $cl->rd_modpacks($cl
! ->reload_x(
! "modules/02packages.details.txt.gz",
! $needshort ?
! File::Spec->catfile('modules', '02packag.gz') :
! File::Spec->catfile('modules', '02packages.details.txt.gz'),
! $force));
$t2 = time;
$debug .= "02[".($t2 - $time)."]";
$time = $t2;
return if $CPAN::Signal; # this is sometimes lengthy
! $cl->rd_modlist($cl
! ->reload_x(
! "modules/03modlist.data.gz",
! $needshort ?
! File::Spec->catfile('modules', '03mlist.gz') :
! File::Spec->catfile('modules', '03modlist.data.gz'),
! $force));
$t2 = time;
$debug .= "03[".($t2 - $time)."]";
$time = $t2;
***************
*** 2379,2385 ****
#-> sub CPAN::Index::rd_authindex ;
sub rd_authindex {
! my($cl,$index_target) = @_;
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
# my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
--- 2622,2629 ----
#-> sub CPAN::Index::rd_authindex ;
sub rd_authindex {
! my($cl, $index_target) = @_;
! my @lines;
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
# my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
***************
*** 2388,2397 ****
local(*FH);
tie *FH, CPAN::Tarzip, $index_target;
local($/) = "\n";
! while (<FH>) {
! chomp;
my($userid,$fullname,$email) =
! /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
next unless $userid && $fullname && $email;
# instantiate an author object
--- 2632,2641 ----
local(*FH);
tie *FH, CPAN::Tarzip, $index_target;
local($/) = "\n";
! push @lines, split /\012/ while <FH>;
! foreach (@lines) {
my($userid,$fullname,$email) =
! m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
next unless $userid && $fullname && $email;
# instantiate an author object
***************
*** 2410,2435 ****
#-> sub CPAN::Index::rd_modpacks ;
sub rd_modpacks {
! my($cl,$index_target) = @_;
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
local($/) = "\n";
while ($_ = $fh->READLINE) {
! last if /^\s*$/;
}
! while ($_ = $fh->READLINE) {
chomp;
my($mod,$version,$dist) = split;
### $version =~ s/^\+//;
# 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')
)
) {
local($^W)= 0;
--- 2654,2687 ----
#-> sub CPAN::Index::rd_modpacks ;
sub rd_modpacks {
! my($cl, $index_target) = @_;
! my @lines;
return unless defined $index_target;
$CPAN::Frontend->myprint("Going to read $index_target\n");
my $fh = CPAN::Tarzip->TIEHANDLE($index_target);
local($/) = "\n";
while ($_ = $fh->READLINE) {
! s/\012/\n/g;
! my @ls = map {"$_\n"} split /\n/, $_;
! unshift @ls, "\n" x length($1) if /^(\n+)/;
! push @lines, @ls;
! }
! while (@lines) {
! my $shift = shift(@lines);
! last if $shift =~ /^\s*$/;
}
! foreach (@lines) {
chomp;
my($mod,$version,$dist) = split;
### $version =~ s/^\+//;
# if it is a bundle, instatiate a bundle object
my($bundle,$id,$userid);
!
if ($mod eq 'CPAN' &&
! (
! CPAN::Queue->exists('Bundle::CPAN') ||
! CPAN::Queue->exists('CPAN')
)
) {
local($^W)= 0;
***************
*** 2452,2460 ****
--- 2704,2714 ----
if ($bundle){
$id = $CPAN::META->instance('CPAN::Bundle',$mod);
+ # warn "made mod[$mod]a bundle";
# Let's make it a module too, because bundles have so much
# in common with modules
$CPAN::META->instance('CPAN::Module',$mod);
+ # warn "made mod[$mod]a module";
# This "next" makes us faster but if the job is running long, we ignore
# rereads which is bad. So we have to be a bit slower again.
***************
*** 2499,2511 ****
my @eval;
local($/) = "\n";
while ($_ = $fh->READLINE) {
! if (/^Date:\s+(.*)/){
return if $date_of_03 eq $1;
($date_of_03) = $1;
}
! last if /^\s*$/;
}
- push @eval, $_ while $_ = $fh->READLINE;
undef $fh;
push @eval, q{CPAN::Modulelist->data;};
local($^W) = 0;
--- 2753,2771 ----
my @eval;
local($/) = "\n";
while ($_ = $fh->READLINE) {
! s/\012/\n/g;
! my @ls = map {"$_\n"} split /\n/, $_;
! unshift @ls, "\n" x length($1) if /^(\n+)/;
! push @eval, @ls;
! }
! while (@eval) {
! my $shift = shift(@eval);
! if ($shift =~ /^Date:\s+(.*)/){
return if $date_of_03 eq $1;
($date_of_03) = $1;
}
! last if $shift =~ /^\s*$/;
}
undef $fh;
push @eval, q{CPAN::Modulelist->data;};
local($^W) = 0;
***************
*** 2604,2609 ****
--- 2864,2870 ----
#-> sub CPAN::Author::fullname ;
sub fullname { shift->{'FULLNAME'} }
*name = \&fullname;
+
#-> sub CPAN::Author::email ;
sub email { shift->{'EMAIL'} }
***************
*** 2667,2677 ****
} else {
$self->{archived} = "NO";
}
! chdir "..";
if ($self->{archived} ne 'NO') {
! chdir "tmp";
# Let's check if the package has its own directory.
! my $dh = DirHandle->new(".") or Carp::croak("Couldn't opendir .: $!");
my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
$dh->close;
my ($distdir,$packagedir);
--- 2928,2939 ----
} else {
$self->{archived} = "NO";
}
! chdir File::Spec->updir;
if ($self->{archived} ne 'NO') {
! chdir File::Spec->catdir(File::Spec->curdir, "tmp");
# Let's check if the package has its own directory.
! my $dh = DirHandle->new(File::Spec->curdir)
! or Carp::croak("Couldn't opendir .: $!");
my @readdir = grep $_ !~ /^\.\.?$/, $dh->read; ### MAC??
$dh->close;
my ($distdir,$packagedir);
***************
*** 2694,2700 ****
}
}
$self->{'build_dir'} = $packagedir;
! chdir "..";
$self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
if $CPAN::DEBUG;
--- 2956,2962 ----
}
}
$self->{'build_dir'} = $packagedir;
! chdir File::Spec->updir;
$self->debug("Changed directory to .. (self is $self [".$self->as_string."])")
if $CPAN::DEBUG;
***************
*** 2783,2788 ****
--- 3045,3056 ----
#-> sub CPAN::Distribution::look ;
sub look {
my($self) = @_;
+
+ if ($^O eq 'MacOS') {
+ $self->ExtUtils::MM_MacOS::look;
+ return;
+ }
+
if ( $CPAN::Config->{'shell'} ) {
$CPAN::Frontend->myprint(qq{
Trying to open a subshell in the build directory...
***************
*** 2825,2830 ****
--- 3093,3104 ----
$local_file = CPAN::FTP->localize("authors/id/$sans.readme",
$local_wanted)
or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::launch_file($local_file);
+ return;
+ }
+
my $fh_pager = FileHandle->new;
local($SIG{PIPE}) = "IGNORE";
$fh_pager->open("|$CPAN::Config->{'pager'}")
***************
*** 2891,2896 ****
--- 3165,3171 ----
if (open $fh, $chk_file){
local($/);
my $eval = <$fh>;
+ $eval =~ s/\015?\012/\n/g;
close $fh;
my($comp) = Safe->new();
$cksum = $comp->reval($eval);
***************
*** 2978,2993 ****
#-> 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'};
}
sub isa_perl {
--- 3253,3266 ----
#-> sub CPAN::Distribution::force ;
sub force {
! 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 {
***************
*** 3078,3083 ****
--- 3351,3361 ----
chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
$self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make($self);
+ return;
+ }
+
my $system;
if ($self->{'configure'}) {
$system = $self->{'configure'};
***************
*** 3097,3106 ****
if ($CPAN::Config->{inactivity_timeout}) {
eval {
alarm $CPAN::Config->{inactivity_timeout};
! local $SIG{CHLD} = sub { wait };
if (defined($pid = fork)) {
if ($pid) { #parent
! wait;
} else { #child
# note, this exec isn't necessary if
# inactivity_timeout is 0. On the Mac I'd
--- 3375,3385 ----
if ($CPAN::Config->{inactivity_timeout}) {
eval {
alarm $CPAN::Config->{inactivity_timeout};
! local $SIG{CHLD}; # = sub { wait };
if (defined($pid = fork)) {
if ($pid) { #parent
! # wait;
! waitpid $pid, 0;
} else { #child
# note, this exec isn't necessary if
# inactivity_timeout is 0. On the Mac I'd
***************
*** 3122,3158 ****
return;
}
} else {
! if (0) {
! warn "Trying to intercept the output of 'perl Makefile.PL'";
! require IO::File;
! # my $fh = FileHandle->new("$system 2>&1 |") or
! my $fh = IO::File->new("$system 2>&1 |") or
! die "Couldn't run '$system': $!";
! local($|) = 1;
! while (length($_ = getc($fh))) {
! print $_; # we want to parse that some day!
! # unfortunately we have Makefile.PLs that want to talk
! # and we can't emulate that reliably. I think, we have
! # to parse Makefile.PL directly
! }
! $ret = $fh->close;
! unless ($ret) {
! warn $! ? "Error during 'perl Makefile.PL' subprocess: $!" :
! "Exit status of 'perl Makefile.PL': $?";
! $self->{writemakefile} = "NO";
! return;
! }
! } else {
! $ret = system($system);
! if ($ret != 0) {
! $self->{writemakefile} = "NO";
! return;
! }
}
}
$self->{writemakefile} = "YES";
}
return if $CPAN::Signal;
$system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
--- 3401,3441 ----
return;
}
} else {
! $ret = system($system);
! if ($ret != 0) {
! $self->{writemakefile} = "NO";
! return;
}
}
$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");
+ }
+ 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;
+ } else {
+ local($") = ", ";
+ $CPAN::Frontend->myprint(" Ignoring dependencies on modules @prereq\n");
+ }
+ 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");
***************
*** 3164,3169 ****
--- 3447,3490 ----
}
}
+ #-> 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(@p,@need);
+ 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;
+ }
+ for my $p (@p) {
+ my $mo = $CPAN::META->instance("CPAN::Module",$p);
+ next if $mo->uptodate;
+ # it's not needed, so don't push it. We cannot omit this step, because
+ # if 'force' is in effect, nobody else will check.
+ 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?
+ # if we push it again, we have a potential infinite loop
+ next;
+ }
+ push @need, $p;
+ }
+ return @need;
+ }
+
#-> sub CPAN::Distribution::test ;
sub test {
my($self) = @_;
***************
*** 3186,3191 ****
--- 3507,3518 ----
Carp::croak("Couldn't chdir to $self->{'build_dir'}");
$self->debug("Changed directory to $self->{'build_dir'}")
if $CPAN::DEBUG;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make_test($self);
+ return;
+ }
+
my $system = join " ", $CPAN::Config->{'make'}, "test";
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
***************
*** 3208,3213 ****
--- 3535,3546 ----
chdir $self->{'build_dir'} or
Carp::croak("Couldn't chdir to $self->{'build_dir'}");
$self->debug("Changed directory to $self->{'build_dir'}") if $CPAN::DEBUG;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make_clean($self);
+ return;
+ }
+
my $system = join " ", $CPAN::Config->{'make'}, "clean";
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
***************
*** 3250,3258 ****
Carp::croak("Couldn't chdir to $self->{'build_dir'}");
$self->debug("Changed directory to $self->{'build_dir'}")
if $CPAN::DEBUG;
my $system = join(" ", $CPAN::Config->{'make'},
"install", $CPAN::Config->{make_install_arg});
! my($pipe) = FileHandle->new("$system 2>&1 |");
my($makeout) = "";
while (<$pipe>){
$CPAN::Frontend->myprint($_);
--- 3583,3598 ----
Carp::croak("Couldn't chdir to $self->{'build_dir'}");
$self->debug("Changed directory to $self->{'build_dir'}")
if $CPAN::DEBUG;
+
+ if ($^O eq 'MacOS') {
+ ExtUtils::MM_MacOS::make_install($self);
+ return;
+ }
+
my $system = join(" ", $CPAN::Config->{'make'},
"install", $CPAN::Config->{make_install_arg});
! my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
! my($pipe) = FileHandle->new("$system $stderr |");
my($makeout) = "";
while (<$pipe>){
$CPAN::Frontend->myprint($_);
***************
*** 3261,3267 ****
$pipe->close;
if ($?==0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
! $self->{'install'} = "YES";
} else {
$self->{'install'} = "NO";
$CPAN::Frontend->myprint(" $system -- NOT OK\n");
--- 3601,3607 ----
$pipe->close;
if ($?==0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
! return $self->{'install'} = "YES";
} else {
$self->{'install'} = "NO";
$CPAN::Frontend->myprint(" $system -- NOT OK\n");
***************
*** 3289,3346 ****
#-> sub CPAN::Bundle::contains ;
sub contains {
! my($self) = @_;
! my($parsefile) = $self->inst_file;
! my($id) = $self->id;
! $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
! unless ($parsefile) {
! # Try to get at it in the cpan directory
! $self->debug("no parsefile") if $CPAN::DEBUG;
! Carp::confess "I don't know a $id" unless $self->{CPAN_FILE};
! my $dist = $CPAN::META->instance('CPAN::Distribution',
! $self->{CPAN_FILE});
! $dist->get;
! $self->debug($dist->as_string) if $CPAN::DEBUG;
! my($todir) = $CPAN::Config->{'cpan_home'};
! my(@me,$from,$to,$me);
! @me = split /::/, $self->id;
! $me[-1] .= ".pm";
! $me = MM->catfile(@me);
! $from = $self->find_bundle_file($dist->{'build_dir'},$me);
! $to = MM->catfile($todir,$me);
! File::Path::mkpath(File::Basename::dirname($to));
! File::Copy::copy($from, $to)
! or Carp::confess("Couldn't copy $from to $to: $!");
! $parsefile = $to;
! }
! my @result;
! my $fh = FileHandle->new;
! local $/ = "\n";
! open($fh,$parsefile) or die "Could not open '$parsefile': $!";
! my $inpod = 0;
! $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
! while (<$fh>) {
! $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 :
! /^=head1\s+CONTENTS/ ? 1 : $inpod;
! next unless $inpod;
! next if /^=/;
! next if /^\s+$/;
! chomp;
! push @result, (split " ", $_, 2)[0];
! }
! close $fh;
! delete $self->{STATUS};
! $self->{CONTAINS} = join ", ", @result;
! $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
! @result;
}
#-> sub CPAN::Bundle::find_bundle_file
sub find_bundle_file {
my($self,$where,$what) = @_;
$self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
! my $bu = MM->catfile($where,$what);
! return $bu if -f $bu;
my $manifest = MM->catfile($where,"MANIFEST");
unless (-f $manifest) {
require ExtUtils::Manifest;
--- 3629,3695 ----
#-> sub CPAN::Bundle::contains ;
sub contains {
! my($self) = @_;
! my($parsefile) = $self->inst_file;
! my($id) = $self->id;
! $self->debug("parsefile[$parsefile]id[$id]") if $CPAN::DEBUG;
! unless ($parsefile) {
! # Try to get at it in the cpan directory
! $self->debug("no parsefile") if $CPAN::DEBUG;
! Carp::confess "I don't know a $id" unless $self->{CPAN_FILE};
! my $dist = $CPAN::META->instance('CPAN::Distribution',
! $self->{CPAN_FILE});
! $dist->get;
! $self->debug($dist->as_string) if $CPAN::DEBUG;
! my($todir) = $CPAN::Config->{'cpan_home'};
! my(@me,$from,$to,$me);
! @me = split /::/, $self->id;
! $me[-1] .= ".pm";
! $me = MM->catfile(@me);
! $from = $self->find_bundle_file($dist->{'build_dir'},$me);
! $to = MM->catfile($todir,$me);
! File::Path::mkpath(File::Basename::dirname($to));
! File::Copy::copy($from, $to)
! or Carp::confess("Couldn't copy $from to $to: $!");
! $parsefile = $to;
! }
! my @result;
! my $fh = FileHandle->new;
! local $/ = "\n";
! open($fh,$parsefile) or die "Could not open '$parsefile': $!";
! my $inpod = 0;
! $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
! while (<$fh>) {
! $inpod = m/^=(?!head1\s+CONTENTS)/ ? 0 :
! m/^=head1\s+CONTENTS/ ? 1 : $inpod;
! next unless $inpod;
! next if /^=/;
! next if /^\s+$/;
! chomp;
! push @result, (split " ", $_, 2)[0];
! }
! close $fh;
! delete $self->{STATUS};
! $self->{CONTAINS} = join ", ", @result;
! $self->debug("CONTAINS[@result]") if $CPAN::DEBUG;
! unless (@result) {
! $CPAN::Frontend->mywarn(qq{
! The bundle file "$parsefile" may be a broken
! bundlefile. It seems not to contain any bundle definition.
! Please check the file and if it is bogus, please delete it.
! Sorry for the inconvenience.
! });
! }
! @result;
}
#-> sub CPAN::Bundle::find_bundle_file
sub find_bundle_file {
my($self,$where,$what) = @_;
$self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
! ### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
! ### my $bu = MM->catfile($where,$what);
! ### return $bu if -f $bu;
my $manifest = MM->catfile($where,"MANIFEST");
unless (-f $manifest) {
require ExtUtils::Manifest;
***************
*** 3353,3372 ****
my $fh = FileHandle->new($manifest)
or Carp::croak("Couldn't open $manifest: $!");
local($/) = "\n";
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);
! }
}
}
Carp::croak("Couldn't find a Bundle file in $where");
}
--- 3702,3731 ----
my $fh = FileHandle->new($manifest)
or Carp::croak("Couldn't open $manifest: $!");
local($/) = "\n";
+ my $what2 = $what;
+ if ($^O eq 'MacOS') {
+ $what =~ s/^://;
+ $what2 =~ tr|:|/|;
+ $what2 =~ s/:Bundle://;
+ $what2 =~ tr|:|/|;
+ } else {
+ $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); # bad
! last;
}
+ # retry if she managed to
+ # have no Bundle directory
+ $bu = $file if $file =~ m|\Q$what2\E$|;
}
+ $bu =~ tr|/|:| if $^O eq 'MacOS';
+ return MM->catfile($where, $bu) if $bu;
Carp::croak("Couldn't find a Bundle file in $where");
}
***************
*** 3395,3401 ****
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);
for $s ($self->contains) {
my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
$s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
--- 3754,3760 ----
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,%fail);
for $s ($self->contains) {
my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
$s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
***************
*** 3406,3412 ****
});
sleep 3;
}
! $CPAN::META->instance($type,$s)->$meth();
}
}
--- 3765,3790 ----
});
sleep 3;
}
! # 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';
! }
}
}
***************
*** 3429,3435 ****
sub install {
my $self = shift;
$self->rematein('install',@_);
- $CPAN::META->delete('CPAN::Queue',$self->id);
}
#-> sub CPAN::Bundle::clean ;
sub clean { shift->rematein('clean',@_); }
--- 3807,3812 ----
***************
*** 3496,3504 ****
pre-alpha alpha beta released mature standard,;
@stats{qw,? m d u n,} = qw,unknown mailing-list
developer comp.lang.perl.* none,;
! @statl{qw,? p c + o,} = qw,unknown perl C C++ other,;
! @stati{qw,? f r O,} = qw,unknown functions
! references+ties object-oriented,;
$statd{' '} = 'unknown';
$stats{' '} = 'unknown';
$statl{' '} = 'unknown';
--- 3873,3881 ----
pre-alpha alpha beta released mature standard,;
@stats{qw,? m d u n,} = qw,unknown mailing-list
developer comp.lang.perl.* none,;
! @statl{qw,? p c + o h,} = qw,unknown perl C C++ other hybrid,;
! @stati{qw,? f r O h,} = qw,unknown functions
! references+ties object-oriented hybrid,;
$statd{' '} = 'unknown';
$stats{' '} = 'unknown';
$statl{' '} = 'unknown';
***************
*** 3544,3551 ****
my $inpod = 0;
local $/ = "\n";
while (<$fh>) {
! $inpod = /^=(?!head1\s+NAME)/ ? 0 :
! /^=head1\s+NAME/ ? 1 : $inpod;
next unless $inpod;
next if /^=/;
next if /^\s+$/;
--- 3921,3928 ----
my $inpod = 0;
local $/ = "\n";
while (<$fh>) {
! $inpod = m/^=(?!head1\s+NAME)/ ? 0 :
! m/^=head1\s+NAME/ ? 1 : $inpod;
next unless $inpod;
next if /^=/;
next if /^\s+$/;
***************
*** 3586,3592 ****
#-> sub CPAN::Module::cpan_version ;
sub cpan_version {
my $self = shift;
! $self->{'CPAN_VERSION'} = 'undef'
unless defined $self->{'CPAN_VERSION'}; # I believe this is
# always a bug in the
# index and should be
--- 3963,3969 ----
#-> sub CPAN::Module::cpan_version ;
sub cpan_version {
my $self = shift;
! $self->{'CPAN_VERSION'} = 'undef'
unless defined $self->{'CPAN_VERSION'}; # I believe this is
# always a bug in the
# index and should be
***************
*** 3640,3649 ****
sub make { shift->rematein('make') }
#-> sub CPAN::Module::test ;
sub test { shift->rematein('test') }
! #-> sub CPAN::Module::install ;
! sub install {
my($self) = @_;
- my($doit) = 0;
my($latest) = $self->cpan_version;
$latest ||= 0;
my($inst_file) = $self->inst_file;
--- 4017,4025 ----
sub make { shift->rematein('make') }
#-> sub CPAN::Module::test ;
sub test { shift->rematein('test') }
! #-> sub CPAN::Module::uptodate ;
! sub uptodate {
my($self) = @_;
my($latest) = $self->cpan_version;
$latest ||= 0;
my($inst_file) = $self->inst_file;
***************
*** 3651,3672 ****
if (defined $inst_file) {
$have = $self->inst_version;
}
! if (1){ # A block for scoping $^W, the if is just for the visual
! # appeal
! local($^W)=0;
! if ($inst_file
! &&
! $have >= $latest
! &&
! 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') }
--- 4027,4054 ----
if (defined $inst_file) {
$have = $self->inst_version;
}
! local($^W)=0;
! if ($inst_file
! &&
! $have >= $latest
! ) {
! 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;
}
#-> sub CPAN::Module::clean ;
sub clean { shift->rematein('clean') }
***************
*** 3707,3712 ****
--- 4089,4095 ----
my($self) = @_;
my $parsefile = $self->inst_file or return;
local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
+ # warn "HERE";
my $have = MM->parse_version($parsefile) || "undef";
$have =~ s/\s+//g;
$have;
***************
*** 3728,3734 ****
$fhw->close;
return 1;
} else {
! system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
}
}
--- 4111,4117 ----
$fhw->close;
return 1;
} else {
! system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
}
}
***************
*** 3830,3844 ****
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;
} elsif ($CPAN::META->has_inst("Archive::Tar")
&&
$CPAN::META->has_inst("Compress::Zlib") ) {
my $tar = Archive::Tar->new($file,1);
$tar->extract($tar->list_files); # I'm pretty sure we have nothing
# that isn't compressed
return 1;
} else {
$CPAN::Frontend->mydie(qq{
--- 4213,4252 ----
if (MM->maybe_command($CPAN::Config->{'gzip'})
&&
MM->maybe_command($CPAN::Config->{'tar'})) {
! 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") ) {
my $tar = Archive::Tar->new($file,1);
$tar->extract($tar->list_files); # I'm pretty sure we have nothing
# that isn't compressed
+
+ ExtUtils::MM_MacOS::convert_files([$tar->list_files], 1)
+ if ($^O eq 'MacOS');
+
return 1;
} else {
$CPAN::Frontend->mydie(qq{
***************
*** 3893,3899 ****
the make processes and deletes excess space according to a simple FIFO
mechanism.
! All methods provided are accessible in a programmer style and in an
interactive shell style.
=head2 Interactive Mode
--- 4301,4315 ----
the make processes and deletes excess space according to a simple FIFO
mechanism.
! For extended searching capabilities there's a plugin for CPAN available,
! L<CPAN::WAIT>. C<CPAN::WAIT> is a full-text search engine that indexes
! all documents available in CPAN authors directories. If C<CPAN::WAIT>
! is installed on your system, the interactive shell of <CPAN.pm> will
! enable the C<wq>, C<wr>, C<wd>, C<wl>, and C<wh> commands which send
! queries to the WAIT server that has been configured for your
! installation.
!
! All other methods provided are accessible in a programmer style and in an
interactive shell style.
=head2 Interactive Mode
***************
*** 3949,3959 ****
=item make, test, install, clean modules or distributions
! These commands take any number of arguments and investigate what is
necessary to perform the action. If the argument is a distribution
! file name (recognized by embedded slashes), it is processed. If it is a
! module, CPAN determines the distribution file in which this module is
! included and processes that.
Any C<make> or C<test> are run unconditionally. An
--- 4365,4377 ----
=item make, test, install, clean modules or distributions
! These commands take any number of arguments and investigates what is
necessary to perform the action. If the argument is a distribution
! file name (recognized by embedded slashes), it is processed. If it is
! a module, CPAN determines the distribution file in which this module
! is included and processes that, following any dependencies named in
! the module's Makefile.PL (this behavior is controlled by
! I<prerequisites_policy>.)
Any C<make> or C<test> are run unconditionally. An
***************
*** 3983,3989 ****
OpenGL-0.4/COPYRIGHT
[...]
! A C<clean> command results in a
make clean
--- 4401,4407 ----
OpenGL-0.4/COPYRIGHT
[...]
! A C<clean> command results in a
make clean
***************
*** 4133,4139 ****
=back
! =head2 Methods in the four
=head2 Cache Manager
--- 4551,4557 ----
=back
! =head2 Methods in the four Classes
=head2 Cache Manager
***************
*** 4212,4218 ****
version use something like this
perl -MExtUtils::MakeMaker -le \
! 'print MM->parse_version($ARGV[0])' filename
If you are author of a package and wonder if your $VERSION can be
parsed, please try the above method.
--- 4630,4636 ----
version use something like this
perl -MExtUtils::MakeMaker -le \
! 'print MM->parse_version(shift)' filename
If you are author of a package and wonder if your $VERSION can be
parsed, please try the above method.
***************
*** 4239,4245 ****
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
CPAN.pm works nicely without network too. If you maintain machines
that are not networked at all, you should consider working with file:
--- 4657,4663 ----
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, 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:
***************
*** 4278,4287 ****
--- 4696,4712 ----
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)
+ prerequisites_policy
+ what to do if you are missing module prerequisites
+ ('follow' automatically, 'ask' me, or 'ignore')
+ 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:
***************
*** 4311,4317 ****
=back
! =head2 CD-ROM support
The C<urllist> parameter of the configuration table contains a list of
URLs that are to be used for downloading. If the list contains any
--- 4736,4742 ----
=back
! =head2 urllist parameter has CD-ROM support
The C<urllist> parameter of the configuration table contains a list of
URLs that are to be used for downloading. If the list contains any
***************
*** 4326,4331 ****
--- 4751,4764 ----
that come at the beginning of urllist. It will later check for each
module if there is a local copy of the most recent version.
+ Another peculiarity of urllist is that the site that we could
+ successfully fetch the last file from automatically gets a preference
+ token and is tried as the first site for the next request. So if you
+ add a new site at runtime it may happen that the previously preferred
+ site will be tried another time. This means that if you want to disallow
+ a site for the next transfer, it must be explicitly removed from
+ urllist.
+
=head1 SECURITY
There's no strong security layer in CPAN.pm. CPAN.pm helps you to
***************
*** 4333,4339 ****
to a checksum that comes from the net just as the distribution file
itself. If somebody has managed to tamper with the distribution file,
they may have as well tampered with the CHECKSUMS file. Future
! development will go towards strong authentification.
=head1 EXPORT
--- 4766,4772 ----
to a checksum that comes from the net just as the distribution file
itself. If somebody has managed to tamper with the distribution file,
they may have as well tampered with the CHECKSUMS file. Future
! development will go towards strong authentication.
=head1 EXPORT
***************
*** 4341,4346 ****
--- 4774,4863 ----
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 themselve 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
***************
*** 4358,4364 ****
=head1 AUTHOR
! Andreas K�nig E<lt>a.koenig@mind.deE<gt>
=head1 SEE ALSO
--- 4875,4881 ----
=head1 AUTHOR
! Andreas K�nig E<lt>a.koenig@kulturbox.deE<gt>
=head1 SEE ALSO
diff -c 'perl5.005_02/lib/CPAN/FirstTime.pm' 'perl5.005_03/lib/CPAN/FirstTime.pm'
Index: ./lib/CPAN/FirstTime.pm
*** ./lib/CPAN/FirstTime.pm Thu Jul 23 23:00:33 1998
--- ./lib/CPAN/FirstTime.pm Sun Mar 28 14:26:41 1999
***************
*** 16,22 ****
use File::Basename ();
use File::Path ();
use vars qw($VERSION);
! $VERSION = substr q$Revision: 1.29 $, 10;
=head1 NAME
--- 16,22 ----
use File::Basename ();
use File::Path ();
use vars qw($VERSION);
! $VERSION = substr q$Revision: 1.36 $, 10;
=head1 NAME
***************
*** 37,43 ****
sub init {
my($configpm) = @_;
use Config;
! require CPAN::Nox;
eval {require CPAN::Config;};
$CPAN::Config ||= {};
local($/) = "\n";
--- 37,45 ----
sub init {
my($configpm) = @_;
use Config;
! unless ($CPAN::VERSION) {
! require CPAN::Nox;
! }
eval {require CPAN::Config;};
$CPAN::Config ||= {};
local($/) = "\n";
***************
*** 45,56 ****
local($|) = 1;
my($ans,$default,$local,$cont,$url,$expected_size);
!
#
# Files, directories
#
! print qq{
CPAN is the world-wide archive of perl resources. It consists of about
100 sites that all replicate the same contents all around the globe.
--- 47,58 ----
local($|) = 1;
my($ans,$default,$local,$cont,$url,$expected_size);
!
#
# Files, directories
#
! print qq[
CPAN is the world-wide archive of perl resources. It consists of about
100 sites that all replicate the same contents all around the globe.
***************
*** 62,68 ****
question and I\'ll try to autoconfigure. (Note: you can revisit this
dialog anytime later by typing 'o conf init' at the cpan prompt.)
! };
my $manual_conf =
ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
--- 64,70 ----
question and I\'ll try to autoconfigure. (Note: you can revisit this
dialog anytime later by typing 'o conf init' at the cpan prompt.)
! ];
my $manual_conf =
ExtUtils::MakeMaker::prompt("Are you ready for manual configuration?",
***************
*** 111,126 ****
$default = $cpan_home;
while ($ans = prompt("CPAN build and cache directory?",$default)) {
! File::Path::mkpath($ans); # dies if it can't
! if (-d $ans && -w _) {
! last;
! } else {
! warn "Couldn't find directory $ans
or directory is not writable. Please retry.\n";
! }
}
$CPAN::Config->{cpan_home} = $ans;
!
print qq{
If you want, I can keep the source files after a build in the cpan
--- 113,133 ----
$default = $cpan_home;
while ($ans = prompt("CPAN build and cache directory?",$default)) {
! eval { File::Path::mkpath($ans); }; # dies if it can't
! if ($@) {
! warn "Couldn't create directory $ans.
! Please retry.\n";
! next;
! }
! if (-d $ans && -w _) {
! last;
! } else {
! warn "Couldn't find directory $ans
or directory is not writable. Please retry.\n";
! }
}
$CPAN::Config->{cpan_home} = $ans;
!
print qq{
If you want, I can keep the source files after a build in the cpan
***************
*** 151,156 ****
--- 158,199 ----
# 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("Policy on building prerequisites (follow, ask or ignore)?",
+ $default);
+ } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
+ $CPAN::Config->{prerequisites_policy} = $ans;
+
#
# External programs
#
***************
*** 164,199 ****
};
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
my $progname;
! for $progname (qw/gzip tar unzip make lynx ncftp ftp/){
my $progcall = $progname;
! my $path = $CPAN::Config->{$progname}
! || $Config::Config{$progname}
! || "";
! if (MM->file_name_is_absolute($path)) {
! # testing existence is not good enough, some have these exe
! # extensions
!
! # warn "Warning: configured $path does not exist\n" unless -e $path;
! # $path = "";
! } else {
! $path = '';
! }
! unless ($path) {
! # e.g. make -> nmake
! $progcall = $Config::Config{$progname} if $Config::Config{$progname};
! }
! $path ||= find_exe($progcall,[@path]);
! warn "Warning: $progcall not found in PATH\n" unless
! $path; # not -e $path, because find_exe already checked that
! $ans = prompt("Where is your $progname program?",$path) || $path;
! $CPAN::Config->{$progname} = $ans;
}
my $path = $CPAN::Config->{'pager'} ||
$ENV{PAGER} || find_exe("less",[@path]) ||
! find_exe("more",[@path]) || "more";
$ans = prompt("What is your favorite pager program?",$path);
$CPAN::Config->{'pager'} = $ans;
$path = $CPAN::Config->{'shell'};
--- 207,252 ----
};
+ my $old_warn = $^W;
+ local $^W if $^O eq 'MacOS';
my(@path) = split /$Config{'path_sep'}/, $ENV{'PATH'};
+ local $^W = $old_warn;
my $progname;
! for $progname (qw/gzip tar unzip make lynx ncftpget ncftp ftp/){
! if ($^O eq 'MacOS') {
! $CPAN::Config->{$progname} = 'not_here';
! next;
! }
my $progcall = $progname;
! # we don't need ncftp if we have ncftpget
! next if $progname eq "ncftp" && $CPAN::Config->{ncftpget} gt " ";
! my $path = $CPAN::Config->{$progname}
! || $Config::Config{$progname}
! || "";
! if (MM->file_name_is_absolute($path)) {
! # testing existence is not good enough, some have these exe
! # extensions
! # warn "Warning: configured $path does not exist\n" unless -e $path;
! # $path = "";
! } else {
! $path = '';
! }
! unless ($path) {
! # e.g. make -> nmake
! $progcall = $Config::Config{$progname} if $Config::Config{$progname};
! }
!
! $path ||= find_exe($progcall,[@path]);
! warn "Warning: $progcall not found in PATH\n" unless
! $path; # not -e $path, because find_exe already checked that
! $ans = prompt("Where is your $progname program?",$path) || $path;
! $CPAN::Config->{$progname} = $ans;
}
my $path = $CPAN::Config->{'pager'} ||
$ENV{PAGER} || find_exe("less",[@path]) ||
! find_exe("more",[@path]) || ($^O eq 'MacOS' ? $ENV{EDITOR} : 0 )
! || "more";
$ans = prompt("What is your favorite pager program?",$path);
$CPAN::Config->{'pager'} = $ans;
$path = $CPAN::Config->{'shell'};
***************
*** 202,210 ****
$path = "";
}
$path ||= $ENV{SHELL};
! $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
! $ans = prompt("What is your favorite shell?",$path);
! $CPAN::Config->{'shell'} = $ans;
#
# Arguments to make etc.
--- 255,267 ----
$path = "";
}
$path ||= $ENV{SHELL};
! if ($^O eq 'MacOS') {
! $CPAN::Config->{'shell'} = 'not_here';
! } else {
! $path =~ s,\\,/,g if $^O eq 'os2'; # Cosmetic only
! $ans = prompt("What is your favorite shell?",$path);
! $CPAN::Config->{'shell'} = $ans;
! }
#
# Arguments to make etc.
***************
*** 327,337 ****
--- 384,421 ----
}
}
+ 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);
my $fh = FileHandle->new;
$fh->open($local) or die "Couldn't open $local: $!";
+ local $/ = "\012";
while (<$fh>) {
($host) = /^([\w\.\-]+)/ unless defined $host;
next unless defined $host;
***************
*** 339,344 ****
--- 423,429 ----
/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);
***************
*** 347,439 ****
}
$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);
! }
$CPAN::Config->{urllist} = [];
- } else {
- $expected_size = 6;
}
!
print qq{
! 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.
!
! };
!
! $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";
! }
}
1;
--- 432,528 ----
}
$fh->close;
$CPAN::Config->{urllist} ||= [];
! my(@previous_urls);
! if (@previous_urls = @{$CPAN::Config->{urllist}}) {
$CPAN::Config->{urllist} = [];
}
!
print qq{
! 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.
! 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.
!
! };
!
! 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 -c 'perl5.005_02/lib/CPAN/Nox.pm' 'perl5.005_03/lib/CPAN/Nox.pm'
Index: ./lib/CPAN/Nox.pm
*** ./lib/CPAN/Nox.pm Thu Jul 23 23:00:33 1998
--- ./lib/CPAN/Nox.pm Sun Mar 28 14:26:41 1999
***************
*** 1,7 ****
--- 1,10 ----
+ package CPAN::Nox;
+
BEGIN{$CPAN::Suppress_readline=1 unless defined $CPAN::term;}
use CPAN;
+ $VERSION = "1.00";
$CPAN::META->has_inst('MD5','no');
$CPAN::META->has_inst('LWP','no');
$CPAN::META->has_inst('Compress::Zlib','no');
diff -c 'perl5.005_02/lib/Carp.pm' 'perl5.005_03/lib/Carp.pm'
Index: ./lib/Carp.pm
*** ./lib/Carp.pm Thu Jul 23 23:00:33 1998
--- ./lib/Carp.pm Thu Mar 4 18:34:17 1999
***************
*** 35,41 ****
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
'verbose'. You would typically enable it by saying
perl -MCarp=verbose script.pl
--- 35,41 ----
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-existent symbol
'verbose'. You would typically enable it by saying
perl -MCarp=verbose script.pl
***************
*** 43,48 ****
--- 43,54 ----
or by including the string C<MCarp=verbose> in the L<PERL5OPT>
environment variable.
+ =head1 BUGS
+
+ The Carp routines don't handle exception objects currently.
+ If called with a first argument that is a reference, they simply
+ call die() or warn(), as appropriate.
+
=cut
# This package is heavily used. Be small. Be fast. Be good.
***************
*** 88,93 ****
--- 94,100 ----
# each function call on the stack.
sub longmess {
+ return @_ if ref $_[0];
my $error = join '', @_;
my $mess = "";
my $i = 1 + $CarpLevel;
***************
*** 190,195 ****
--- 197,203 ----
sub shortmess { # Short-circuit &longmess if called via multiple packages
goto &longmess if $Verbose;
+ return @_ if ref $_[0];
my $error = join '', @_;
my ($prevpack) = caller(1);
my $extra = $CarpLevel;
diff -c 'perl5.005_02/lib/Cwd.pm' 'perl5.005_03/lib/Cwd.pm'
Index: ./lib/Cwd.pm
*** ./lib/Cwd.pm Thu Jul 23 23:00:33 1998
--- ./lib/Cwd.pm Thu Jan 21 19:03:55 1999
***************
*** 32,38 ****
in Perl.
The abs_path() function takes a single argument and returns the
! absolute pathname for that argument. It uses the same algoritm as
getcwd(). (actually getcwd() is abs_path("."))
The fastcwd() function looks the same as getcwd(), but runs faster.
--- 32,38 ----
in Perl.
The abs_path() function takes a single argument and returns the
! absolute pathname for that argument. It uses the same algorithm as
getcwd(). (actually getcwd() is abs_path("."))
The fastcwd() function looks the same as getcwd(), but runs faster.
***************
*** 269,275 ****
# --- PORTING SECTION ---
# VMS: $ENV{'DEFAULT'} points to default directory at all times
! # 06-Mar-1996 Charles Bailey bailey@genetics.upenn.edu
# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
# in the process logical name table as the default device and directory
# seen by Perl. This may not be the same as the default device
--- 269,275 ----
# --- PORTING SECTION ---
# VMS: $ENV{'DEFAULT'} points to default directory at all times
! # 06-Mar-1996 Charles Bailey bailey@newman.upenn.edu
# Note: Use of Cwd::chdir() causes the logical name PWD to be defined
# in the process logical name table as the default device and directory
# seen by Perl. This may not be the same as the default device
diff -c /dev/null 'perl5.005_03/lib/Dumpvalue.pm'
Index: lib/Dumpvalue.pm
*** lib/Dumpvalue.pm Wed Dec 31 18:00:00 1969
--- lib/Dumpvalue.pm Sat Jan 16 13:16:50 1999
***************
*** 0 ****
--- 1,600 ----
+ require 5.005; # For (defined ref) and $#$v
+ package Dumpvalue;
+ use strict;
+ use vars qw(%address *stab %subs);
+
+ # translate control chars to ^X - Randal Schwartz
+ # Modifications to print types by Peter Gordon v1.0
+
+ # Ilya Zakharevich -- patches after 5.001 (and some before ;-)
+
+ # Won't dump symbol tables and contents of debugged files by default
+
+ # (IZ) changes for objectification:
+ # c) quote() renamed to method set_quote();
+ # d) unctrlSet() renamed to method set_unctrl();
+ # f) Compiles with `use strict', but in two places no strict refs is needed:
+ # maybe more problems are waiting...
+
+ my %defaults = (
+ globPrint => 0,
+ printUndef => 1,
+ tick => "auto",
+ unctrl => 'quote',
+ subdump => 1,
+ dumpReused => 0,
+ bareStringify => 1,
+ hashDepth => '',
+ arrayDepth => '',
+ dumpDBFiles => '',
+ dumpPackages => '',
+ quoteHighBit => '',
+ usageOnly => '',
+ compactDump => '',
+ veryCompact => '',
+ stopDbSignal => '',
+ );
+
+ sub new {
+ my $class = shift;
+ my %opt = (%defaults, @_);
+ bless \%opt, $class;
+ }
+
+ sub set {
+ my $self = shift;
+ my %opt = @_;
+ @$self{keys %opt} = values %opt;
+ }
+
+ sub get {
+ my $self = shift;
+ wantarray ? @$self{@_} : $$self{pop @_};
+ }
+
+ sub dumpValue {
+ my $self = shift;
+ die "usage: \$dumper->dumpValue(value)" unless @_ == 1;
+ local %address;
+ local $^W=0;
+ (print "undef\n"), return unless defined $_[0];
+ (print $self->stringify($_[0]), "\n"), return unless ref $_[0];
+ $self->unwrap($_[0],0);
+ }
+
+ sub dumpValues {
+ my $self = shift;
+ local %address;
+ local $^W=0;
+ (print "undef\n"), return unless defined $_[0];
+ $self->unwrap(\@_,0);
+ }
+
+ # This one is good for variable names:
+
+ sub unctrl {
+ local($_) = @_;
+
+ return \$_ if ref \$_ eq "GLOB";
+ s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+ $_;
+ }
+
+ sub stringify {
+ my $self = shift;
+ local $_ = shift;
+ my $noticks = shift;
+ my $tick = $self->{tick};
+
+ return 'undef' unless defined $_ or not $self->{printUndef};
+ return $_ . "" if ref \$_ eq 'GLOB';
+ { no strict 'refs';
+ $_ = &{'overload::StrVal'}($_)
+ if $self->{bareStringify} and ref $_
+ and defined %overload:: and defined &{'overload::StrVal'};
+ }
+
+ if ($tick eq 'auto') {
+ if (/[\000-\011\013-\037\177]/) {
+ $tick = '"';
+ } else {
+ $tick = "'";
+ }
+ }
+ if ($tick eq "'") {
+ s/([\'\\])/\\$1/g;
+ } elsif ($self->{unctrl} eq 'unctrl') {
+ s/([\"\\])/\\$1/g ;
+ s/([\000-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+ s/([\200-\377])/'\\0x'.sprintf('%2X',ord($1))/eg
+ if $self->{quoteHighBit};
+ } elsif ($self->{unctrl} eq 'quote') {
+ s/([\"\\\$\@])/\\$1/g if $tick eq '"';
+ s/\033/\\e/g;
+ s/([\000-\037\177])/'\\c'.chr(ord($1)^64)/eg;
+ }
+ s/([\200-\377])/'\\'.sprintf('%3o',ord($1))/eg if $self->{quoteHighBit};
+ ($noticks || /^\d+(\.\d*)?\Z/)
+ ? $_
+ : $tick . $_ . $tick;
+ }
+
+ sub DumpElem {
+ my ($self, $v) = (shift, shift);
+ my $short = $self->stringify($v, ref $v);
+ my $shortmore = '';
+ if ($self->{veryCompact} && ref $v
+ && (ref $v eq 'ARRAY' and !grep(ref $_, @$v) )) {
+ my $depth = $#$v;
+ ($shortmore, $depth) = (' ...', $self->{arrayDepth} - 1)
+ if $self->{arrayDepth} and $depth >= $self->{arrayDepth};
+ my @a = map $self->stringify($_), @$v[0..$depth];
+ print "0..$#{$v} @a$shortmore\n";
+ } elsif ($self->{veryCompact} && ref $v
+ && (ref $v eq 'HASH') and !grep(ref $_, values %$v)) {
+ my @a = sort keys %$v;
+ my $depth = $#a;
+ ($shortmore, $depth) = (' ...', $self->{hashDepth} - 1)
+ if $self->{hashDepth} and $depth >= $self->{hashDepth};
+ my @b = map {$self->stringify($_) . " => " . $self->stringify($$v{$_})}
+ @a[0..$depth];
+ local $" = ', ';
+ print "@b$shortmore\n";
+ } else {
+ print "$short\n";
+ $self->unwrap($v,shift);
+ }
+ }
+
+ sub unwrap {
+ my $self = shift;
+ return if $DB::signal and $self->{stopDbSignal};
+ my ($v) = shift ;
+ my ($s) = shift ; # extra no of spaces
+ my $sp;
+ my (%v,@v,$address,$short,$fileno);
+
+ $sp = " " x $s ;
+ $s += 3 ;
+
+ # Check for reused addresses
+ if (ref $v) {
+ my $val = $v;
+ { no strict 'refs';
+ $val = &{'overload::StrVal'}($v)
+ if defined %overload:: and defined &{'overload::StrVal'};
+ }
+ ($address) = $val =~ /(0x[0-9a-f]+)\)$/ ;
+ if (!$self->{dumpReused} && defined $address) {
+ $address{$address}++ ;
+ if ( $address{$address} > 1 ) {
+ print "${sp}-> REUSED_ADDRESS\n" ;
+ return ;
+ }
+ }
+ } elsif (ref \$v eq 'GLOB') {
+ $address = "$v" . ""; # To avoid a bug with globs
+ $address{$address}++ ;
+ if ( $address{$address} > 1 ) {
+ print "${sp}*DUMPED_GLOB*\n" ;
+ return ;
+ }
+ }
+
+ if ( UNIVERSAL::isa($v, 'HASH') ) {
+ my @sortKeys = sort keys(%$v) ;
+ my $more;
+ my $tHashDepth = $#sortKeys ;
+ $tHashDepth = $#sortKeys < $self->{hashDepth}-1 ? $#sortKeys : $self->{hashDepth}-1
+ unless $self->{hashDepth} eq '' ;
+ $more = "....\n" if $tHashDepth < $#sortKeys ;
+ my $shortmore = "";
+ $shortmore = ", ..." if $tHashDepth < $#sortKeys ;
+ $#sortKeys = $tHashDepth ;
+ if ($self->{compactDump} && !grep(ref $_, values %{$v})) {
+ $short = $sp;
+ my @keys;
+ for (@sortKeys) {
+ push @keys, $self->stringify($_) . " => " . $self->stringify($v->{$_});
+ }
+ $short .= join ', ', @keys;
+ $short .= $shortmore;
+ (print "$short\n"), return if length $short <= $self->{compactDump};
+ }
+ for my $key (@sortKeys) {
+ return if $DB::signal and $self->{stopDbSignal};
+ my $value = $ {$v}{$key} ;
+ print $sp, $self->stringify($key), " => ";
+ $self->DumpElem($value, $s);
+ }
+ print "$sp empty hash\n" unless @sortKeys;
+ print "$sp$more" if defined $more ;
+ } elsif ( UNIVERSAL::isa($v, 'ARRAY') ) {
+ my $tArrayDepth = $#{$v} ;
+ my $more ;
+ $tArrayDepth = $#$v < $self->{arrayDepth}-1 ? $#$v : $self->{arrayDepth}-1
+ unless $self->{arrayDepth} eq '' ;
+ $more = "....\n" if $tArrayDepth < $#{$v} ;
+ my $shortmore = "";
+ $shortmore = " ..." if $tArrayDepth < $#{$v} ;
+ if ($self->{compactDump} && !grep(ref $_, @{$v})) {
+ if ($#$v >= 0) {
+ $short = $sp . "0..$#{$v} " .
+ join(" ",
+ map {$self->stringify($_)} @{$v}[0..$tArrayDepth])
+ . "$shortmore";
+ } else {
+ $short = $sp . "empty array";
+ }
+ (print "$short\n"), return if length $short <= $self->{compactDump};
+ }
+ for my $num ($[ .. $tArrayDepth) {
+ return if $DB::signal and $self->{stopDbSignal};
+ print "$sp$num ";
+ $self->DumpElem($v->[$num], $s);
+ }
+ print "$sp empty array\n" unless @$v;
+ print "$sp$more" if defined $more ;
+ } elsif ( UNIVERSAL::isa($v, 'SCALAR') or ref $v eq 'REF' ) {
+ print "$sp-> ";
+ $self->DumpElem($$v, $s);
+ } elsif ( UNIVERSAL::isa($v, 'CODE') ) {
+ print "$sp-> ";
+ $self->dumpsub(0, $v);
+ } elsif ( UNIVERSAL::isa($v, 'GLOB') ) {
+ print "$sp-> ",$self->stringify($$v,1),"\n";
+ if ($self->{globPrint}) {
+ $s += 3;
+ $self->dumpglob('', $s, "{$$v}", $$v, 1);
+ } elsif (defined ($fileno = fileno($v))) {
+ print( (' ' x ($s+3)) . "FileHandle({$$v}) => fileno($fileno)\n" );
+ }
+ } elsif (ref \$v eq 'GLOB') {
+ if ($self->{globPrint}) {
+ $self->dumpglob('', $s, "{$v}", $v, 1);
+ } elsif (defined ($fileno = fileno(\$v))) {
+ print( (' ' x $s) . "FileHandle({$v}) => fileno($fileno)\n" );
+ }
+ }
+ }
+
+ sub matchvar {
+ $_[0] eq $_[1] or
+ ($_[1] =~ /^([!~])(.)([\x00-\xff]*)/) and
+ ($1 eq '!') ^ (eval {($_[2] . "::" . $_[0]) =~ /$2$3/});
+ }
+
+ sub compactDump {
+ my $self = shift;
+ $self->{compactDump} = shift if @_;
+ $self->{compactDump} = 6*80-1
+ if $self->{compactDump} and $self->{compactDump} < 2;
+ $self->{compactDump};
+ }
+
+ sub veryCompact {
+ my $self = shift;
+ $self->{veryCompact} = shift if @_;
+ $self->compactDump(1) if !$self->{compactDump} and $self->{veryCompact};
+ $self->{veryCompact};
+ }
+
+ sub set_unctrl {
+ my $self = shift;
+ if (@_) {
+ my $in = shift;
+ if ($in eq 'unctrl' or $in eq 'quote') {
+ $self->{unctrl} = $in;
+ } else {
+ print "Unknown value for `unctrl'.\n";
+ }
+ }
+ $self->{unctrl};
+ }
+
+ sub set_quote {
+ my $self = shift;
+ if (@_ and $_[0] eq '"') {
+ $self->{tick} = '"';
+ $self->{unctrl} = 'quote';
+ } elsif (@_ and $_[0] eq 'auto') {
+ $self->{tick} = 'auto';
+ $self->{unctrl} = 'quote';
+ } elsif (@_) { # Need to set
+ $self->{tick} = "'";
+ $self->{unctrl} = 'unctrl';
+ }
+ $self->{tick};
+ }
+
+ sub dumpglob {
+ my $self = shift;
+ return if $DB::signal and $self->{stopDbSignal};
+ my ($package, $off, $key, $val, $all) = @_;
+ local(*stab) = $val;
+ my $fileno;
+ if (($key !~ /^_</ or $self->{dumpDBFiles}) and defined $stab) {
+ print( (' ' x $off) . "\$", &unctrl($key), " = " );
+ $self->DumpElem($stab, 3+$off);
+ }
+ if (($key !~ /^_</ or $self->{dumpDBFiles}) and defined @stab) {
+ print( (' ' x $off) . "\@$key = (\n" );
+ $self->unwrap(\@stab,3+$off) ;
+ print( (' ' x $off) . ")\n" );
+ }
+ if ($key ne "main::" && $key ne "DB::" && defined %stab
+ && ($self->{dumpPackages} or $key !~ /::$/)
+ && ($key !~ /^_</ or $self->{dumpDBFiles})
+ && !($package eq "Dumpvalue" and $key eq "stab")) {
+ print( (' ' x $off) . "\%$key = (\n" );
+ $self->unwrap(\%stab,3+$off) ;
+ print( (' ' x $off) . ")\n" );
+ }
+ if (defined ($fileno = fileno(*stab))) {
+ print( (' ' x $off) . "FileHandle($key) => fileno($fileno)\n" );
+ }
+ if ($all) {
+ if (defined &stab) {
+ $self->dumpsub($off, $key);
+ }
+ }
+ }
+
+ sub dumpsub {
+ my $self = shift;
+ my ($off,$sub) = @_;
+ $sub = $1 if $sub =~ /^\{\*(.*)\}$/;
+ my $subref = \&$sub;
+ my $place = $DB::sub{$sub} || (($sub = $subs{"$subref"}) && $DB::sub{$sub})
+ || ($self->{subdump} && ($sub = $self->findsubs("$subref"))
+ && $DB::sub{$sub});
+ $place = '???' unless defined $place;
+ print( (' ' x $off) . "&$sub in $place\n" );
+ }
+
+ sub findsubs {
+ my $self = shift;
+ return undef unless defined %DB::sub;
+ my ($addr, $name, $loc);
+ while (($name, $loc) = each %DB::sub) {
+ $addr = \&$name;
+ $subs{"$addr"} = $name;
+ }
+ $self->{subdump} = 0;
+ $subs{ shift() };
+ }
+
+ sub dumpvars {
+ my $self = shift;
+ my ($package,@vars) = @_;
+ local(%address,$^W);
+ my ($key,$val);
+ $package .= "::" unless $package =~ /::$/;
+ *stab = *main::;
+
+ while ($package =~ /(\w+?::)/g) {
+ *stab = $ {stab}{$1};
+ }
+ $self->{TotalStrings} = 0;
+ $self->{Strings} = 0;
+ $self->{CompleteTotal} = 0;
+ while (($key,$val) = each(%stab)) {
+ return if $DB::signal and $self->{stopDbSignal};
+ next if @vars && !grep( matchvar($key, $_), @vars );
+ if ($self->{usageOnly}) {
+ $self->globUsage(\$val, $key)
+ unless $package eq 'Dumpvalue' and $key eq 'stab';
+ } else {
+ $self->dumpglob($package, 0,$key, $val);
+ }
+ }
+ if ($self->{usageOnly}) {
+ print <<EOP;
+ String space: $self->{TotalStrings} bytes in $self->{Strings} strings.
+ EOP
+ $self->{CompleteTotal} += $self->{TotalStrings};
+ print <<EOP;
+ Grand total = $self->{CompleteTotal} bytes (1 level deep) + overhead.
+ EOP
+ }
+ }
+
+ sub scalarUsage {
+ my $self = shift;
+ my $size = length($_[0]);
+ $self->{TotalStrings} += $size;
+ $self->{Strings}++;
+ $size;
+ }
+
+ sub arrayUsage { # array ref, name
+ my $self = shift;
+ my $size = 0;
+ map {$size += $self->scalarUsage($_)} @{$_[0]};
+ my $len = @{$_[0]};
+ print "\@$_[1] = $len item", ($len > 1 ? "s" : ""), " (data: $size bytes)\n"
+ if defined $_[1];
+ $self->{CompleteTotal} += $size;
+ $size;
+ }
+
+ sub hashUsage { # hash ref, name
+ my $self = shift;
+ my @keys = keys %{$_[0]};
+ my @values = values %{$_[0]};
+ my $keys = $self->arrayUsage(\@keys);
+ my $values = $self->arrayUsage(\@values);
+ my $len = @keys;
+ my $total = $keys + $values;
+ print "\%$_[1] = $len item", ($len > 1 ? "s" : ""),
+ " (keys: $keys; values: $values; total: $total bytes)\n"
+ if defined $_[1];
+ $total;
+ }
+
+ sub globUsage { # glob ref, name
+ my $self = shift;
+ local *stab = *{$_[0]};
+ my $total = 0;
+ $total += $self->scalarUsage($stab) if defined $stab;
+ $total += $self->arrayUsage(\@stab, $_[1]) if defined @stab;
+ $total += $self->hashUsage(\%stab, $_[1])
+ if defined %stab and $_[1] ne "main::" and $_[1] ne "DB::";
+ #and !($package eq "Dumpvalue" and $key eq "stab"));
+ $total;
+ }
+
+ 1;
+
+ =head1 NAME
+
+ Dumpvalue - provides screen dump of Perl data.
+
+ =head1 SYNOPSYS
+
+ use Dumpvalue;
+ my $dumper = new Dumpvalue;
+ $dumper->set(globPrint => 1);
+ $dumper->dumpValue(\*::);
+ $dumper->dumpvars('main');
+
+ =head1 DESCRIPTION
+
+ =head2 Creation
+
+ A new dumper is created by a call
+
+ $d = new Dumpvalue(option1 => value1, option2 => value2)
+
+ Recognized options:
+
+ =over
+
+ =item C<arrayDepth>, C<hashDepth>
+
+ Print only first N elements of arrays and hashes. If false, prints all the
+ elements.
+
+ =item C<compactDump>, C<veryCompact>
+
+ Change style of array and hash dump. If true, short array
+ may be printed on one line.
+
+ =item C<globPrint>
+
+ Whether to print contents of globs.
+
+ =item C<DumpDBFiles>
+
+ Dump arrays holding contents of debugged files.
+
+ =item C<DumpPackages>
+
+ Dump symbol tables of packages.
+
+ =item C<DumpReused>
+
+ Dump contents of "reused" addresses.
+
+ =item C<tick>, C<HighBit>, C<printUndef>
+
+ Change style of string dump. Default value of C<tick> is C<auto>, one
+ can enable either double-quotish dump, or single-quotish by setting it
+ to C<"> or C<'>. By default, characters with high bit set are printed
+ I<as is>.
+
+ =item C<UsageOnly>
+
+ I<very> rudimentally per-package memory usage dump. If set,
+ C<dumpvars> calculates total size of strings in variables in the package.
+
+ =item unctrl
+
+ Changes the style of printout of strings. Possible values are
+ C<unctrl> and C<quote>.
+
+ =item subdump
+
+ Whether to try to find the subroutine name given the reference.
+
+ =item bareStringify
+
+ Whether to write the non-overloaded form of the stringify-overloaded objects.
+
+ =item quoteHighBit
+
+ Whether to print chars with high bit set in binary or "as is".
+
+ =item stopDbSignal
+
+ Whether to abort printing if debugger signal flag is raised.
+
+ =back
+
+ Later in the life of the object the methods may be queries with get()
+ method and set() method (which accept multiple arguments).
+
+ =head2 Methods
+
+ =over
+
+ =item dumpValue
+
+ $dumper->dumpValue($value);
+ $dumper->dumpValue([$value1, $value2]);
+
+ =item dumpValues
+
+ $dumper->dumpValues($value1, $value2);
+
+ =item dumpvars
+
+ $dumper->dumpvars('my_package');
+ $dumper->dumpvars('my_package', 'foo', '~bar$', '!......');
+
+ The optional arguments are considered as literal strings unless they
+ start with C<~> or C<!>, in which case they are interpreted as regular
+ expressions (possibly negated).
+
+ The second example prints entries with names C<foo>, and also entries
+ with names which ends on C<bar>, or are shorter than 5 chars.
+
+ =item set_quote
+
+ $d->set_quote('"');
+
+ Sets C<tick> and C<unctrl> options to suitable values for printout with the
+ given quote char. Possible values are C<auto>, C<'> and C<">.
+
+ =item set_unctrl
+
+ $d->set_unctrl('"');
+
+ Sets C<unctrl> option with checking for an invalid argument.
+ Possible values are C<unctrl> and C<quote>.
+
+ =item compactDump
+
+ $d->compactDump(1);
+
+ Sets C<compactDump> option. If the value is 1, sets to a reasonable
+ big number.
+
+ =item veryCompact
+
+ $d->veryCompact(1);
+
+ Sets C<compactDump> and C<veryCompact> options simultaneously.
+
+ =item set
+
+ $d->set(option1 => value1, option2 => value2);
+
+ =item get
+
+ @values = $d->get('option1', 'option2');
+
+ =back
+
+ =cut
+
diff -c 'perl5.005_02/lib/English.pm' 'perl5.005_03/lib/English.pm'
Index: ./lib/English.pm
*** ./lib/English.pm Thu Jul 23 23:00:34 1998
--- ./lib/English.pm Sat Mar 27 12:38:47 1999
***************
*** 15,20 ****
--- 15,28 ----
=head1 DESCRIPTION
+ You should I<not> use this module in programs intended to be portable
+ among Perl versions, programs that must perform regular expression
+ matching operations efficiently, or libraries intended for use with
+ such programs. In a sense, this module is deprecated. The reasons
+ for this have to do with implementation details of the Perl
+ interpreter which are too thorny to go into here. Perhaps someday
+ they will be fixed to make "C<use English>" more practical.
+
This module provides aliases for the built-in variables whose
names no one seems to like to read. Variables with side-effects
which get triggered just by accessing them (like $0) will still
***************
*** 160,165 ****
--- 168,174 ----
*PERL_VERSION = *] ;
*ACCUMULATOR = *^A ;
+ *COMPILING = *^C ;
*DEBUGGING = *^D ;
*SYSTEM_FD_MAX = *^F ;
*INPLACE_EDIT = *^I ;
diff -c 'perl5.005_02/lib/ExtUtils/Command.pm' 'perl5.005_03/lib/ExtUtils/Command.pm'
Index: ./lib/ExtUtils/Command.pm
*** ./lib/ExtUtils/Command.pm Thu Jul 23 23:00:34 1998
--- ./lib/ExtUtils/Command.pm Tue Jan 5 20:17:48 1999
***************
*** 31,38 ****
=head1 DESCRIPTION
! The module is used in Win32 port to replace common UNIX commands.
! Most commands are wrapers on generic modules File::Path and File::Basename.
=over 4
--- 31,38 ----
=head1 DESCRIPTION
! The module is used in the Win32 port to replace common UNIX commands.
! Most commands are wrappers on generic modules File::Path and File::Basename.
=over 4
diff -c 'perl5.005_02/lib/ExtUtils/Embed.pm' 'perl5.005_03/lib/ExtUtils/Embed.pm'
Index: ./lib/ExtUtils/Embed.pm
Prereq: 1.2501
*** ./lib/ExtUtils/Embed.pm Thu Jul 23 23:00:34 1998
--- ./lib/ExtUtils/Embed.pm Tue Jan 5 20:17:50 1999
***************
*** 416,422 ****
extensions found in B<$Config{static_ext}>. This includes libraries
found in B<$Config{libs}> and the first ModuleName.a library
for each extension that is found by searching B<@INC> or the path
! specifed by the B<-I> option.
In addition, when ModuleName.a is found, additional linker arguments
are picked up from the B<extralibs.ld> file in the same directory.
--- 416,422 ----
extensions found in B<$Config{static_ext}>. This includes libraries
found in B<$Config{libs}> and the first ModuleName.a library
for each extension that is found by searching B<@INC> or the path
! specified by the B<-I> option.
In addition, when ModuleName.a is found, additional linker arguments
are picked up from the B<extralibs.ld> file in the same directory.
diff -c 'perl5.005_02/lib/ExtUtils/Install.pm' 'perl5.005_03/lib/ExtUtils/Install.pm'
Index: ./lib/ExtUtils/Install.pm
*** ./lib/ExtUtils/Install.pm Thu Jul 23 23:00:35 1998
--- ./lib/ExtUtils/Install.pm Tue Jan 5 20:17:51 1999
***************
*** 354,360 ****
This function calls install() with the same arguments as the defaults
the MakeMaker would use.
! The argumement-less form is convenient for install scripts like
perl -MExtUtils::Install -e install_default Tk/Canvas
--- 354,360 ----
This function calls install() with the same arguments as the defaults
the MakeMaker would use.
! The argument-less form is convenient for install scripts like
perl -MExtUtils::Install -e install_default Tk/Canvas
diff -c 'perl5.005_02/lib/ExtUtils/Liblist.pm' 'perl5.005_03/lib/ExtUtils/Liblist.pm'
Index: ./lib/ExtUtils/Liblist.pm
*** ./lib/ExtUtils/Liblist.pm Wed Aug 5 18:02:22 1998
--- ./lib/ExtUtils/Liblist.pm Tue Jan 5 20:17:47 1999
***************
*** 225,230 ****
--- 225,233 ----
my $search = 1;
my($fullname, $thislib, $thispth);
+ # add "$Config{installarchlib}/CORE" to default search path
+ push @libpath, "$Config{installarchlib}/CORE";
+
foreach (Text::ParseWords::quotewords('\s+', 0, $potential_libs)){
$thislib = $_;
***************
*** 240,247 ****
# if searching is disabled, do compiler-specific translations
unless ($search) {
- s/^-L/-libpath:/ if $VC;
s/^-l(.+)$/$1.lib/ unless $GC;
push(@extralibs, $_);
$found++;
next;
--- 243,250 ----
# if searching is disabled, do compiler-specific translations
unless ($search) {
s/^-l(.+)$/$1.lib/ unless $GC;
+ s/^-L/-libpath:/ if $VC;
push(@extralibs, $_);
$found++;
next;
***************
*** 575,581 ****
=item *
Input library and path specifications are accepted with or without the
! C<-l> and C<-L> prefices used by Unix linkers. If neither prefix is
present, a token is considered a directory to search if it is in fact
a directory, and a library to search for otherwise. Authors who wish
their extensions to be portable to Unix or OS/2 should use the Unix
--- 578,584 ----
=item *
Input library and path specifications are accepted with or without the
! C<-l> and C<-L> prefixes used by Unix linkers. If neither prefix is
present, a token is considered a directory to search if it is in fact
a directory, and a library to search for otherwise. Authors who wish
their extensions to be portable to Unix or OS/2 should use the Unix
***************
*** 586,592 ****
Wherever possible, shareable images are preferred to object libraries,
and object libraries to plain object files. In accordance with VMS
naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
! it also looks for I<lib>lib and libI<lib> to accomodate Unix conventions
used in some ported software.
=item *
--- 589,595 ----
Wherever possible, shareable images are preferred to object libraries,
and object libraries to plain object files. In accordance with VMS
naming conventions, ext() looks for files named I<lib>shr and I<lib>rtl;
! it also looks for I<lib>lib and libI<lib> to accommodate Unix conventions
used in some ported software.
=item *
***************
*** 625,638 ****
If C<$potential_libs> is empty, the return value will be empty.
Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm)
will be appended to the list of C<$potential_libs>. The libraries
! will be searched for in the directories specified in C<$potential_libs>
! as well as in C<$Config{libpth}>. For each library that is found, a
! space-separated list of fully qualified library pathnames is generated.
=item *
Input library and path specifications are accepted with or without the
! C<-l> and C<-L> prefices used by Unix linkers.
An entry of the form C<-La:\foo> specifies the C<a:\foo> directory to look
for the libraries that follow.
--- 628,642 ----
If C<$potential_libs> is empty, the return value will be empty.
Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm)
will be appended to the list of C<$potential_libs>. The libraries
! will be searched for in the directories specified in C<$potential_libs>,
! C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>.
! For each library that is found, a space-separated list of fully qualified
! library pathnames is generated.
=item *
Input library and path specifications are accepted with or without the
! C<-l> and C<-L> prefixes used by Unix linkers.
An entry of the form C<-La:\foo> specifies the C<a:\foo> directory to look
for the libraries that follow.
***************
*** 651,657 ****
be appended to any entries that are not directories and don't already have
the suffix.
! Note that the C<-L> and <-l> prefixes are B<not required>, but authors
who wish their extensions to be portable to Unix or OS/2 should use the
prefixes, since the Unix-OS/2 version of ext() requires them.
--- 655,661 ----
be appended to any entries that are not directories and don't already have
the suffix.
! Note that the C<-L> and C<-l> prefixes are B<not required>, but authors
who wish their extensions to be portable to Unix or OS/2 should use the
prefixes, since the Unix-OS/2 version of ext() requires them.
diff -c 'perl5.005_02/lib/ExtUtils/MM_OS2.pm' 'perl5.005_03/lib/ExtUtils/MM_OS2.pm'
Index: ./lib/ExtUtils/MM_OS2.pm
*** ./lib/ExtUtils/MM_OS2.pm Thu Jul 23 23:00:35 1998
--- ./lib/ExtUtils/MM_OS2.pm Fri Oct 30 18:52:33 1998
***************
*** 15,20 ****
--- 15,21 ----
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {};
my(@m);
(my $boot = $self->{NAME}) =~ s/:/_/g;
***************
*** 27,38 ****
--- 28,71 ----
Mksymlists("NAME" => "', $self->{NAME},
'", "DLBASE" => "',$self->{DLBASE},
'", "DL_FUNCS" => ',neatvalue($funcs),
+ ', "FUNCLIST" => ',neatvalue($funclist),
', "IMPORTS" => ',neatvalue($imports),
', "VERSION" => "',$self->{VERSION},
'", "DL_VARS" => ', neatvalue($vars), ');\'
');
}
+ if (%{$self->{IMPORTS}}) {
+ # Make import files (needed for static build)
+ -d 'tmp_imp' or mkdir 'tmp_imp', 0777 or die "Can't mkdir tmp_imp";
+ open IMP, '>tmpimp.imp' or die "Can't open tmpimp.imp";
+ my ($name, $exp);
+ while (($name, $exp)= each %{$self->{IMPORTS}}) {
+ my ($lib, $id) = ($exp =~ /(.*)\.(.*)/) or die "Malformed IMPORT `$exp'";
+ print IMP "$name $lib $id ?\n";
+ }
+ close IMP or die "Can't close tmpimp.imp";
+ # print "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp\n";
+ system "emximp -o tmpimp$Config::Config{lib_ext} tmpimp.imp"
+ and die "Cannot make import library: $!, \$?=$?";
+ unlink <tmp_imp/*>;
+ system "cd tmp_imp; $Config::Config{ar} x ../tmpimp$Config::Config{lib_ext}"
+ and die "Cannot extract import objects: $!, \$?=$?";
+ }
join('',@m);
+ }
+
+ sub static_lib {
+ my($self) = @_;
+ my $old = $self->ExtUtils::MM_Unix::static_lib();
+ return $old unless %{$self->{IMPORTS}};
+
+ my @chunks = split /\n{2,}/, $old;
+ shift @chunks unless length $chunks[0]; # Empty lines at the start
+ $chunks[0] .= <<'EOC';
+
+ $(AR) $(AR_STATIC_ARGS) $@ tmp_imp/* && $(RANLIB) $@
+ EOC
+ return join "\n\n". '', @chunks;
}
sub replace_manpage_separator {
diff -c 'perl5.005_02/lib/ExtUtils/MM_Unix.pm' 'perl5.005_03/lib/ExtUtils/MM_Unix.pm'
Index: ./lib/ExtUtils/MM_Unix.pm
Prereq: 1.126
*** ./lib/ExtUtils/MM_Unix.pm Thu Jul 23 23:00:37 1998
--- ./lib/ExtUtils/MM_Unix.pm Thu Mar 4 18:34:20 1999
***************
*** 8,14 ****
use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT
$Verbose %pm %static $Xsubpp_Version);
! $VERSION = substr q$Revision: 1.12601 $, 10;
# $Id: MM_Unix.pm,v 1.126 1998/06/28 21:32:49 k Exp k $
Exporter::import('ExtUtils::MakeMaker',
--- 8,14 ----
use vars qw($VERSION $Is_Mac $Is_OS2 $Is_VMS $Is_Win32 $Is_Dos $Is_PERL_OBJECT
$Verbose %pm %static $Xsubpp_Version);
! $VERSION = substr q$Revision: 1.12602 $, 10;
# $Id: MM_Unix.pm,v 1.126 1998/06/28 21:32:49 k Exp k $
Exporter::import('ExtUtils::MakeMaker',
***************
*** 19,25 ****
$Is_Win32 = $^O eq 'MSWin32';
$Is_Dos = $^O eq 'dos';
! $Is_PERL_OBJECT = 1 if $Config{'ccflags'} =~ /-DPERL_OBJECT/;
if ($Is_VMS = $^O eq 'VMS') {
require VMS::Filespec;
--- 19,25 ----
$Is_Win32 = $^O eq 'MSWin32';
$Is_Dos = $^O eq 'dos';
! $Is_PERL_OBJECT = $Config{'ccflags'} =~ /-DPERL_OBJECT/;
if ($Is_VMS = $^O eq 'VMS') {
require VMS::Filespec;
***************
*** 84,93 ****
if ( $^O eq 'qnx' && $path =~ s|^(//\d+)/|/| ) {
$node = $1;
}
! $path =~ s|/+|/|g ; # xx////xx -> xx/xx
$path =~ s|(/\.)+/|/|g ; # xx/././xx -> xx/xx
$path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx
! $path =~ s|/$|| unless $path eq "/"; # xx/ -> xx
"$node$path";
}
--- 84,93 ----
if ( $^O eq 'qnx' && $path =~ s|^(//\d+)/|/| ) {
$node = $1;
}
! $path =~ s|(?<=[^/])/+|/|g ; # xx////xx -> xx/xx
$path =~ s|(/\.)+/|/|g ; # xx/././xx -> xx/xx
$path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx
! $path =~ s|(?<=[^/])/$|| ; # xx/ -> xx
"$node$path";
}
***************
*** 233,238 ****
--- 233,239 ----
sub ExtUtils::MM_Unix::top_targets ;
sub ExtUtils::MM_Unix::writedoc ;
sub ExtUtils::MM_Unix::xs_c ;
+ sub ExtUtils::MM_Unix::xs_cpp ;
sub ExtUtils::MM_Unix::xs_o ;
sub ExtUtils::MM_Unix::xsubpp_version ;
***************
*** 374,382 ****
$self->{uc $_} ||= $cflags{$_}
}
! if ($self->{CAPI} && $Is_PERL_OBJECT == 1) {
$self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//;
! $self->{CCFLAGS} .= '-DPERL_CAPI';
if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) {
# Turn off C++ mode of the MSC compiler
$self->{CCFLAGS} =~ s/-TP(\s|$)//;
--- 375,383 ----
$self->{uc $_} ||= $cflags{$_}
}
! if ($self->{CAPI} && $Is_PERL_OBJECT) {
$self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//;
! $self->{CCFLAGS} .= ' -DPERL_CAPI ';
if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) {
# Turn off C++ mode of the MSC compiler
$self->{CCFLAGS} =~ s/-TP(\s|$)//;
***************
*** 818,824 ****
=item dist_core (o)
! Defeines the targets dist, tardist, zipdist, uutardist, shdist
=cut
--- 819,825 ----
=item dist_core (o)
! Defines the targets dist, tardist, zipdist, uutardist, shdist
=cut
***************
*** 915,920 ****
--- 916,922 ----
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my(@m);
push(@m,"
***************
*** 931,937 ****
$self->{BASEEXT}.exp: Makefile.PL
",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
! neatvalue($funcs),', "DL_VARS" => ', neatvalue($vars), ');\'
');
join('',@m);
--- 933,940 ----
$self->{BASEEXT}.exp: Makefile.PL
",' $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e \'use ExtUtils::Mksymlists; \\
Mksymlists("NAME" => "',$self->{NAME},'", "DL_FUNCS" => ',
! neatvalue($funcs), ', "FUNCLIST" => ', neatvalue($funclist),
! ', "DL_VARS" => ', neatvalue($vars), ');\'
');
join('',@m);
***************
*** 2018,2024 ****
=item installbin (o)
! Defines targets to install EXE_FILES.
=cut
--- 2021,2027 ----
=item installbin (o)
! Defines targets to make and to install EXE_FILES.
=cut
***************
*** 2045,2051 ****
} : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \
-e "MY->fixin(shift)"
}).qq{
! all :: @to
$self->{NOECHO}\$(NOOP)
realclean ::
--- 2048,2054 ----
} : q{FIXIN = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::MakeMaker \
-e "MY->fixin(shift)"
}).qq{
! pure_all :: @to
$self->{NOECHO}\$(NOOP)
realclean ::
***************
*** 2347,2353 ****
$tmp/perlmain.c: $makefilename}, q{
}.$self->{NOECHO}.q{echo Writing $@
}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\
! -e "writemain(grep s#.*/auto/##, qw|$(MAP_STATIC)|)" > $@t && $(MV) $@t $@
};
push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
--- 2350,2356 ----
$tmp/perlmain.c: $makefilename}, q{
}.$self->{NOECHO}.q{echo Writing $@
}.$self->{NOECHO}.q{$(PERL) $(MAP_PERLINC) -MExtUtils::Miniperl \\
! -e "writemain(grep s#.*/auto/##, split(q| |, q|$(MAP_STATIC)|))" > $@t && $(MV) $@t $@
};
push @m, "\t",$self->{NOECHO}.q{$(PERL) $(INSTALLSCRIPT)/fixpmain
***************
*** 2746,2755 ****
--- 2749,2761 ----
push(@m, "\t\@\$(PERL) -e \"print qq{<SOFTPKG NAME=\\\"$self->{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}");
push(@m, ". qq{\\t<TITLE>$self->{DISTNAME}</TITLE>\\n}");
my $abstract = $self->{ABSTRACT};
+ $abstract =~ s/\n/\\n/sg;
$abstract =~ s/</</g;
$abstract =~ s/>/>/g;
push(@m, ". qq{\\t<ABSTRACT>$abstract</ABSTRACT>\\n}");
my ($author) = $self->{AUTHOR};
+ $author =~ s/</</g;
+ $author =~ s/>/>/g;
$author =~ s/@/\\@/g;
push(@m, ". qq{\\t<AUTHOR>$author</AUTHOR>\\n}");
push(@m, ". qq{\\t<IMPLEMENTATION>\\n}");
***************
*** 2757,2765 ****
foreach $prereq (sort keys %{$self->{PREREQ_PM}}) {
my $pre_req = $prereq;
$pre_req =~ s/::/-/g;
! push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" />\\n}");
}
push(@m, ". qq{\\t\\t<OS NAME=\\\"\$(OSNAME)\\\" />\\n}");
my ($bin_location) = $self->{BINARY_LOCATION};
$bin_location =~ s/\\/\\\\/g;
if ($self->{PPM_INSTALL_SCRIPT}) {
--- 2763,2773 ----
foreach $prereq (sort keys %{$self->{PREREQ_PM}}) {
my $pre_req = $prereq;
$pre_req =~ s/::/-/g;
! my ($dep_ver) = join ",", (split (/\./, $self->{PREREQ_PM}{$prereq}), (0) x 4) [0 .. 3];
! push(@m, ". qq{\\t\\t<DEPENDENCY NAME=\\\"$pre_req\\\" VERSION=\\\"$dep_ver\\\" />\\n}");
}
push(@m, ". qq{\\t\\t<OS NAME=\\\"\$(OSNAME)\\\" />\\n}");
+ push(@m, ". qq{\\t\\t<ARCHITECTURE NAME=\\\"$Config{'archname'}\\\" />\\n}");
my ($bin_location) = $self->{BINARY_LOCATION};
$bin_location =~ s/\\/\\\\/g;
if ($self->{PPM_INSTALL_SCRIPT}) {
***************
*** 2783,2789 ****
Used as the string that is passed
to the C<chmod> command to set the permissions for read/writeable files.
MakeMaker chooses C<644> because it has turned out in the past that
! relying on the umask provokes hard-to-track bugreports.
When the return value is used by the perl function C<chmod>, it is
interpreted as an octal value.
--- 2791,2797 ----
Used as the string that is passed
to the C<chmod> command to set the permissions for read/writeable files.
MakeMaker chooses C<644> because it has turned out in the past that
! relying on the umask provokes hard-to-track bug reports.
When the return value is used by the perl function C<chmod>, it is
interpreted as an octal value.
***************
*** 2889,2901 ****
return "" unless $self->{PL_FILES};
my(@m, $plfile);
foreach $plfile (sort keys %{$self->{PL_FILES}}) {
push @m, "
! all :: $self->{PL_FILES}->{$plfile}
$self->{NOECHO}\$(NOOP)
! $self->{PL_FILES}->{$plfile} :: $plfile
! \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile
";
}
join "", @m;
}
--- 2897,2914 ----
return "" unless $self->{PL_FILES};
my(@m, $plfile);
foreach $plfile (sort keys %{$self->{PL_FILES}}) {
+ my $list = ref($self->{PL_FILES}->{$plfile})
+ ? $self->{PL_FILES}->{$plfile}
+ : [$self->{PL_FILES}->{$plfile}];
+ foreach $target (@$list) {
push @m, "
! all :: $target
$self->{NOECHO}\$(NOOP)
! $target :: $plfile
! \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) $plfile $target
";
+ }
}
join "", @m;
}
***************
*** 2943,2949 ****
sub replace_manpage_separator {
my($self,$man) = @_;
! $man =~ s,/+,::,g;
$man;
}
--- 2956,2966 ----
sub replace_manpage_separator {
my($self,$man) = @_;
! if ($^O eq 'uwin') {
! $man =~ s,/+,.,g;
! } else {
! $man =~ s,/+,::,g;
! }
$man;
}
***************
*** 3304,3310 ****
}
}
! $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp";
return qq{
XSUBPPDIR = $xsdir
--- 3321,3327 ----
}
}
! my $xsubpp = $self->{CAPI} ? "xsubpp -object_capi" : "xsubpp";
return qq{
XSUBPPDIR = $xsdir
***************
*** 3454,3460 ****
=item writedoc
! Obsolete, depecated method. Not used since Version 5.21.
=cut
--- 3471,3477 ----
=item writedoc
! Obsolete, deprecated method. Not used since Version 5.21.
=cut
***************
*** 3478,3484 ****
return '' unless $self->needs_linking();
'
.xs.c:
! $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >$*.tc && $(MV) $*.tc $@
';
}
--- 3495,3516 ----
return '' unless $self->needs_linking();
'
.xs.c:
! $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c
! ';
! }
!
! =item xs_cpp (o)
!
! Defines the suffix rules to compile XS files to C++.
!
! =cut
!
! sub xs_cpp {
! my($self) = shift;
! return '' unless $self->needs_linking();
! '
! .xs.cpp:
! $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.cpp
';
}
***************
*** 3509,3514 ****
--- 3541,3547 ----
sub perl_archive
{
+ return '$(PERL_INC)' . "/$Config{libperl}" if $^O eq "beos";
return "";
}
diff -c 'perl5.005_02/lib/ExtUtils/MM_VMS.pm' 'perl5.005_03/lib/ExtUtils/MM_VMS.pm'
Index: ./lib/ExtUtils/MM_VMS.pm
*** ./lib/ExtUtils/MM_VMS.pm Thu Jul 23 23:00:39 1998
--- ./lib/ExtUtils/MM_VMS.pm Sun Dec 13 10:16:29 1998
***************
*** 3,9 ****
# This package is inserted into @ISA of MakeMaker's MM before the
# built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS.
#
! # Author: Charles Bailey bailey@genetics.upenn.edu
package ExtUtils::MM_VMS;
--- 3,9 ----
# This package is inserted into @ISA of MakeMaker's MM before the
# built-in ExtUtils::MM_Unix methods if MakeMaker.pm is run under VMS.
#
! # Author: Charles Bailey bailey@newman.upenn.edu
package ExtUtils::MM_VMS;
***************
*** 14,20 ****
use File::Basename;
use vars qw($Revision);
! $Revision = '5.42 (31-Mar-1997)';
unshift @MM::ISA, 'ExtUtils::MM_VMS';
--- 14,20 ----
use File::Basename;
use vars qw($Revision);
! $Revision = '5.52 (12-Sep-1998)';
unshift @MM::ISA, 'ExtUtils::MM_VMS';
***************
*** 829,835 ****
$quals =~ s/ -$type$def\s*//;
$def =~ s/"/""/g;
if ($type eq 'D') { $definestr .= qq["$def",]; }
! elsif ($type eq 'I') { $flagincstr .= ',' . $self->fixpath($def,1); }
else { $undefstr .= qq["$def",]; }
}
}
--- 829,835 ----
$quals =~ s/ -$type$def\s*//;
$def =~ s/"/""/g;
if ($type eq 'D') { $definestr .= qq["$def",]; }
! elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
else { $undefstr .= qq["$def",]; }
}
}
***************
*** 869,875 ****
my(@includes) = split(/\s+/,$self->{INC});
foreach (@includes) {
s/^-I//;
! $incstr .= ', '.$self->fixpath($_,1);
}
}
$quals .= "$incstr)";
--- 869,875 ----
my(@includes) = split(/\s+/,$self->{INC});
foreach (@includes) {
s/^-I//;
! $incstr .= ','.$self->fixpath($_,1);
}
}
$quals .= "$incstr)";
***************
*** 1322,1327 ****
--- 1322,1328 ----
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my(@m);
unless ($self->{SKIPHASH}{'dynamic'}) {
***************
*** 1343,1349 ****
$(BASEEXT).opt : Makefile.PL
$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
! neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),')"
$(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
');
--- 1344,1351 ----
$(BASEEXT).opt : Makefile.PL
$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Mksymlists;" -
',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
! neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
! q[, 'FUNCLIST' => ],neatvalue($funclist),')"
$(PERL) -e "print ""$(INST_STATIC)/Include=$(BASEEXT)\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)
');
***************
*** 1389,1395 ****
push @m, '
$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
! $(NOECHO) If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
';
--- 1391,1397 ----
push @m, '
$(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
! If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
';
***************
*** 1441,1447 ****
$(NOECHO) $(NOOP)
' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
! my(@m);
push @m,'
# Rely on suffix rule for update action
$(OBJECT) : $(INST_ARCHAUTODIR).exists
--- 1443,1449 ----
$(NOECHO) $(NOOP)
' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
! my(@m,$lib);
push @m,'
# Rely on suffix rule for update action
$(OBJECT) : $(INST_ARCHAUTODIR).exists
***************
*** 1463,1469 ****
push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
}
! push(@m,"\t",'$(NOECHO) $(PERL) -e "open F,\'>>$(INST_ARCHAUTODIR)extralibs.ld\';print F qq{$(EXTRALIBS)\n};close F;"',"\n");
push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
join('',@m);
}
--- 1465,1474 ----
push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
}
! foreach $lib (split $self->{EXTRALIBS}) {
! $lib = '""' if $lib eq '"';
! push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
! }
push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
join('',@m);
}
***************
*** 1530,1544 ****
return "" unless $self->{PL_FILES};
my(@m, $plfile);
foreach $plfile (sort keys %{$self->{PL_FILES}}) {
! my $vmsplfile = vmsify($plfile);
! my $vmsfile = vmsify($self->{PL_FILES}->{$plfile});
! push @m, "
all :: $vmsfile
\$(NOECHO) \$(NOOP)
$vmsfile :: $vmsplfile
! ",' $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile
";
}
join "", @m;
}
--- 1535,1554 ----
return "" unless $self->{PL_FILES};
my(@m, $plfile);
foreach $plfile (sort keys %{$self->{PL_FILES}}) {
! my $list = ref($self->{PL_FILES}->{$plfile})
! ? $self->{PL_FILES}->{$plfile}
! : [$self->{PL_FILES}->{$plfile}];
! foreach $target (@$list) {
! my $vmsplfile = vmsify($plfile);
! my $vmsfile = vmsify($target);
! push @m, "
all :: $vmsfile
\$(NOECHO) \$(NOOP)
$vmsfile :: $vmsplfile
! ",' $(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile $vmsfile
";
+ }
}
join "", @m;
}
***************
*** 2188,2194 ****
}
! my($linkcmd,@staticopts,@staticpkgs,$extralist,$targdir,$libperldir);
# The front matter of the linkcommand...
$linkcmd = join ' ', $Config{'ld'},
--- 2198,2205 ----
}
! my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
! local($_);
# The front matter of the linkcommand...
$linkcmd = join ' ', $Config{'ld'},
***************
*** 2251,2278 ****
# (e.g. Intuit::DWIM will precede Intuit, so unresolved
# references from [.intuit.dwim]dwim.obj can be found
# in [.intuit]intuit.olb).
! for (sort keys %olbs) {
next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
my($dir) = $self->fixpath($_,1);
my($extralibs) = $dir . "extralibs.ld";
my($extopt) = $dir . $olbs{$_};
$extopt =~ s/$self->{LIB_EXT}$/.opt/;
if (-f $extralibs ) {
open LIST,$extralibs or warn $!,next;
! push @$extra, <LIST>;
close LIST;
}
if (-f $extopt) {
open OPT,$extopt or die $!;
while (<OPT>) {
next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
! # ExtUtils::Miniperl expects Unix paths
! (my($pkg) = "$1_$1$self->{LIB_EXT}") =~ s#_*#/#g;
push @staticpkgs,$pkg;
}
- push @staticopts, $extopt;
}
}
$target = "Perl$Config{'exe_ext'}" unless $target;
($shrtarget,$targdir) = fileparse($target);
--- 2262,2307 ----
# (e.g. Intuit::DWIM will precede Intuit, so unresolved
# references from [.intuit.dwim]dwim.obj can be found
# in [.intuit]intuit.olb).
! for (sort { length($a) <=> length($b) } keys %olbs) {
next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
my($dir) = $self->fixpath($_,1);
my($extralibs) = $dir . "extralibs.ld";
my($extopt) = $dir . $olbs{$_};
$extopt =~ s/$self->{LIB_EXT}$/.opt/;
+ push @optlibs, "$dir$olbs{$_}";
+ # Get external libraries this extension will need
if (-f $extralibs ) {
+ my %seenthis;
open LIST,$extralibs or warn $!,next;
! while (<LIST>) {
! chomp;
! # Include a library in the link only once, unless it's mentioned
! # multiple times within a single extension's options file, in which
! # case we assume the builder needed to search it again later in the
! # link.
! my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
! $libseen{$_}++; $seenthis{$_}++;
! next if $skip;
! push @$extra,$_;
! }
close LIST;
}
+ # Get full name of extension for ExtUtils::Miniperl
if (-f $extopt) {
open OPT,$extopt or die $!;
while (<OPT>) {
next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
! my $pkg = $1;
! $pkg =~ s#__*#::#g;
push @staticpkgs,$pkg;
}
}
}
+ # Place all of the external libraries after all of the Perl extension
+ # libraries in the final link, in order to maximize the opportunity
+ # for XS code from multiple extensions to resolve symbols against the
+ # same external library while only including that library once.
+ push @optlibs, @$extra;
$target = "Perl$Config{'exe_ext'}" unless $target;
($shrtarget,$targdir) = fileparse($target);
***************
*** 2281,2291 ****
$target = "Perlshr.$Config{'dlext'}" unless $target;
$tmp = "[]" unless $tmp;
$tmp = $self->fixpath($tmp,1);
! if (@$extra) {
! $extralist = join(' ',@$extra);
! $extralist =~ s/[,\s\n]+/, /g;
! }
! else { $extralist = ''; }
if ($libperl) {
unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
print STDOUT "Warning: $libperl not found\n";
--- 2310,2320 ----
$target = "Perlshr.$Config{'dlext'}" unless $target;
$tmp = "[]" unless $tmp;
$tmp = $self->fixpath($tmp,1);
! if (@optlibs) { $extralist = join(' ',@optlibs); }
! else { $extralist = ''; }
! # Let ExtUtils::Liblist find the necessary for us (but skip PerlShr;
! # that's what we're building here).
! push @optlibs, grep { !/PerlShr/i } split +($self->ext())[2];
if ($libperl) {
unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
print STDOUT "Warning: $libperl not found\n";
***************
*** 2309,2327 ****
MAP_TARGET = ',$self->fixpath($target,0),'
MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
MAP_LINKCMD = $linkcmd
! MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '','
! # We use the linker options files created with each extension, rather than
! #specifying the object files directly on the command line.
! MAP_STATIC = ',@staticopts ? join(' ', @staticopts) : '','
! MAP_OPTS = ',@staticopts ? ','.join(',', map($_.'/Option', @staticopts)) : '',"
MAP_EXTRA = $extralist
MAP_LIBPERL = ",$self->fixpath($libperl,0),'
';
! push @m,'
! $(MAP_SHRTARGET) : $(MAP_LIBPERL) $(MAP_STATIC) ',"${libperldir}Perlshr_Attr.Opt",'
! $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_OPTS), $(MAP_EXTRA), $(MAP_LIBPERL) ',"${libperldir}Perlshr_Attr.Opt",'
$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
$(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
--- 2338,2359 ----
MAP_TARGET = ',$self->fixpath($target,0),'
MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
MAP_LINKCMD = $linkcmd
! MAP_PERLINC = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
MAP_EXTRA = $extralist
MAP_LIBPERL = ",$self->fixpath($libperl,0),'
';
! push @m,"\n${tmp}Makeaperl.Opt : \$(MAP_EXTRA)\n";
! foreach (@optlibs) {
! push @m,' $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
! }
! push @m,"\n${tmp}PerlShr.Opt :\n\t";
! push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
!
! push @m,'
! $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
! $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
$(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmp}perlmain\$(OBJ_EXT) ${tmp}PerlShr.Opt",'
$(MAP_LINKCMD) ',"${tmp}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
$(NOECHO) $(SAY) "To install the new ""$(MAP_TARGET)"" binary, say"
***************
*** 2329,2341 ****
$(NOECHO) $(SAY) "To remove the intermediate files, say
$(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
';
! push @m,'
! ',"${tmp}perlmain.c",' : $(MAKEFILE)
! $(NOECHO) $(PERL) $(MAP_PERLINC) -e "use ExtUtils::Miniperl; writemain(qw|',@staticpkgs,'|)" >$(MMS$TARGET)
! ';
push @m, q[
! # More from the 255-char line length limit
doc_inst_perl :
$(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
$(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
--- 2361,2377 ----
$(NOECHO) $(SAY) "To remove the intermediate files, say
$(NOECHO) $(SAY) " $(MMS)$(MMSQUALIFIERS)$(USEMAKEFILE)$(MAKEFILE) map_clean"
';
! push @m,"\n${tmp}perlmain.c : \$(MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmp}Writemain.tmp\n";
! push @m, "# More from the 255-char line length limit\n";
! foreach (@staticpkgs) {
! push @m,' $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmp}Writemain.tmp\n];
! }
! push @m,'
! $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" ',$tmp,'Writemain.tmp >$(MMS$TARGET)
! $(NOECHO) $(RM_F) ',"${tmp}Writemain.tmp\n";
push @m, q[
! # Still more from the 255-char line length limit
doc_inst_perl :
$(NOECHO) $(PERL) -e "print 'Perl binary $(MAP_TARGET)|'" >.MM_tmp
$(NOECHO) $(PERL) -e "print 'MAP_STATIC|$(MAP_STATIC)|'" >>.MM_tmp
***************
*** 2358,2364 ****
map_clean :
\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
! \$(RM_F) ${tmp}PerlShr.Opt \$(MAP_TARGET)
";
join '', @m;
--- 2394,2400 ----
map_clean :
\$(RM_F) ${tmp}perlmain\$(OBJ_EXT) ${tmp}perlmain.c \$(MAKEFILE)
! \$(RM_F) ${tmp}Makeaperl.Opt ${tmp}PerlShr.Opt \$(MAP_TARGET)
";
join '', @m;
diff -c 'perl5.005_02/lib/ExtUtils/MM_Win32.pm' 'perl5.005_03/lib/ExtUtils/MM_Win32.pm'
Index: ./lib/ExtUtils/MM_Win32.pm
*** ./lib/ExtUtils/MM_Win32.pm Wed Aug 5 17:34:20 1998
--- ./lib/ExtUtils/MM_Win32.pm Fri Oct 30 19:02:22 1998
***************
*** 33,38 ****
--- 33,39 ----
$GCC = 1 if $Config{'cc'} =~ /^gcc/i;
$DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
$NMAKE = 1 if $Config{'make'} =~ /^nmake/i;
+ $PERLMAKE = 1 if $Config{'make'} =~ /^pmake/i;
$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
sub dlsyms {
***************
*** 40,45 ****
--- 41,47 ----
my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
+ my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {};
my(@m);
(my $boot = $self->{NAME}) =~ s/:/_/g;
***************
*** 52,57 ****
--- 54,60 ----
-e "Mksymlists('NAME' => '!, $self->{NAME},
q!', 'DLBASE' => '!,$self->{DLBASE},
q!', 'DL_FUNCS' => !,neatvalue($funcs),
+ q!, 'FUNCLIST' => !,neatvalue($funclist),
q!, 'IMPORTS' => !,neatvalue($imports),
q!, 'DL_VARS' => !, neatvalue($vars), q!);"
!);
***************
*** 445,455 ****
$(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
$(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
! } else {
! push(@m, $BORLAND ?
! q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) $(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,),$(RESFILES)} :
! q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)}
! );
}
push @m, '
$(CHMOD) 755 $@
--- 448,465 ----
$(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
$(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
! } elsif ($BORLAND) {
! push(@m,
! q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
! .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
! .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
! : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
! .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
! .q{,$(RESFILES)});
! } else { # VC
! push(@m,
! q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
! .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
}
push @m, '
$(CHMOD) 755 $@
***************
*** 463,469 ****
{
my ($self) = @_;
if($OBJ) {
! if ($self->{CAPI} eq 'TRUE') {
return '$(PERL_INC)\perlCAPI$(LIB_EXT)';
}
}
--- 473,479 ----
{
my ($self) = @_;
if($OBJ) {
! if ($self->{CAPI}) {
return '$(PERL_INC)\perlCAPI$(LIB_EXT)';
}
}
***************
*** 524,533 ****
pm_to_blib: $(TO_INST_PM)
}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
! -e "pm_to_blib(qw[ }.
! ($NMAKE ? '<<pmfiles.dat'
! : '$(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n)').
! q{ ],'}.$autodir.q{')"
}. ($NMAKE ? q{
$(PM_TO_BLIB)
<<
--- 534,544 ----
pm_to_blib: $(TO_INST_PM)
}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
! -e "pm_to_blib(}.
! ($NMAKE ? 'qw[ <<pmfiles.dat ],'
! : $DMAKE ? 'qw[ $(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n) ],'
! : '{ qw[$(PM_TO_BLIB)] },'
! ).q{'}.$autodir.q{')"
}. ($NMAKE ? q{
$(PM_TO_BLIB)
<<
diff -c 'perl5.005_02/lib/ExtUtils/MakeMaker.pm' 'perl5.005_03/lib/ExtUtils/MakeMaker.pm'
Index: ./lib/ExtUtils/MakeMaker.pm
*** ./lib/ExtUtils/MakeMaker.pm Thu Jul 23 23:00:40 1998
--- ./lib/ExtUtils/MakeMaker.pm Thu Feb 11 18:06:01 1999
***************
*** 2,8 ****
package ExtUtils::MakeMaker;
! $Version = $VERSION = "5.4301";
$Version_OK = "5.17"; # Makefiles older than $Version_OK will die
# (Will be checked from MakeMaker version 4.13 onwards)
($Revision = substr(q$Revision: 1.222 $, 10)) =~ s/\s+$//;
--- 2,8 ----
package ExtUtils::MakeMaker;
! $VERSION = "5.4302";
$Version_OK = "5.17"; # Makefiles older than $Version_OK will die
# (Will be checked from MakeMaker version 4.13 onwards)
($Revision = substr(q$Revision: 1.222 $, 10)) =~ s/\s+$//;
***************
*** 35,43 ****
#
@ISA = qw(Exporter);
@EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt);
! @EXPORT_OK = qw($VERSION &Version_check &neatvalue &mkbootstrap &mksymlists
! $Version);
! # $Version in mixed case will go away!
#
# Dummy package MM inherits actual methods from OS-specific
--- 35,41 ----
#
@ISA = qw(Exporter);
@EXPORT = qw(&WriteMakefile &writeMakefile $Verbose &prompt);
! @EXPORT_OK = qw($VERSION &Version_check &neatvalue &mkbootstrap &mksymlists);
#
# Dummy package MM inherits actual methods from OS-specific
***************
*** 73,82 ****
$Is_Mac = $^O eq 'MacOS';
$Is_Win32 = $^O eq 'MSWin32';
- # This is for module authors to query, so they can enable 'CAPI' => 'TRUE'
- # in their Makefile.pl
- $CAPI_support = 1;
-
require ExtUtils::MM_Unix;
if ($Is_VMS) {
--- 71,76 ----
***************
*** 192,198 ****
} else {
print "$def\n";
}
! return $ans || $def;
}
sub eval_in_subdirs {
--- 186,192 ----
} else {
print "$def\n";
}
! return ($ans ne '') ? $ans : $def;
}
sub eval_in_subdirs {
***************
*** 241,269 ****
@Attrib_help = qw/
! AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION LICENSE_HREF CAPI
! C CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS
! EXE_FILES EXCLUDE_EXT INCLUDE_EXT NO_VC FIRST_MAKEFILE FULLPERL H
! INC INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH
INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB
! INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIBPERL_A LIB LIBS
LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
! NAME NEEDS_LINKING NOECHO NORECURS OBJECT OPTIMIZE PERL PERLMAINCC
PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX
! PL_FILES PM PMLIBDIRS PREFIX
PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
! tool_autosplit PPM_INSTALL_SCRIPT PPM_INSTALL_EXEC
!
! IMPORTS
!
! installpm
/;
! # IMPORTS is used under OS/2
!
! # ^^^ installpm is deprecated, will go about Summer 96
# @Overridable is close to @MM_Sections but not identical. The
# order is important. Many subroutines declare macros. These
--- 235,257 ----
@Attrib_help = qw/
! AUTHOR ABSTRACT ABSTRACT_FROM BINARY_LOCATION
! C CAPI CCFLAGS CONFIG CONFIGURE DEFINE DIR DISTNAME DL_FUNCS DL_VARS
! EXCLUDE_EXT EXE_FILES FIRST_MAKEFILE FULLPERL FUNCLIST H IMPORTS
! INC INCLUDE_EXT INSTALLARCHLIB INSTALLBIN INSTALLDIRS INSTALLMAN1DIR
INSTALLMAN3DIR INSTALLPRIVLIB INSTALLSCRIPT INSTALLSITEARCH
INSTALLSITELIB INST_ARCHLIB INST_BIN INST_EXE INST_LIB
! INST_MAN1DIR INST_MAN3DIR INST_SCRIPT LDFROM LIB LIBPERL_A LIBS
LINKTYPE MAKEAPERL MAKEFILE MAN1PODS MAN3PODS MAP_TARGET MYEXTLIB
! NAME NEEDS_LINKING NOECHO NORECURS NO_VC OBJECT OPTIMIZE PERL PERLMAINCC
PERL_ARCHLIB PERL_LIB PERL_SRC PERM_RW PERM_RWX
! PL_FILES PM PMLIBDIRS PPM_INSTALL_EXEC PPM_INSTALL_SCRIPT PREFIX
PREREQ_PM SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
! tool_autosplit
/;
! # IMPORTS is used under OS/2 and Win32
# @Overridable is close to @MM_Sections but not identical. The
# order is important. Many subroutines declare macros. These
***************
*** 428,433 ****
--- 416,422 ----
}
my $newclass = ++$PACKNAME;
+ local @Parent = @Parent; # Protect against non-local exits
{
# no strict;
print "Blessing Object into class [$newclass]\n" if $Verbose>=2;
***************
*** 450,458 ****
unless $self->file_name_is_absolute($self->{$key})
|| ($^O eq 'VMS' and ($key =~ /PERL$/ && $self->{$key} =~ /^[\w\-\$]+$/));
}
! $self->{PARENT}->{CHILDREN}->{$newclass} = $self if $self->{PARENT};
} else {
! parse_args($self,@ARGV);
}
$self->{NAME} ||= $self->guess_name;
--- 439,455 ----
unless $self->file_name_is_absolute($self->{$key})
|| ($^O eq 'VMS' and ($key =~ /PERL$/ && $self->{$key} =~ /^[\w\-\$]+$/));
}
! if ($self->{PARENT}) {
! $self->{PARENT}->{CHILDREN}->{$newclass} = $self;
! if (exists $self->{PARENT}->{CAPI}
! and not exists $self->{CAPI})
! {
! # inherit, but only if already unspecified
! $self->{CAPI} = $self->{PARENT}->{CAPI};
! }
! }
} else {
! parse_args($self,split(' ', $ENV{PERL_MM_OPT} || ''),@ARGV);
}
$self->{NAME} ||= $self->guess_name;
***************
*** 487,492 ****
--- 484,492 ----
$self->init_dirscan();
$self->init_others();
+ my($argv) = neatvalue(\@ARGV);
+ $argv =~ s/^\[/(/;
+ $argv =~ s/\]$/)/;
push @{$self->{RESULT}}, <<END;
# This Makefile is for the $self->{NAME} extension to perl.
***************
*** 497,502 ****
--- 497,504 ----
#
# ANY CHANGES MADE HERE WILL BE LOST!
#
+ # MakeMaker ARGV: $argv
+ #
# MakeMaker Parameters:
END
***************
*** 541,547 ****
}
push @{$self->{RESULT}}, "\n# End.";
- pop @Parent;
$self;
}
--- 543,548 ----
***************
*** 1026,1032 ****
$Config{install*} values.
Note, that in both cases the tilde expansion is done by MakeMaker, not
! by perl by default, nor by make. Conflicts between parmeters LIB,
PREFIX and the various INSTALL* arguments are resolved so that
XXX
--- 1027,1033 ----
$Config{install*} values.
Note, that in both cases the tilde expansion is done by MakeMaker, not
! by perl by default, nor by make. Conflicts between parameters LIB,
PREFIX and the various INSTALL* arguments are resolved so that
XXX
***************
*** 1176,1187 ****
The following attributes can be specified as arguments to WriteMakefile()
or as NAME=VALUE pairs on the command line:
! =cut
! # The following "=item C" is used by the attrib_help routine
! # likewise the "=back" below. So be careful when changing it!
! =over 2
=item C
--- 1177,1209 ----
The following attributes can be specified as arguments to WriteMakefile()
or as NAME=VALUE pairs on the command line:
! =over 2
! =item AUTHOR
! String containing name (and email address) of package author(s). Is used
! in PPD (Perl Package Description) files for PPM (Perl Package Manager).
!
! =item ABSTRACT
!
! One line description of the module. Will be included in PPD file.
!
! =item ABSTRACT_FROM
!
! Name of the file that contains the package description. MakeMaker looks
! for a line in the POD matching /^($package\s-\s)(.*)/. This is typically
! the first line in the "=head1 NAME" section. $2 becomes the abstract.
!
! =item BINARY_LOCATION
!
! Used when creating PPD files for binary packages. It can be set to a
! full or relative path or URL to the binary archive for a particular
! architecture. For example:
!
! perl Makefile.PL BINARY_LOCATION=x86/Agent.tar.gz
!
! builds a PPD package that references a binary of the C<Agent> package,
! located in the C<x86> directory relative to the PPD itself.
=item C
***************
*** 1189,1194 ****
--- 1211,1224 ----
and the values portion of the XS attribute hash. This is not
currently used by MakeMaker but may be handy in Makefile.PLs.
+ =item CAPI
+
+ Switch to force usage of the Perl C API even when compiling for PERL_OBJECT.
+
+ Note that this attribute is passed through to any recursive build,
+ but if and only if the submodule's Makefile.PL itself makes no mention
+ of the 'CAPI' attribute.
+
=item CCFLAGS
String that will be included in the compiler call command line between
***************
*** 1237,1248 ****
=item DL_FUNCS
! Hashref of symbol names for routines to be made available as
! universal symbols. Each key/value pair consists of the package name
! and an array of routine names in that package. Used only under AIX
! (export lists) and VMS (linker options) at present. The routine
! names supplied will be expanded in the same way as XSUB names are
! expanded by the XS() macro. Defaults to
{"$(NAME)" => ["boot_$(NAME)" ] }
--- 1267,1278 ----
=item DL_FUNCS
! Hashref of symbol names for routines to be made available as universal
! symbols. Each key/value pair consists of the package name and an
! array of routine names in that package. Used only under AIX, OS/2,
! VMS and Win32 at present. The routine names supplied will be expanded
! in the same way as XSUB names are expanded by the XS() macro.
! Defaults to
{"$(NAME)" => ["boot_$(NAME)" ] }
***************
*** 1251,1262 ****
{"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )],
"NetconfigPtr" => [ 'DESTROY'] }
=item DL_VARS
! Array of symbol names for variables to be made available as
! universal symbols. Used only under AIX (export lists) and VMS
! (linker options) at present. Defaults to []. (e.g. [ qw(
! Foo_version Foo_numstreams Foo_tree ) ])
=item EXCLUDE_EXT
--- 1281,1294 ----
{"RPC" => [qw( boot_rpcb rpcb_gettime getnetconfigent )],
"NetconfigPtr" => [ 'DESTROY'] }
+ Please see the L<ExtUtils::Mksymlists> documentation for more information
+ about the DL_FUNCS, DL_VARS and FUNCLIST attributes.
+
=item DL_VARS
! Array of symbol names for variables to be made available as universal symbols.
! Used only under AIX, OS/2, VMS and Win32 at present. Defaults to [].
! (e.g. [ qw(Foo_version Foo_numstreams Foo_tree ) ])
=item EXCLUDE_EXT
***************
*** 1265,1271 ****
details. (e.g. [ qw( Socket POSIX ) ] )
This attribute may be most useful when specified as a string on the
! commandline: perl Makefile.PL EXCLUDE_EXT='Socket Safe'
=item EXE_FILES
--- 1297,1303 ----
details. (e.g. [ qw( Socket POSIX ) ] )
This attribute may be most useful when specified as a string on the
! command line: perl Makefile.PL EXCLUDE_EXT='Socket Safe'
=item EXE_FILES
***************
*** 1273,1285 ****
INST_SCRIPT directory. Make realclean will delete them from there
again.
- =item NO_VC
-
- In general any generated Makefile checks for the current version of
- MakeMaker and the version the Makefile was built under. If NO_VC is
- set, the version check is neglected. Do not write this into your
- Makefile.PL, use it interactively instead.
-
=item FIRST_MAKEFILE
The name of the Makefile to be produced. Defaults to the contents of
--- 1305,1310 ----
***************
*** 1290,1302 ****
Perl binary able to run this extension.
=item H
Ref to array of *.h file names. Similar to C.
=item IMPORTS
! IMPORTS is only used on OS/2.
=item INC
--- 1315,1335 ----
Perl binary able to run this extension.
+ =item FUNCLIST
+
+ This provides an alternate means to specify function names to be
+ exported from the extension. Its value is a reference to an
+ array of function names to be exported by the extension. These
+ names are passed through unaltered to the linker options file.
+
=item H
Ref to array of *.h file names. Similar to C.
=item IMPORTS
! This attribute is used to specify names to be imported into the
! extension. It is only used on OS/2 and Win32.
=item INC
***************
*** 1315,1321 ****
only DynaLoader and the current extension will be included in the build.
This attribute may be most useful when specified as a string on the
! commandline: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
=item INSTALLARCHLIB
--- 1348,1354 ----
only DynaLoader and the current extension will be included in the build.
This attribute may be most useful when specified as a string on the
! command line: perl Makefile.PL INCLUDE_EXT='POSIX Socket Devel::Peek'
=item INSTALLARCHLIB
***************
*** 1353,1366 ****
Used by 'make install' which copies files from INST_SCRIPT to this
directory.
! =item INSTALLSITELIB
! Used by 'make install', which copies files from INST_LIB to this
directory if INSTALLDIRS is set to site (default).
! =item INSTALLSITEARCH
! Used by 'make install', which copies files from INST_ARCHLIB to this
directory if INSTALLDIRS is set to site (default).
=item INST_ARCHLIB
--- 1386,1399 ----
Used by 'make install' which copies files from INST_SCRIPT to this
directory.
! =item INSTALLSITEARCH
! Used by 'make install', which copies files from INST_ARCHLIB to this
directory if INSTALLDIRS is set to site (default).
! =item INSTALLSITELIB
! Used by 'make install', which copies files from INST_LIB to this
directory if INSTALLDIRS is set to site (default).
=item INST_ARCHLIB
***************
*** 1403,1418 ****
what files to link/load from (also see dynamic_lib below for how to
specify ld flags)
- =item LIBPERL_A
-
- The filename of the perllibrary that will be used together with this
- extension. Defaults to libperl.a.
-
=item LIB
LIB can only be set at C<perl Makefile.PL> time. It has the effect of
setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any
=item LIBS
An anonymous array of alternative library
--- 1436,1451 ----
what files to link/load from (also see dynamic_lib below for how to
specify ld flags)
=item LIB
LIB can only be set at C<perl Makefile.PL> time. It has the effect of
setting both INSTALLPRIVLIB and INSTALLSITELIB to that value regardless any
+ =item LIBPERL_A
+
+ The filename of the perllibrary that will be used together with this
+ extension. Defaults to libperl.a.
+
=item LIBS
An anonymous array of alternative library
***************
*** 1497,1502 ****
--- 1530,1542 ----
Boolean. Attribute to inhibit descending into subdirectories.
+ =item NO_VC
+
+ In general any generated Makefile checks for the current version of
+ MakeMaker and the version the Makefile was built under. If NO_VC is
+ set, the version check is neglected. Do not write this into your
+ Makefile.PL, use it interactively instead.
+
=item OBJECT
List of object files, defaults to '$(BASEEXT)$(OBJ_EXT)', but can be a long
***************
*** 1532,1538 ****
=item PERM_RW
! Desired Permission for read/writable files. Defaults to C<644>.
See also L<MM_Unix/perm_rw>.
=item PERM_RWX
--- 1572,1578 ----
=item PERM_RW
! Desired permission for read/writable files. Defaults to C<644>.
See also L<MM_Unix/perm_rw>.
=item PERM_RWX
***************
*** 1549,1555 ****
{'foobar.PL' => 'foobar'}
The *.PL files are expected to produce output to the target files
! themselves.
=item PM
--- 1589,1599 ----
{'foobar.PL' => 'foobar'}
The *.PL files are expected to produce output to the target files
! themselves. If multiple files can be generated from the same *.PL
! file then the value in the hash can be a reference to an array of
! target file names. E.g.
!
! {'foobar.PL' => ['foobar1','foobar2']}
=item PM
***************
*** 1569,1574 ****
--- 1613,1627 ----
library. A libscan() method can be used to alter the behaviour.
Defining PM in the Makefile.PL will override PMLIBDIRS.
+ =item PPM_INSTALL_EXEC
+
+ Name of the executable used to run C<PPM_INSTALL_SCRIPT> below. (e.g. perl)
+
+ =item PPM_INSTALL_SCRIPT
+
+ Name of the script that gets executed by the Perl Package Manager after
+ the installation of a package.
+
=item PREFIX
Can be used to set the three INSTALL* attributes in one go (except for
***************
*** 1703,1712 ****
{ARMAYBE => 'ar', OTHERLDFLAGS => '...', INST_DYNAMIC_DEP => '...'}
- =item installpm
-
- Deprecated as of MakeMaker 5.23. See L<ExtUtils::MM_Unix/pm_to_blib>.
-
=item linkext
{LINKTYPE => 'static', 'dynamic' or ''}
--- 1756,1761 ----
***************
*** 1733,1744 ****
=back
- =cut
-
- # bug in pod2html, so leave the =back
-
- # Don't delete this cut, MM depends on it!
-
=head2 Overriding MakeMaker Methods
If you cannot achieve the desired Makefile behaviour by specifying
--- 1782,1787 ----
***************
*** 1916,1921 ****
--- 1959,1976 ----
dependency in a CPAN::Bundle, but the functionality is supported by
different means on the current architecture).
+ =head1 ENVIRONMENT
+
+ =over 8
+
+ =item PERL_MM_OPT
+
+ Command line options used by C<MakeMaker-E<gt>new()>, and thus by
+ C<WriteMakefile()>. The string is split on whitespace, and the result
+ is processed before any actual command line arguments are processed.
+
+ =back
+
=head1 SEE ALSO
ExtUtils::MM_Unix, ExtUtils::Manifest, ExtUtils::testlib,
***************
*** 1925,1931 ****
Andy Dougherty <F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>.
! VMS support by Charles Bailey <F<bailey@genetics.upenn.edu>>. OS/2
support by Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Contact the
makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
you have any questions.
--- 1980,1986 ----
Andy Dougherty <F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>.
! VMS support by Charles Bailey <F<bailey@newman.upenn.edu>>. OS/2
support by Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Contact the
makemaker mailing list C<mailto:makemaker@franz.ww.tu-berlin.de>, if
you have any questions.
diff -c 'perl5.005_02/lib/ExtUtils/Manifest.pm' 'perl5.005_03/lib/ExtUtils/Manifest.pm'
Index: ./lib/ExtUtils/Manifest.pm
*** ./lib/ExtUtils/Manifest.pm Thu Jul 23 23:00:40 1998
--- ./lib/ExtUtils/Manifest.pm Tue Jan 5 20:17:54 1999
***************
*** 298,304 ****
includes any comments that are found in the existing C<MANIFEST> file
in the new one. Anything between white space and an end of line within
a C<MANIFEST> file is considered to be a comment. Filenames and
! comments are seperated by one or more TAB characters in the
output. All files that match any regular expression in a file
C<MANIFEST.SKIP> (if such a file exists) are ignored.
--- 298,304 ----
includes any comments that are found in the existing C<MANIFEST> file
in the new one. Anything between white space and an end of line within
a C<MANIFEST> file is considered to be a comment. Filenames and
! comments are separated by one or more TAB characters in the
output. All files that match any regular expression in a file
C<MANIFEST.SKIP> (if such a file exists) are ignored.
***************
*** 317,323 ****
Skipcheck() lists all the files that are skipped due to your
C<MANIFEST.SKIP> file.
! Manifind() retruns a hash reference. The keys of the hash are the
files found below the current directory.
Maniread($file) reads a named C<MANIFEST> file (defaults to
--- 317,323 ----
Skipcheck() lists all the files that are skipped due to your
C<MANIFEST.SKIP> file.
! Manifind() returns a hash reference. The keys of the hash are the
files found below the current directory.
Maniread($file) reads a named C<MANIFEST> file (defaults to
diff -c 'perl5.005_02/lib/ExtUtils/Mkbootstrap.pm' 'perl5.005_03/lib/ExtUtils/Mkbootstrap.pm'
Index: ./lib/ExtUtils/Mkbootstrap.pm
*** ./lib/ExtUtils/Mkbootstrap.pm Thu Jul 23 23:00:40 1998
--- ./lib/ExtUtils/Mkbootstrap.pm Fri Oct 30 19:04:47 1998
***************
*** 1,6 ****
package ExtUtils::Mkbootstrap;
! $VERSION = substr q$Revision: 1.13 $, 10;
# $Date: 1996/09/03 17:04:43 $
use Config;
--- 1,6 ----
package ExtUtils::Mkbootstrap;
! $VERSION = substr q$Revision: 1.14 $, 10;
# $Date: 1996/09/03 17:04:43 $
use Config;
***************
*** 49,55 ****
print BS "# $baseext DynaLoader bootstrap file for $^O architecture.\n";
print BS "# Do not edit this file, changes will be lost.\n";
print BS "# This file was automatically generated by the\n";
! print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$Version).\n";
print BS "\@DynaLoader::dl_resolve_using = ";
# If @all contains names in the form -lxxx or -Lxxx then it's asking for
# runtime library location so we automatically add a call to dl_findfile()
--- 49,55 ----
print BS "# $baseext DynaLoader bootstrap file for $^O architecture.\n";
print BS "# Do not edit this file, changes will be lost.\n";
print BS "# This file was automatically generated by the\n";
! print BS "# Mkbootstrap routine in ExtUtils::Mkbootstrap (v$VERSION).\n";
print BS "\@DynaLoader::dl_resolve_using = ";
# If @all contains names in the form -lxxx or -Lxxx then it's asking for
# runtime library location so we automatically add a call to dl_findfile()
diff -c 'perl5.005_02/lib/ExtUtils/Mksymlists.pm' 'perl5.005_03/lib/ExtUtils/Mksymlists.pm'
Index: ./lib/ExtUtils/Mksymlists.pm
*** ./lib/ExtUtils/Mksymlists.pm Thu Jul 23 23:00:41 1998
--- ./lib/ExtUtils/Mksymlists.pm Tue Jan 5 20:17:55 1999
***************
*** 19,28 ****
$spec{DL_VARS} = [] unless $spec{DL_VARS};
($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
$spec{DL_FUNCS} = { $spec{NAME} => [] }
unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
! $spec{FUNCLIST});
! $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
if (defined $spec{DL_FUNCS}) {
my($package);
foreach $package (keys %{$spec{DL_FUNCS}}) {
--- 19,28 ----
$spec{DL_VARS} = [] unless $spec{DL_VARS};
($spec{FILE} = $spec{NAME}) =~ s/.*::// unless $spec{FILE};
+ $spec{FUNCLIST} = [] unless $spec{FUNCLIST};
$spec{DL_FUNCS} = { $spec{NAME} => [] }
unless ( ($spec{DL_FUNCS} and keys %{$spec{DL_FUNCS}}) or
! @{$spec{FUNCLIST}});
if (defined $spec{DL_FUNCS}) {
my($package);
foreach $package (keys %{$spec{DL_FUNCS}}) {
***************
*** 89,98 ****
print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
if (%{$data->{IMPORTS}}) {
print DEF "IMPORTS\n";
! my ($name, $exp);
! while (($name, $exp)= each %{$data->{IMPORTS}}) {
! print DEF " $name=$exp\n";
! }
}
close DEF;
}
--- 89,98 ----
print DEF join("\n ",@{$data->{FUNCLIST}}, "\n") if @{$data->{FUNCLIST}};
if (%{$data->{IMPORTS}}) {
print DEF "IMPORTS\n";
! my ($name, $exp);
! while (($name, $exp)= each %{$data->{IMPORTS}}) {
! print DEF " $name=$exp\n";
! }
}
close DEF;
}
***************
*** 207,216 ****
=over
! =item NAME
! This gives the name of the extension (I<e.g.> Tk::Canvas) for which
! the linker option file will be produced.
=item DL_FUNCS
--- 207,219 ----
=over
! =item DLBASE
! This item specifies the name by which the linker knows the
! extension, which may be different from the name of the
! extension itself (for instance, some linkers add an '_' to the
! name of the extension). If it is not specified, it is derived
! from the NAME attribute. It is presently used only by OS2 and Win32.
=item DL_FUNCS
***************
*** 219,225 ****
associative array, in which each key is the name of a package, and
each value is an a reference to an array of function names which
should be exported by the extension. For instance, one might say
! C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The
function names should be identical to those in the XSUB code;
C<Mksymlists> will alter the names written to the linker option
--- 222,228 ----
associative array, in which each key is the name of a package, and
each value is an a reference to an array of function names which
should be exported by the extension. For instance, one might say
! C<DL_FUNCS =E<gt> { Homer::Iliad =E<gt> [ qw(trojans greeks) ],
Homer::Odyssey =E<gt> [ qw(travellers family suitors) ] }>. The
function names should be identical to those in the XSUB code;
C<Mksymlists> will alter the names written to the linker option
***************
*** 243,249 ****
This key can be used to specify the name of the linker option file
(minus the OS-specific extension), if for some reason you do not
want to use the default value, which is the last word of the NAME
! attribute (I<e.g.> for Tk::Canvas, FILE defaults to 'Canvas').
=item FUNCLIST
--- 246,252 ----
This key can be used to specify the name of the linker option file
(minus the OS-specific extension), if for some reason you do not
want to use the default value, which is the last word of the NAME
! attribute (I<e.g.> for C<Tk::Canvas>, FILE defaults to C<Canvas>).
=item FUNCLIST
***************
*** 251,264 ****
exported from the extension. Its value is a reference to an
array of function names to be exported by the extension. These
names are passed through unaltered to the linker options file.
! =item DLBASE
! This item specifies the name by which the linker knows the
! extension, which may be different from the name of the
! extension itself (for instance, some linkers add an '_' to the
! name of the extension). If it is not specified, it is derived
! from the NAME attribute. It is presently used only by OS2.
=back
--- 254,278 ----
exported from the extension. Its value is a reference to an
array of function names to be exported by the extension. These
names are passed through unaltered to the linker options file.
+ Specifying a value for the FUNCLIST attribute suppresses automatic
+ generation of the bootstrap function for the package. To still create
+ the bootstrap name you have to specify the package name in the
+ DL_FUNCS hash:
! Mksymlists({ NAME => $name ,
! FUNCLIST => [ $func1, $func2 ],
! DL_FUNCS => { $pkg => [] } });
!
! =item IMPORTS
!
! This attribute is used to specify names to be imported into the
! extension. It is currently only used by OS/2 and Win32.
!
! =item NAME
!
! This gives the name of the extension (I<e.g.> C<Tk::Canvas>) for which
! the linker option file will be produced.
=back
***************
*** 269,275 ****
=head1 AUTHOR
! Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>>
=head1 REVISION
--- 283,289 ----
=head1 AUTHOR
! Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>>
=head1 REVISION
diff -c 'perl5.005_02/lib/ExtUtils/typemap' 'perl5.005_03/lib/ExtUtils/typemap'
Index: ./lib/ExtUtils/typemap
*** ./lib/ExtUtils/typemap Thu Jul 23 23:00:41 1998
--- ./lib/ExtUtils/typemap Thu Nov 26 17:51:57 1998
***************
*** 1,12 ****
# $Header$
# basic C types
int T_IV
! unsigned T_IV
! unsigned int T_IV
long T_IV
! unsigned long T_IV
short T_IV
! unsigned short T_IV
char T_CHAR
unsigned char T_U_CHAR
char * T_PV
--- 1,12 ----
# $Header$
# basic C types
int T_IV
! unsigned T_UV
! unsigned int T_UV
long T_IV
! unsigned long T_UV
short T_IV
! unsigned short T_UV
char T_CHAR
unsigned char T_U_CHAR
char * T_PV
***************
*** 34,40 ****
I8 T_IV
U32 T_U_LONG
U16 T_U_SHORT
! U8 T_IV
Result T_U_CHAR
Boolean T_IV
double T_DOUBLE
--- 34,40 ----
I8 T_IV
U32 T_U_LONG
U16 T_U_SHORT
! U8 T_UV
Result T_U_CHAR
Boolean T_IV
double T_DOUBLE
***************
*** 73,78 ****
--- 73,80 ----
croak(\"$var is not of type ${ntype}\")
T_SYSRET
$var NOT IMPLEMENTED
+ T_UV
+ $var = ($type)SvUV($arg)
T_IV
$var = ($type)SvIV($arg)
T_INT
***************
*** 82,100 ****
T_BOOL
$var = (int)SvIV($arg)
T_U_INT
! $var = (unsigned int)SvIV($arg)
T_SHORT
$var = (short)SvIV($arg)
T_U_SHORT
! $var = (unsigned short)SvIV($arg)
T_LONG
$var = (long)SvIV($arg)
T_U_LONG
! $var = (unsigned long)SvIV($arg)
T_CHAR
$var = (char)*SvPV($arg,PL_na)
T_U_CHAR
! $var = (unsigned char)SvIV($arg)
T_FLOAT
$var = (float)SvNV($arg)
T_NV
--- 84,102 ----
T_BOOL
$var = (int)SvIV($arg)
T_U_INT
! $var = (unsigned int)SvUV($arg)
T_SHORT
$var = (short)SvIV($arg)
T_U_SHORT
! $var = (unsigned short)SvUV($arg)
T_LONG
$var = (long)SvIV($arg)
T_U_LONG
! $var = (unsigned long)SvUV($arg)
T_CHAR
$var = (char)*SvPV($arg,PL_na)
T_U_CHAR
! $var = (unsigned char)SvUV($arg)
T_FLOAT
$var = (float)SvNV($arg)
T_NV
***************
*** 191,196 ****
--- 193,200 ----
$arg = newRV((SV*)$var);
T_IV
sv_setiv($arg, (IV)$var);
+ T_UV
+ sv_setuv($arg, (UV)$var);
T_INT
sv_setiv($arg, (IV)$var);
T_SYSRET
***************
*** 205,223 ****
T_BOOL
$arg = boolSV($var);
T_U_INT
! sv_setiv($arg, (IV)$var);
T_SHORT
sv_setiv($arg, (IV)$var);
T_U_SHORT
! sv_setiv($arg, (IV)$var);
T_LONG
sv_setiv($arg, (IV)$var);
T_U_LONG
! sv_setiv($arg, (IV)$var);
T_CHAR
sv_setpvn($arg, (char *)&$var, 1);
T_U_CHAR
! sv_setiv($arg, (IV)$var);
T_FLOAT
sv_setnv($arg, (double)$var);
T_NV
--- 209,227 ----
T_BOOL
$arg = boolSV($var);
T_U_INT
! sv_setuv($arg, (UV)$var);
T_SHORT
sv_setiv($arg, (IV)$var);
T_U_SHORT
! sv_setuv($arg, (UV)$var);
T_LONG
sv_setiv($arg, (IV)$var);
T_U_LONG
! sv_setuv($arg, (UV)$var);
T_CHAR
sv_setpvn($arg, (char *)&$var, 1);
T_U_CHAR
! sv_setuv($arg, (UV)$var);
T_FLOAT
sv_setnv($arg, (double)$var);
T_NV
diff -c 'perl5.005_02/lib/ExtUtils/xsubpp' 'perl5.005_03/lib/ExtUtils/xsubpp'
Index: ./lib/ExtUtils/xsubpp
*** ./lib/ExtUtils/xsubpp Thu Jul 23 23:00:42 1998
--- ./lib/ExtUtils/xsubpp Fri Oct 30 19:15:50 1998
***************
*** 776,782 ****
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
if ($OBJ) {
! s/#if(?:def|\s+defined)\s+(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/;
}
print $_;
}
--- 776,782 ----
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
if ($OBJ) {
! s/#if(?:def\s|\s+defined)\s*(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/;
}
print $_;
}
***************
*** 1254,1283 ****
}
# print initialization routine
! if ($WantCAPI) {
print Q<<"EOF";
- #
##ifdef __cplusplus
#extern "C"
##endif
#XS(boot__CAPI_entry)
! #[[
! # dXSARGS;
! # char* file = __FILE__;
! #
EOF
! } else {
print Q<<"EOF";
- ##ifdef __cplusplus
- #extern "C"
- ##endif
#XS(boot_$Module_cname)
#[[
# dXSARGS;
# char* file = __FILE__;
#
EOF
- }
print Q<<"EOF" if $WantVersionChk ;
# XS_VERSION_BOOTCHECK ;
--- 1254,1290 ----
}
# print initialization routine
!
print Q<<"EOF";
##ifdef __cplusplus
#extern "C"
##endif
+ EOF
+
+ if ($WantCAPI) {
+ print Q<<"EOF";
+ ##ifdef PERL_CAPI
#XS(boot__CAPI_entry)
! ##else
EOF
! }
!
print Q<<"EOF";
#XS(boot_$Module_cname)
+ EOF
+
+ if ($WantCAPI) {
+ print Q<<"EOF";
+ ##endif /* PERL_CAPI */
+ EOF
+ }
+
+ print Q<<"EOF";
#[[
# dXSARGS;
# char* file = __FILE__;
#
EOF
print Q<<"EOF" if $WantVersionChk ;
# XS_VERSION_BOOTCHECK ;
***************
*** 1312,1318 ****
if ($WantCAPI) {
print Q<<"EOF";
! #
##define XSCAPI(name) void name(CV* cv, void* pPerl)
#
##ifdef __cplusplus
--- 1319,1325 ----
if ($WantCAPI) {
print Q<<"EOF";
! ##ifdef PERL_CAPI
##define XSCAPI(name) void name(CV* cv, void* pPerl)
#
##ifdef __cplusplus
***************
*** 1323,1329 ****
# SetCPerlObj(pPerl);
# boot__CAPI_entry(cv);
#]]
! #
EOF
}
--- 1330,1336 ----
# SetCPerlObj(pPerl);
# boot__CAPI_entry(cv);
#]]
! ##endif /* PERL_CAPI */
EOF
}
diff -c 'perl5.005_02/lib/Fatal.pm' 'perl5.005_03/lib/Fatal.pm'
Index: ./lib/Fatal.pm
*** ./lib/Fatal.pm Thu Jul 23 23:00:42 1998
--- ./lib/Fatal.pm Thu Mar 4 18:34:20 1999
***************
*** 111,121 ****
$code .= write_invocation($core, $call, $name, @protos);
$code .= "}\n";
print $code if $Debug;
! $code = eval($code);
! die if $@;
! local($^W) = 0; # to avoid: Subroutine foo redefined ...
! no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ...
! *{$sub} = $code;
}
1;
--- 111,123 ----
$code .= write_invocation($core, $call, $name, @protos);
$code .= "}\n";
print $code if $Debug;
! {
! no strict 'refs'; # to avoid: Can't use string (...) as a symbol ref ...
! $code = eval("package $pkg; use Carp; $code");
! die if $@;
! local($^W) = 0; # to avoid: Subroutine foo redefined ...
! *{$sub} = $code;
! }
}
1;
diff -c 'perl5.005_02/lib/File/Copy.pm' 'perl5.005_03/lib/File/Copy.pm'
Index: ./lib/File/Copy.pm
*** ./lib/File/Copy.pm Thu Jul 23 23:00:43 1998
--- ./lib/File/Copy.pm Wed Jan 6 22:41:53 1999
***************
*** 235,241 ****
files as handles instead of names may lead to loss of information
on some operating systems; it is recommended that you use file
names whenever possible.> Files are opened in binary mode where
! applicable. To get a consistent behavour when copying from a
filehandle to a file, use C<binmode> on the filehandle.
An optional third parameter can be used to specify the buffer
--- 235,241 ----
files as handles instead of names may lead to loss of information
on some operating systems; it is recommended that you use file
names whenever possible.> Files are opened in binary mode where
! applicable. To get a consistent behaviour when copying from a
filehandle to a file, use C<binmode> on the filehandle.
An optional third parameter can be used to specify the buffer
***************
*** 274,280 ****
routine (see below). For OS/2 systems, this calls the C<syscopy>
XSUB directly.
! =head2 Special behavior if C<syscopy> is defined (VMS and OS/2)
If both arguments to C<copy> are not file handles,
then C<copy> will perform a "system copy" of
--- 274,280 ----
routine (see below). For OS/2 systems, this calls the C<syscopy>
XSUB directly.
! =head2 Special behaviour if C<syscopy> is defined (VMS and OS/2)
If both arguments to C<copy> are not file handles,
then C<copy> will perform a "system copy" of
***************
*** 336,342 ****
=head1 AUTHOR
File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
! and updated by Charles Bailey I<E<lt>bailey@genetics.upenn.eduE<gt>> in 1996.
=cut
--- 336,342 ----
=head1 AUTHOR
File::Copy was written by Aaron Sherman I<E<lt>ajs@ajs.comE<gt>> in 1995,
! and updated by Charles Bailey I<E<lt>bailey@newman.upenn.eduE<gt>> in 1996.
=cut
diff -c 'perl5.005_02/lib/File/Find.pm' 'perl5.005_03/lib/File/Find.pm'
Index: ./lib/File/Find.pm
*** ./lib/File/Find.pm Thu Jul 23 23:00:43 1998
--- ./lib/File/Find.pm Sat Oct 31 20:55:13 1998
***************
*** 22,31 ****
=head1 DESCRIPTION
The first argument to find() is either a hash reference describing the
! operations to be performed for each file, or a code reference. If it
! is a hash reference, then the value for the key C<wanted> should be a
! code reference. This code reference is called I<the wanted()
! function> below.
Currently the only other supported key for the above hash is
C<bydepth>, in presense of which the walk over directories is
--- 22,31 ----
=head1 DESCRIPTION
The first argument to find() is either a hash reference describing the
! operations to be performed for each file, a code reference, or a string
! that contains a subroutine name. If it is a hash reference, then the
! value for the key C<wanted> should be a code reference. This code
! reference is called I<the wanted() function> below.
Currently the only other supported key for the above hash is
C<bydepth>, in presense of which the walk over directories is
***************
*** 177,182 ****
--- 177,184 ----
--$subcount;
next if $prune;
+ # Untaint $_, so that we can do a chdir
+ $_ = $1 if /^(.*)/;
if (chdir $_) {
$name =~ s/\.dir$// if $Is_VMS;
&finddir($wanted,$name,$nlink, $bydepth);
***************
*** 194,200 ****
sub wrap_wanted {
my $wanted = shift;
! defined &$wanted ? {wanted => $wanted} : $wanted;
}
sub find {
--- 196,202 ----
sub wrap_wanted {
my $wanted = shift;
! ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted };
}
sub find {
diff -c 'perl5.005_02/lib/File/Path.pm' 'perl5.005_03/lib/File/Path.pm'
Index: ./lib/File/Path.pm
*** ./lib/File/Path.pm Thu Jul 23 23:00:43 1998
--- ./lib/File/Path.pm Sun Oct 25 13:31:38 1998
***************
*** 88,94 ****
=head1 AUTHORS
Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
! Charles Bailey <F<bailey@genetics.upenn.edu>>
=head1 REVISION
--- 88,94 ----
=head1 AUTHORS
Tim Bunce <F<Tim.Bunce@ig.co.uk>> and
! Charles Bailey <F<bailey@newman.upenn.edu>>
=head1 REVISION
***************
*** 135,142 ****
}
print "mkdir $path\n" if $verbose;
unless (mkdir($path,$mode)) {
! # allow for another process to have created it meanwhile
! croak "mkdir $path: $!" unless -d $path;
}
push(@created, $path);
}
--- 135,143 ----
}
print "mkdir $path\n" if $verbose;
unless (mkdir($path,$mode)) {
! my $e = $!;
! # allow for another process to have created it meanwhile
! croak "mkdir $path: $e" unless -d $path;
}
push(@created, $path);
}
diff -c 'perl5.005_02/lib/File/Spec.pm' 'perl5.005_03/lib/File/Spec.pm'
Index: ./lib/File/Spec.pm
*** ./lib/File/Spec.pm Thu Jul 23 23:00:43 1998
--- ./lib/File/Spec.pm Wed Jan 6 22:41:53 1999
***************
*** 91,97 ****
File::Spec->catfile('a','b');
! For a reference of available functions, pleaes consult L<File::Spec::Unix>,
which contains the entire set, and inherited by the modules for other
platforms. For further information, please see L<File::Spec::Mac>,
L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
--- 91,97 ----
File::Spec->catfile('a','b');
! For a reference of available functions, please consult L<File::Spec::Unix>,
which contains the entire set, and inherited by the modules for other
platforms. For further information, please see L<File::Spec::Mac>,
L<File::Spec::OS2>, L<File::Spec::Win32>, or L<File::Spec::VMS>.
***************
*** 106,112 ****
Kenneth Albanowski <F<kjahds@kjahds.com>>, Andy Dougherty
<F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>. VMS
! support by Charles Bailey <F<bailey@genetics.upenn.edu>>. OS/2 support by
Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Mac support by Paul Schinder
<F<schinder@pobox.com>>.
--- 106,112 ----
Kenneth Albanowski <F<kjahds@kjahds.com>>, Andy Dougherty
<F<doughera@lafcol.lafayette.edu>>, Andreas KE<ouml>nig
<F<A.Koenig@franz.ww.TU-Berlin.DE>>, Tim Bunce <F<Tim.Bunce@ig.co.uk>>. VMS
! support by Charles Bailey <F<bailey@newman.upenn.edu>>. OS/2 support by
Ilya Zakharevich <F<ilya@math.ohio-state.edu>>. Mac support by Paul Schinder
<F<schinder@pobox.com>>.
diff -c 'perl5.005_02/lib/File/Spec/Mac.pm' 'perl5.005_03/lib/File/Spec/Mac.pm'
Index: ./lib/File/Spec/Mac.pm
*** ./lib/File/Spec/Mac.pm Thu Jul 23 23:00:43 1998
--- ./lib/File/Spec/Mac.pm Wed Jan 6 22:41:53 1999
***************
*** 52,58 ****
File::Spec->catdir(split(":",$path)) eq $path
But because of the nature of Macintosh paths, some additional
! possibilities are allowed to make using this routine give resonable results
for some common situations. Here are the rules that are used. Each
argument has its trailing ":" removed. Each argument, except the first,
has its leading ":" removed. They are then joined together by a ":".
--- 52,58 ----
File::Spec->catdir(split(":",$path)) eq $path
But because of the nature of Macintosh paths, some additional
! possibilities are allowed to make using this routine give reasonable results
for some common situations. Here are the rules that are used. Each
argument has its trailing ":" removed. Each argument, except the first,
has its leading ":" removed. They are then joined together by a ":".
***************
*** 78,84 ****
File::Spec->catfile("LWP","Protocol","http.pm")
be relative or absolute? There's no way of telling except by checking for the
! existance of LWP: or :LWP, and even there he may mean a dismounted volume or
a relative path in a different directory (like in @INC). So those checks
aren't done here. This routine will treat this as absolute.
--- 78,84 ----
File::Spec->catfile("LWP","Protocol","http.pm")
be relative or absolute? There's no way of telling except by checking for the
! existence of LWP: or :LWP, and even there he may mean a dismounted volume or
a relative path in a different directory (like in @INC). So those checks
aren't done here. This routine will treat this as absolute.
diff -c 'perl5.005_02/lib/FindBin.pm' 'perl5.005_03/lib/FindBin.pm'
Index: ./lib/FindBin.pm
*** ./lib/FindBin.pm Thu Jul 23 23:00:44 1998
--- ./lib/FindBin.pm Thu Jan 21 19:54:12 1999
***************
*** 55,61 ****
=head1 AUTHORS
! Graham Barr E<lt>F<bodg@tiuk.ti.com>E<gt>
Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
=head1 COPYRIGHT
--- 55,64 ----
=head1 AUTHORS
! FindBin is supported as part of the core perl distribution. Please send bug
! reports to E<lt>F<perlbug@perl.org>E<gt> using the perlbug program included with perl.
!
! Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>
=head1 COPYRIGHT
***************
*** 64,73 ****
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
- =head1 REVISION
-
- $Revision: 1.4 $
-
=cut
package FindBin;
--- 67,72 ----
***************
*** 77,107 ****
use Cwd qw(getcwd abs_path);
use Config;
use File::Basename;
@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
@ISA = qw(Exporter);
! $VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.41 $ =~ /(\d+)\.(\d+)/);
!
! sub is_abs_path
! {
! local $_ = shift if (@_);
! if ($^O eq 'MSWin32' || $^O eq 'dos')
! {
! return m#^[a-z]:[\\/]#i;
! }
! elsif ($^O eq 'VMS')
! {
! # If it's a logical name, expand it.
! $_ = $ENV{$_} while /^[\w\$\-]+$/ and $ENV{$_};
! return m!^/! or m![<\[][^.\-\]>]! or /:[^<\[]/;
! }
! else
! {
! return m#^/#;
! }
! }
BEGIN
{
--- 76,88 ----
use Cwd qw(getcwd abs_path);
use Config;
use File::Basename;
+ use File::Spec;
@EXPORT_OK = qw($Bin $Script $RealBin $RealScript $Dir $RealDir);
%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
@ISA = qw(Exporter);
! $VERSION = $VERSION = "1.42";
BEGIN
{
***************
*** 131,143 ****
&& -f $script)
{
my $dir;
! my $pathvar = 'PATH';
!
! foreach $dir (split(/$Config{'path_sep'}/,$ENV{$pathvar}))
{
! if(-r "$dir/$script" && (!$IsWin32 || -x _))
{
! $script = "$dir/$script";
if (-f $0)
{
--- 112,123 ----
&& -f $script)
{
my $dir;
! foreach $dir (File::Spec->path)
{
! my $scr = File::Spec->catfile($dir, $script);
! if(-r $scr && (!$IsWin32 || -x _))
{
! $script = $scr;
if (-f $0)
{
***************
*** 160,166 ****
# Ensure $script contains the complete path incase we C<chdir>
! $script = getcwd() . "/" . $script unless is_abs_path($script);
($Script,$Bin) = fileparse($script);
--- 140,147 ----
# Ensure $script contains the complete path incase we C<chdir>
! $script = File::Spec->catfile(getcwd(), $script)
! unless File::Spec->file_name_is_absolute($script);
($Script,$Bin) = fileparse($script);
***************
*** 172,180 ****
($RealScript,$RealBin) = fileparse($script);
last unless defined $linktext;
! $script = (is_abs_path($linktext))
? $linktext
! : $RealBin . "/" . $linktext;
}
# Get absolute paths to directories
--- 153,161 ----
($RealScript,$RealBin) = fileparse($script);
last unless defined $linktext;
! $script = (File::Spec->file_name_is_absolute($linktext))
? $linktext
! : File::Spec->catfile($RealBin, $linktext);
}
# Get absolute paths to directories
diff -c 'perl5.005_02/lib/Getopt/Long.pm' 'perl5.005_03/lib/Getopt/Long.pm'
Index: ./lib/Getopt/Long.pm
Prereq: 2.18
*** ./lib/Getopt/Long.pm Thu Jul 23 23:00:45 1998
--- ./lib/Getopt/Long.pm Sat Jan 23 17:41:48 1999
***************
*** 6,18 ****
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
! # Last Modified On: Sun Jun 14 13:17:22 1998
! # Update Count : 705
# Status : Released
################ Copyright ################
! # This program is Copyright 1990,1998 by Johan Vromans.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
--- 6,18 ----
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
! # Last Modified On: Fri Jan 8 14:48:43 1999
! # Update Count : 707
# Status : Released
################ Copyright ################
! # This program is Copyright 1990,1999 by Johan Vromans.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
***************
*** 35,41 ****
require 5.004;
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
! $VERSION = "2.17";
@ISA = qw(Exporter);
@EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
--- 35,41 ----
require 5.004;
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
! $VERSION = "2.19";
@ISA = qw(Exporter);
@EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
***************
*** 547,552 ****
--- 547,553 ----
# If bundling == 2, long options can override bundles.
if ( $bundling == 2 and
+ defined ($rest) and
defined ($type = $opctl->{$tryopt.$rest}) ) {
print STDERR ("=> $starter$tryopt rebundled to ",
"$starter$tryopt$rest\n") if $debug;
***************
*** 1363,1369 ****
=head1 COPYRIGHT AND DISCLAIMER
! This program is Copyright 1990,1998 by Johan Vromans.
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
--- 1364,1370 ----
=head1 COPYRIGHT AND DISCLAIMER
! This program is Copyright 1990,1999 by Johan Vromans.
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
diff -c 'perl5.005_02/lib/Getopt/Std.pm' 'perl5.005_03/lib/Getopt/Std.pm'
Index: ./lib/Getopt/Std.pm
*** ./lib/Getopt/Std.pm Thu Jul 23 23:00:45 1998
--- ./lib/Getopt/Std.pm Thu Mar 4 18:34:21 1999
***************
*** 42,49 ****
@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
!
! # $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
# Process single-character switches with switch clustering. Pass one argument
# which is a string containing all switches that take an argument. For each
--- 42,48 ----
@ISA = qw(Exporter);
@EXPORT = qw(getopt getopts);
! $VERSION = $VERSION = '1.01';
# Process single-character switches with switch clustering. Pass one argument
# which is a string containing all switches that take an argument. For each
***************
*** 145,151 ****
}
}
else {
! print STDERR "Unknown option: $first\n";
++$errs;
if($rest ne '') {
$ARGV[0] = "-$rest";
--- 144,150 ----
}
}
else {
! warn "Unknown option: $first\n";
++$errs;
if($rest ne '') {
$ARGV[0] = "-$rest";
diff -c 'perl5.005_02/lib/IPC/Open3.pm' 'perl5.005_03/lib/IPC/Open3.pm'
Index: ./lib/IPC/Open3.pm
Prereq: 1.1
*** ./lib/IPC/Open3.pm Thu Jul 23 23:00:45 1998
--- ./lib/IPC/Open3.pm Thu Oct 15 21:44:41 1998
***************
*** 2,16 ****
use strict;
no strict 'refs'; # because users pass me bareword filehandles
! use vars qw($VERSION @ISA @EXPORT $Fh $Me);
require 5.001;
require Exporter;
use Carp;
! use Symbol 'qualify';
! $VERSION = 1.0102;
@ISA = qw(Exporter);
@EXPORT = qw(open3);
--- 2,16 ----
use strict;
no strict 'refs'; # because users pass me bareword filehandles
! use vars qw($VERSION @ISA @EXPORT $Me);
require 5.001;
require Exporter;
use Carp;
! use Symbol qw(gensym qualify);
! $VERSION = 1.0103;
@ISA = qw(Exporter);
@EXPORT = qw(open3);
***************
*** 94,100 ****
# rdr or wtr are null
# a system call fails
- $Fh = 'FHOPEN000'; # package static in case called more than once
$Me = 'open3 (bug)'; # you should never see this, it's always localized
# Fatal.pm needs to be fixed WRT prototypes.
--- 94,99 ----
***************
*** 140,148 ****
$dad_rdr = qualify $dad_rdr, $package;
$dad_err = qualify $dad_err, $package;
! my $kid_rdr = ++$Fh;
! my $kid_wtr = ++$Fh;
! my $kid_err = ++$Fh;
xpipe $kid_rdr, $dad_wtr if !$dup_wtr;
xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
--- 139,147 ----
$dad_rdr = qualify $dad_rdr, $package;
$dad_err = qualify $dad_err, $package;
! my $kid_rdr = gensym;
! my $kid_wtr = gensym;
! my $kid_err = gensym;
xpipe $kid_rdr, $dad_wtr if !$dup_wtr;
xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
***************
*** 154,160 ****
# save a copy of her stdout before I put something else there.
if ($dad_rdr ne $dad_err && $dup_err
&& fileno($dad_err) == fileno(STDOUT)) {
! my $tmp = ++$Fh;
xopen($tmp, ">&$dad_err");
$dad_err = $tmp;
}
--- 153,159 ----
# save a copy of her stdout before I put something else there.
if ($dad_rdr ne $dad_err && $dup_err
&& fileno($dad_err) == fileno(STDOUT)) {
! my $tmp = gensym;
xopen($tmp, ">&$dad_err");
$dad_err = $tmp;
}
***************
*** 163,186 ****
xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
} else {
xclose $dad_wtr;
! xopen \*STDIN, "<&$kid_rdr";
! xclose $kid_rdr;
}
if ($dup_rdr) {
xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
} else {
xclose $dad_rdr;
! xopen \*STDOUT, ">&$kid_wtr";
! xclose $kid_wtr;
}
if ($dad_rdr ne $dad_err) {
if ($dup_err) {
! xopen \*STDERR, ">&$dad_err"
if fileno(STDERR) != fileno($dad_err);
} else {
xclose $dad_err;
! xopen \*STDERR, ">&$kid_err";
! xclose $kid_err;
}
} else {
xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
--- 162,185 ----
xopen \*STDIN, "<&$dad_wtr" if fileno(STDIN) != fileno($dad_wtr);
} else {
xclose $dad_wtr;
! xopen \*STDIN, "<&=" . fileno $kid_rdr;
}
if ($dup_rdr) {
xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != fileno($dad_rdr);
} else {
xclose $dad_rdr;
! xopen \*STDOUT, ">&=" . fileno $kid_wtr;
}
if ($dad_rdr ne $dad_err) {
if ($dup_err) {
! # I have to use a fileno here because in this one case
! # I'm doing a dup but the filehandle might be a reference
! # (from the special case above).
! xopen \*STDERR, ">&" . fileno $dad_err
if fileno(STDERR) != fileno($dad_err);
} else {
xclose $dad_err;
! xopen \*STDERR, ">&=" . fileno $kid_err;
}
} else {
xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
***************
*** 194,216 ****
my @close;
if ($dup_wtr) {
! $kid_rdr = $dad_wtr;
! push @close, \*{$kid_rdr};
} else {
! push @close, \*{$dad_wtr}, \*{$kid_rdr};
}
if ($dup_rdr) {
! $kid_wtr = $dad_rdr;
! push @close, \*{$kid_wtr};
} else {
! push @close, \*{$dad_rdr}, \*{$kid_wtr};
}
if ($dad_rdr ne $dad_err) {
if ($dup_err) {
! $kid_err = $dad_err ;
! push @close, \*{$kid_err};
} else {
! push @close, \*{$dad_err}, \*{$kid_err};
}
} else {
$kid_err = $kid_wtr;
--- 193,215 ----
my @close;
if ($dup_wtr) {
! $kid_rdr = \*{$dad_wtr};
! push @close, $kid_rdr;
} else {
! push @close, \*{$dad_wtr}, $kid_rdr;
}
if ($dup_rdr) {
! $kid_wtr = \*{$dad_rdr};
! push @close, $kid_wtr;
} else {
! push @close, \*{$dad_rdr}, $kid_wtr;
}
if ($dad_rdr ne $dad_err) {
if ($dup_err) {
! $kid_err = \*{$dad_err};
! push @close, $kid_err;
} else {
! push @close, \*{$dad_err}, $kid_err;
}
} else {
$kid_err = $kid_wtr;
***************
*** 218,230 ****
require IO::Pipe;
$kidpid = eval {
spawn_with_handles( [ { mode => 'r',
! open_as => \*{$kid_rdr},
handle => \*STDIN },
{ mode => 'w',
! open_as => \*{$kid_wtr},
handle => \*STDOUT },
{ mode => 'w',
! open_as => \*{$kid_err},
handle => \*STDERR },
], \@close, @cmd);
};
--- 217,229 ----
require IO::Pipe;
$kidpid = eval {
spawn_with_handles( [ { mode => 'r',
! open_as => $kid_rdr,
handle => \*STDIN },
{ mode => 'w',
! open_as => $kid_wtr,
handle => \*STDOUT },
{ mode => 'w',
! open_as => $kid_err,
handle => \*STDERR },
], \@close, @cmd);
};
diff -c 'perl5.005_02/lib/Math/BigFloat.pm' 'perl5.005_03/lib/Math/BigFloat.pm'
Index: ./lib/Math/BigFloat.pm
*** ./lib/Math/BigFloat.pm Thu Jul 23 23:00:45 1998
--- ./lib/Math/BigFloat.pm Wed Jan 6 22:41:53 1999
***************
*** 301,307 ****
=item number format
canonical strings have the form /[+-]\d+E[+-]\d+/ . Input values can
! have inbedded whitespace.
=item Error returns 'NaN'
--- 301,307 ----
=item number format
canonical strings have the form /[+-]\d+E[+-]\d+/ . Input values can
! have imbedded whitespace.
=item Error returns 'NaN'
diff -c 'perl5.005_02/lib/Math/BigInt.pm' 'perl5.005_03/lib/Math/BigInt.pm'
Index: ./lib/Math/BigInt.pm
*** ./lib/Math/BigInt.pm Sat Jul 25 21:08:46 1998
--- ./lib/Math/BigInt.pm Wed Jan 6 22:41:53 1999
***************
*** 258,266 ****
else {
push(@x, 0);
}
! @q = (); ($v2,$v1) = @y[-2,-1];
while ($#x > $#y) {
! ($u2,$u1,$u0) = @x[-3..-1];
$q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
if ($q) {
--- 258,266 ----
else {
push(@x, 0);
}
! @q = (); ($v2,$v1) = ($y[-2] || 0, $y[-1]);
while ($#x > $#y) {
! ($u2,$u1,$u0) = ($x[-3] || 0, $x[-2] || 0, $x[-1]);
$q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1));
--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
if ($q) {
***************
*** 400,407 ****
perl -MMath::BigInt=:constant -e 'print 2**100'
! print the integer value of C<2**100>. Note that without convertion of
! constants the expression 2**100 will be calculatted as floating point number.
=head1 BUGS
--- 400,407 ----
perl -MMath::BigInt=:constant -e 'print 2**100'
! print the integer value of C<2**100>. Note that without conversion of
! constants the expression 2**100 will be calculated as floating point number.
=head1 BUGS
diff -c 'perl5.005_02/lib/Math/Complex.pm' 'perl5.005_03/lib/Math/Complex.pm'
Index: ./lib/Math/Complex.pm
Prereq: 1.25
*** ./lib/Math/Complex.pm Sat Aug 1 22:42:27 1998
--- ./lib/Math/Complex.pm Thu Nov 26 08:54:06 1998
***************
*** 14,20 ****
my ( $i, $ip2, %logn );
! $VERSION = sprintf("%s", q$Id: Complex.pm,v 1.25 1998/02/05 16:07:37 jhi Exp $ =~ /(\d+\.\d+)/);
@ISA = qw(Exporter);
--- 14,20 ----
my ( $i, $ip2, %logn );
! $VERSION = sprintf("%s", q$Id: Complex.pm,v 1.26 1998/11/01 00:00:00 dsl Exp $ =~ /(\d+\.\d+)/);
@ISA = qw(Exporter);
***************
*** 401,438 ****
}
#
- # _zerotozero
- #
- # Die on zero raised to the zeroth.
- #
- sub _zerotozero {
- my $mess = "The zero raised to the zeroth power is not defined.\n";
-
- my @up = caller(1);
-
- $mess .= "Died at $up[1] line $up[2].\n";
-
- die $mess;
- }
-
- #
# (power)
#
# Computes z1**z2 = exp(z2 * log z1)).
#
sub power {
my ($z1, $z2, $inverted) = @_;
- my $z1z = $z1 == 0;
- my $z2z = $z2 == 0;
- _zerotozero if ($z1z and $z2z);
if ($inverted) {
! return 0 if ($z2z);
! return 1 if ($z1z or $z2 == 1);
} else {
! return 0 if ($z1z);
! return 1 if ($z2z or $z1 == 1);
}
! my $w = $inverted ? CORE::exp($z1 * CORE::log($z2)) : CORE::exp($z2 * CORE::log($z1));
# If both arguments cartesian, return cartesian, else polar.
return $z1->{c_dirty} == 0 &&
(not ref $z2 or $z2->{c_dirty} == 0) ?
--- 401,421 ----
}
#
# (power)
#
# Computes z1**z2 = exp(z2 * log z1)).
#
sub power {
my ($z1, $z2, $inverted) = @_;
if ($inverted) {
! return 1 if $z1 == 0 || $z2 == 1;
! return 0 if $z2 == 0 && Re($z1) > 0;
} else {
! return 1 if $z2 == 0 || $z1 == 1;
! return 0 if $z1 == 0 && Re($z2) > 0;
}
! my $w = $inverted ? CORE::exp($z1 * CORE::log($z2))
! : CORE::exp($z2 * CORE::log($z1));
# If both arguments cartesian, return cartesian, else polar.
return $z1->{c_dirty} == 0 &&
(not ref $z2 or $z2->{c_dirty} == 0) ?
***************
*** 443,449 ****
# (spaceship)
#
# Computes z1 <=> z2.
! # Sorts on the real part first, then on the imaginary part. Thus 2-4i > 3+8i.
#
sub spaceship {
my ($z1, $z2, $inverted) = @_;
--- 426,432 ----
# (spaceship)
#
# Computes z1 <=> z2.
! # Sorts on the real part first, then on the imaginary part. Thus 2-4i < 3+8i.
#
sub spaceship {
my ($z1, $z2, $inverted) = @_;
***************
*** 1273,1279 ****
my ($a, $b) = @_;
my $id = "$a $b";
!
unless (exists $gcd{$id}) {
$gcd{$id} = _gcd($a, $b);
$gcd{"$b $a"} = $gcd{$id};
--- 1256,1262 ----
my ($a, $b) = @_;
my $id = "$a $b";
!
unless (exists $gcd{$id}) {
$gcd{$id} = _gcd($a, $b);
$gcd{"$b $a"} = $gcd{$id};
***************
*** 1702,1708 ****
The division (/) and the following functions
log ln log10 logn
! tan sec csc cot
atan asec acsc acot
tanh sech csch coth
atanh asech acsch acoth
--- 1685,1691 ----
The division (/) and the following functions
log ln log10 logn
! tan sec csc cot
atan asec acsc acot
tanh sech csch coth
atanh asech acsch acoth
diff -c 'perl5.005_02/lib/Math/Trig.pm' 'perl5.005_03/lib/Math/Trig.pm'
Index: ./lib/Math/Trig.pm
*** ./lib/Math/Trig.pm Thu Jul 23 23:00:47 1998
--- ./lib/Math/Trig.pm Thu Feb 11 18:06:01 1999
***************
*** 314,322 ****
coordinate. The angle from the I<z>-axis is B<phi>, also known as the
I<polar> coordinate. The `North Pole' is therefore I<0, 0, rho>, and
the `Bay of Guinea' (think of the missing big chunk of Africa) I<0,
! pi/2, rho>.
! B<Beware>: some texts define I<theta> and I<phi> the other way round,
some texts define the I<phi> to start from the horizontal plane, some
texts use I<r> in place of I<rho>.
--- 314,324 ----
coordinate. The angle from the I<z>-axis is B<phi>, also known as the
I<polar> coordinate. The `North Pole' is therefore I<0, 0, rho>, and
the `Bay of Guinea' (think of the missing big chunk of Africa) I<0,
! pi/2, rho>. In geographical terms I<phi> is latitude (northward
! positive, southward negative) and I<theta> is longitude (eastward
! positive, westward negative).
! B<BEWARE>: some texts define I<theta> and I<phi> the other way round,
some texts define the I<phi> to start from the horizontal plane, some
texts use I<r> in place of I<rho>.
***************
*** 374,386 ****
use Math::Trig 'great_circle_distance'
! $distance = great_circle_distance($theta0, $phi0, $theta1, $phi, [, $rho]);
The I<great circle distance> is the shortest distance between two
points on a sphere. The distance is in C<$rho> units. The C<$rho> is
optional, it defaults to 1 (the unit sphere), therefore the distance
defaults to radians.
=head1 EXAMPLES
To calculate the distance between London (51.3N 0.5W) and Tokyo (35.7N
--- 376,400 ----
use Math::Trig 'great_circle_distance'
! $distance = great_circle_distance($theta0, $phi0, $theta1, $phi1, [, $rho]);
The I<great circle distance> is the shortest distance between two
points on a sphere. The distance is in C<$rho> units. The C<$rho> is
optional, it defaults to 1 (the unit sphere), therefore the distance
defaults to radians.
+ If you think geographically the I<theta> are longitudes: zero at the
+ Greenwhich meridian, eastward positive, westward negative--and the
+ I<phi> are latitudes: zero at the North Pole, northward positive,
+ southward negative. B<NOTE>: this formula thinks in mathematics, not
+ geographically: the I<phi> zero is at the North Pole, not at the
+ Equator on the west coast of Africa (Bay of Guinea). You need to
+ subtract your geographical coordinates from I<pi/2> (also known as 90
+ degrees).
+
+ $distance = great_circle_distance($lon0, pi/2 - $lat0,
+ $lon1, pi/2 - $lat1, $rho);
+
=head1 EXAMPLES
To calculate the distance between London (51.3N 0.5W) and Tokyo (35.7N
***************
*** 394,401 ****
$km = great_circle_distance(@L, @T, 6378);
! The answer may be off by up to 0.3% because of the irregular (slightly
! aspherical) form of the Earth.
=head1 BUGS
--- 408,415 ----
$km = great_circle_distance(@L, @T, 6378);
! The answer may be off by few percentages because of the irregular
! (slightly aspherical) form of the Earth.
=head1 BUGS
diff -c 'perl5.005_02/lib/Net/hostent.pm' 'perl5.005_03/lib/Net/hostent.pm'
Index: ./lib/Net/hostent.pm
*** ./lib/Net/hostent.pm Thu Jul 23 23:00:47 1998
--- ./lib/Net/hostent.pm Wed Jan 6 22:41:53 1999
***************
*** 89,95 ****
regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
}> would be simply @h_aliases.
! The gethost() funtion is a simple front-end that forwards a numeric
argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
to gethostbyname().
--- 89,95 ----
regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
}> would be simply @h_aliases.
! The gethost() function is a simple front-end that forwards a numeric
argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
to gethostbyname().
diff -c 'perl5.005_02/lib/Net/netent.pm' 'perl5.005_03/lib/Net/netent.pm'
Index: ./lib/Net/netent.pm
*** ./lib/Net/netent.pm Thu Jul 23 23:00:47 1998
--- ./lib/Net/netent.pm Wed Jan 6 22:41:53 1999
***************
*** 92,98 ****
regular array variables, so for example C<@{ $net_obj-E<gt>aliases()
}> would be simply @n_aliases.
! The getnet() funtion is a simple front-end that forwards a numeric
argument to getnetbyaddr(), and the rest
to getnetbyname().
--- 92,98 ----
regular array variables, so for example C<@{ $net_obj-E<gt>aliases()
}> would be simply @n_aliases.
! The getnet() function is a simple front-end that forwards a numeric
argument to getnetbyaddr(), and the rest
to getnetbyname().
diff -c 'perl5.005_02/lib/Pod/Html.pm' 'perl5.005_03/lib/Pod/Html.pm'
Index: ./lib/Pod/Html.pm
*** ./lib/Pod/Html.pm Tue Aug 4 14:59:32 1998
--- ./lib/Pod/Html.pm Sat Dec 12 10:14:08 1998
***************
*** 11,16 ****
--- 11,18 ----
use Carp;
+ use locale; # make \w work right in non-ASCII lands
+
use strict;
use Config;
***************
*** 300,317 ****
open(HTML, ">$htmlfile")
|| die "$0: cannot open $htmlfile file for output: $!\n";
! # put a title in the HTML file
! $title = '';
! TITLE_SEARCH: {
! for (my $i = 0; $i < @poddata; $i++) {
! if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
! for my $para ( @poddata[$i, $i+1] ) {
! last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
! }
! }
! }
! }
if (!$title and $podfile =~ /\.pod$/) {
# probably a split pod so take first =head[12] as title
for (my $i = 0; $i < @poddata; $i++) {
--- 302,321 ----
open(HTML, ">$htmlfile")
|| die "$0: cannot open $htmlfile file for output: $!\n";
! # put a title in the HTML file if one wasn't specified
! if ($title eq '') {
! TITLE_SEARCH: {
! for (my $i = 0; $i < @poddata; $i++) {
! if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
! for my $para ( @poddata[$i, $i+1] ) {
! last TITLE_SEARCH
! if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
! }
! }
! }
! }
! }
if (!$title and $podfile =~ /\.pod$/) {
# probably a split pod so take first =head[12] as title
for (my $i = 0; $i < @poddata; $i++) {
***************
*** 1371,1379 ****
# LREF: a la HREF L<show this text|man/section>
$linktext = $1 if s:^([^|]+)\|::;
- # a :: acts like a /
- s,::,/,;
-
# make sure sections start with a /
s,^",/",g;
s,^,/,g if (!m,/, && / /);
--- 1375,1380 ----
***************
*** 1397,1402 ****
--- 1398,1408 ----
if ($page eq "") {
$link = "#" . htmlify(0,$section);
$linktext = $section unless defined($linktext);
+ } elsif ( $page =~ /::/ ) {
+ $linktext = ($section ? "$section" : "$page");
+ $page =~ s,::,/,g;
+ $link = "$htmlroot/$page.html";
+ $link .= "#" . htmlify(0,$section) if ($section);
} elsif (!defined $pages{$page}) {
warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
$link = "";
diff -c 'perl5.005_02/lib/Pod/Text.pm' 'perl5.005_03/lib/Pod/Text.pm'
Index: ./lib/Pod/Text.pm
*** ./lib/Pod/Text.pm Thu Jul 23 23:00:49 1998
--- ./lib/Pod/Text.pm Thu Mar 4 18:34:22 1999
***************
*** 52,57 ****
--- 52,59 ----
use vars qw($VERSION);
$VERSION = "1.0203";
+ use locale; # make \w work right in non-ASCII lands
+
$termcap=0;
$opt_alt_format = 0;
***************
*** 273,286 ****
my $paratag = $_;
$_ = <IN>;
if (/^=/) { # tricked!
! local($indent) = $indent[$#index - 1] || $DEF_INDENT;
output($paratag);
redo POD_DIRECTIVE;
}
&prepare_for_output;
IP_output($paratag, $_);
} else {
! local($indent) = $indent[$#index - 1] || $DEF_INDENT;
output($_, 0);
}
}
--- 275,288 ----
my $paratag = $_;
$_ = <IN>;
if (/^=/) { # tricked!
! local($indent) = $indent[$#indent - 1] || $DEF_INDENT;
output($paratag);
redo POD_DIRECTIVE;
}
&prepare_for_output;
IP_output($paratag, $_);
} else {
! local($indent) = $indent[$#indent - 1] || $DEF_INDENT;
output($_, 0);
}
}
***************
*** 368,374 ****
sub IP_output {
local($tag, $_) = @_;
! local($tag_indent) = $indent[$#index - 1] || $DEF_INDENT;
$tag_cols = $SCREEN - $tag_indent;
$cols = $SCREEN - $indent;
$tag =~ s/\s*$//;
--- 370,376 ----
sub IP_output {
local($tag, $_) = @_;
! local($tag_indent) = $indent[$#indent - 1] || $DEF_INDENT;
$tag_cols = $SCREEN - $tag_indent;
$cols = $SCREEN - $indent;
$tag =~ s/\s*$//;
diff -c 'perl5.005_02/lib/SelfLoader.pm' 'perl5.005_03/lib/SelfLoader.pm'
Index: ./lib/SelfLoader.pm
*** ./lib/SelfLoader.pm Thu Jul 23 23:00:50 1998
--- ./lib/SelfLoader.pm Thu Jan 21 19:03:55 1999
***************
*** 133,139 ****
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.
The C<__DATA__> token is not recognized in versions of perl prior to
5.001m.
--- 133,139 ----
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 retrievable, whereas data after C<__DATA__> is.
The C<__DATA__> token is not recognized in versions of perl prior to
5.001m.
***************
*** 203,209 ****
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
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
--- 203,209 ----
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 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 -c 'perl5.005_02/lib/Symbol.pm' 'perl5.005_03/lib/Symbol.pm'
Index: ./lib/Symbol.pm
*** ./lib/Symbol.pm Thu Jul 23 23:00:50 1998
--- ./lib/Symbol.pm Thu Jan 21 19:03:55 1999
***************
*** 46,52 ****
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
"main::".
Qualification applies only to symbol names (strings). References are
--- 46,52 ----
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 qualified with
"main::".
Qualification applies only to symbol names (strings). References are
diff -c 'perl5.005_02/lib/Term/Complete.pm' 'perl5.005_03/lib/Term/Complete.pm'
Index: ./lib/Term/Complete.pm
*** ./lib/Term/Complete.pm Thu Jul 23 23:00:51 1998
--- ./lib/Term/Complete.pm Wed Jan 6 22:41:53 1999
***************
*** 5,11 ****
@ISA = qw(Exporter);
@EXPORT = qw(Complete);
! # @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91
=head1 NAME
--- 5,11 ----
@ISA = qw(Exporter);
@EXPORT = qw(Complete);
! # @(#)complete.pl,v1.2 (me@anywhere.EBay.Sun.COM) 09/23/91
=head1 NAME
***************
*** 13,20 ****
=head1 SYNOPSIS
! $input = complete('prompt_string', \@completion_list);
! $input = complete('prompt_string', @completion_list);
=head1 DESCRIPTION
--- 13,20 ----
=head1 SYNOPSIS
! $input = Complete('prompt_string', \@completion_list);
! $input = Complete('prompt_string', @completion_list);
=head1 DESCRIPTION
***************
*** 56,62 ****
=head1 BUGS
! The completion charater E<lt>tabE<gt> cannot be changed.
=head1 AUTHOR
--- 56,62 ----
=head1 BUGS
! The completion character E<lt>tabE<gt> cannot be changed.
=head1 AUTHOR
***************
*** 72,78 ****
}
sub Complete {
! my($prompt, @cmp_list, $return, @match, $l, $test, $cmp, $r);
$prompt = shift;
if (ref $_[0] || $_[0] =~ /^\*/) {
--- 72,82 ----
}
sub Complete {
! my($prompt, @cmp_list, $cmp, $test, $l, @match);
! my ($return, $r) = ("", 0);
!
! $return = "";
! $r = 0;
$prompt = shift;
if (ref $_[0] || $_[0] =~ /^\*/) {
***************
*** 90,106 ****
# (TAB) attempt completion
$_ eq "\t" && do {
@match = grep(/^$return/, @cmp_lst);
- $l = length($test = shift(@match));
unless ($#match < 0) {
foreach $cmp (@match) {
until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
$l--;
}
}
print("\a");
}
- print($test = substr($test, $r, $l - $r));
- $r = length($return .= $test);
last CASE;
};
--- 94,110 ----
# (TAB) attempt completion
$_ eq "\t" && do {
@match = grep(/^$return/, @cmp_lst);
unless ($#match < 0) {
+ $l = length($test = shift(@match));
foreach $cmp (@match) {
until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
$l--;
}
}
print("\a");
+ print($test = substr($test, $r, $l - $r));
+ $r = length($return .= $test);
}
last CASE;
};
***************
*** 113,120 ****
# (^U) kill
$_ eq $kill && do {
if ($r) {
! undef $r;
! undef $return;
print("\r\n");
redo LOOP;
}
--- 117,124 ----
# (^U) kill
$_ eq $kill && do {
if ($r) {
! $r = 0;
! $return = "";
print("\r\n");
redo LOOP;
}
diff -c 'perl5.005_02/lib/Term/ReadLine.pm' 'perl5.005_03/lib/Term/ReadLine.pm'
Index: ./lib/Term/ReadLine.pm
*** ./lib/Term/ReadLine.pm Thu Jul 23 23:00:51 1998
--- ./lib/Term/ReadLine.pm Wed Jan 6 22:41:53 1999
***************
*** 139,145 ****
=head1 ENVIRONMENT
! The envrironment variable C<PERL_RL> governs which ReadLine clone is
loaded. If the value is false, a dummy interface is used. If the value
is true, it should be tail of the name of the package to use, such as
C<Perl> or C<Gnu>.
--- 139,145 ----
=head1 ENVIRONMENT
! The environment variable C<PERL_RL> governs which ReadLine clone is
loaded. If the value is false, a dummy interface is used. If the value
is true, it should be tail of the name of the package to use, such as
C<Perl> or C<Gnu>.
diff -c 'perl5.005_02/lib/Test.pm' 'perl5.005_03/lib/Test.pm'
Index: ./lib/Test.pm
*** ./lib/Test.pm Fri Aug 7 16:40:39 1998
--- ./lib/Test.pm Sat Mar 27 11:27:46 1999
***************
*** 2,18 ****
package Test;
use Test::Harness 1.1601 ();
use Carp;
! use vars (qw($VERSION @ISA @EXPORT $ntest $TestLevel), #public-ish
! qw($ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish
! $VERSION = '1.04';
require Exporter;
@ISA=('Exporter');
! @EXPORT= qw(&plan &ok &skip $ntest);
$TestLevel = 0; # how many extra stack frames to skip
$|=1;
#$^W=1; ?
$ntest=1;
# Use of this variable is strongly discouraged. It is set mainly to
# help test coverage analyzers know which test is running.
--- 2,20 ----
package Test;
use Test::Harness 1.1601 ();
use Carp;
! use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish
! qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish
! $VERSION = '1.122';
require Exporter;
@ISA=('Exporter');
! @EXPORT=qw(&plan &ok &skip);
! @EXPORT_OK=qw($ntest $TESTOUT);
$TestLevel = 0; # how many extra stack frames to skip
$|=1;
#$^W=1; ?
$ntest=1;
+ $TESTOUT = *STDOUT{IO};
# Use of this variable is strongly discouraged. It is set mainly to
# help test coverage analyzers know which test is running.
***************
*** 35,43 ****
}
my @todo = sort { $a <=> $b } keys %todo;
if (@todo) {
! print "1..$max todo ".join(' ', @todo).";\n";
} else {
! print "1..$max\n";
}
++$planned;
}
--- 37,45 ----
}
my @todo = sort { $a <=> $b } keys %todo;
if (@todo) {
! print $TESTOUT "1..$max todo ".join(' ', @todo).";\n";
} else {
! print $TESTOUT "1..$max\n";
}
++$planned;
}
***************
*** 47,55 ****
(ref $v or '') eq 'CODE' ? $v->() : $v;
}
- # STDERR is NOT used for diagnostic output which should have been
- # fixed before release. Is this appropriate?
-
sub ok ($;$$) {
croak "ok: plan before you test!" if !$planned;
my ($pkg,$file,$line) = caller($TestLevel);
--- 49,54 ----
***************
*** 63,111 ****
$ok = $result;
} else {
$expected = to_value(shift);
- # until regex can be manipulated like objects...
my ($regex,$ignore);
! if (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
$ok = $result =~ /$regex/;
} else {
$ok = $result eq $expected;
}
}
! if ($todo{$ntest}) {
! if ($ok) {
! print "ok $ntest # Wow! ($context)\n";
! } else {
! $diag = to_value(shift) if @_;
! if (!$diag) {
! print "not ok $ntest # (failure expected in $context)\n";
! } else {
! print "not ok $ntest # (failure expected: $diag)\n";
! }
! }
} else {
! print "not " if !$ok;
! print "ok $ntest\n";
if (!$ok) {
my $detail = { 'repetition' => $repetition, 'package' => $pkg,
! 'result' => $result };
$$detail{expected} = $expected if defined $expected;
$diag = $$detail{diagnostic} = to_value(shift) if @_;
if (!defined $expected) {
if (!$diag) {
! print STDERR "# Failed test $ntest in $context\n";
} else {
! print STDERR "# Failed test $ntest in $context: $diag\n";
}
} else {
my $prefix = "Test $ntest";
! print STDERR "# $prefix got: '$result' ($context)\n";
$prefix = ' ' x (length($prefix) - 5);
if (!$diag) {
! print STDERR "# $prefix Expected: '$expected'\n";
} else {
! print STDERR "# $prefix Expected: '$expected' ($diag)\n";
}
}
push @FAILDETAIL, $detail;
--- 62,110 ----
$ok = $result;
} else {
$expected = to_value(shift);
my ($regex,$ignore);
! if ((ref($expected)||'') eq 'Regexp') {
! $ok = $result =~ /$expected/;
! } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
$ok = $result =~ /$regex/;
} else {
$ok = $result eq $expected;
}
}
! my $todo = $todo{$ntest};
! if ($todo and $ok) {
! $context .= ' TODO?!' if $todo;
! print $TESTOUT "ok $ntest # ($context)\n";
} else {
! print $TESTOUT "not " if !$ok;
! print $TESTOUT "ok $ntest\n";
if (!$ok) {
my $detail = { 'repetition' => $repetition, 'package' => $pkg,
! 'result' => $result, 'todo' => $todo };
$$detail{expected} = $expected if defined $expected;
$diag = $$detail{diagnostic} = to_value(shift) if @_;
+ $context .= ' *TODO*' if $todo;
if (!defined $expected) {
if (!$diag) {
! print $TESTOUT "# Failed test $ntest in $context\n";
} else {
! print $TESTOUT "# Failed test $ntest in $context: $diag\n";
}
} else {
my $prefix = "Test $ntest";
! print $TESTOUT "# $prefix got: '$result' ($context)\n";
$prefix = ' ' x (length($prefix) - 5);
+ if ((ref($expected)||'') eq 'Regexp') {
+ $expected = 'qr/'.$expected.'/'
+ } else {
+ $expected = "'$expected'";
+ }
if (!$diag) {
! print $TESTOUT "# $prefix Expected: $expected\n";
} else {
! print $TESTOUT "# $prefix Expected: $expected ($diag)\n";
}
}
push @FAILDETAIL, $detail;
***************
*** 116,123 ****
}
sub skip ($$;$$) {
! if (to_value(shift)) {
! print "ok $ntest # skip\n";
++ $ntest;
1;
} else {
--- 115,124 ----
}
sub skip ($$;$$) {
! my $whyskip = to_value(shift);
! if ($whyskip) {
! $whyskip = 'skip' if $whyskip =~ m/^\d+$/;
! print $TESTOUT "ok $ntest # $whyskip\n";
++ $ntest;
1;
} else {
***************
*** 141,147 ****
use strict;
use Test;
! BEGIN { plan tests => 13, todo => [3,4] }
ok(0); # failure
ok(1); # success
--- 142,153 ----
use strict;
use Test;
!
! # use a BEGIN block so we print our plan before MyModule is loaded
! BEGIN { plan tests => 14, todo => [3,4] }
!
! # load your module...
! use MyModule;
ok(0); # failure
ok(1); # success
***************
*** 152,161 ****
ok(0,1); # failure: '0' ne '1'
ok('broke','fixed'); # failure: 'broke' ne 'fixed'
ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
ok(sub { 1+1 }, 2); # success: '2' eq '2'
ok(sub { 1+1 }, 3); # failure: '2' ne '3'
! ok(0, int(rand(2)); # (just kidding! :-)
my @list = (0,0);
ok @list, 3, "\@list=".join(',',@list); #extra diagnostics
--- 158,168 ----
ok(0,1); # failure: '0' ne '1'
ok('broke','fixed'); # failure: 'broke' ne 'fixed'
ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
+ ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/
ok(sub { 1+1 }, 2); # success: '2' eq '2'
ok(sub { 1+1 }, 3); # failure: '2' ne '3'
! ok(0, int(rand(2)); # (just kidding :-)
my @list = (0,0);
ok @list, 3, "\@list=".join(',',@list); #extra diagnostics
***************
*** 165,173 ****
=head1 DESCRIPTION
! Test::Harness expects to see particular output when it executes tests.
! This module aims to make writing proper test scripts just a little bit
! easier (and less error prone :-).
=head1 TEST TYPES
--- 172,180 ----
=head1 DESCRIPTION
! L<Test::Harness> expects to see particular output when it executes
! tests. This module aims to make writing proper test scripts just a
! little bit easier (and less error prone :-).
=head1 TEST TYPES
***************
*** 175,231 ****
=item * NORMAL TESTS
! These tests are expected to succeed. If they don't, something's
screwed up!
=item * SKIPPED TESTS
! Skip tests need a platform specific feature that might or might not be
! available. The first argument should evaluate to true if the required
! feature is NOT available. After the first argument, skip tests work
exactly the same way as do normal tests.
=item * TODO TESTS
! TODO tests are designed for maintaining an executable TODO list.
! These tests are expected NOT to succeed (otherwise the feature they
! test would be on the new feature list, not the TODO list).
! Packages should NOT be released with successful TODO tests. As soon
as a TODO test starts working, it should be promoted to a normal test
! and the newly minted feature should be documented in the release
! notes.
=back
=head1 ONFAIL
BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
! The test failures can trigger extra diagnostics at the end of the 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:
! package, repetition, and result. (The file, line, and test number are
! not included because their correspondance to a particular test is
! fairly weak.) If the test had an expected value or a diagnostic
! string, these will also be included.
!
! This optional feature might be used simply to print out the version of
! your package and/or how to report problems. It might also be used to
! generate extremely sophisticated diagnostics for a particular test
! failure. It's not a panacea, however. Core dumps or other
! unrecoverable errors will prevent the C<onfail> hook from running.
! (It is run inside an END block.) Besides, C<onfail> is probably
! over-kill in the majority of cases. (Your test code should be simpler
than the code it is testing, yes?)
=head1 SEE ALSO
! L<Test::Harness> and various test coverage analysis tools.
=head1 AUTHOR
! Copyright (C) 1998 Joshua Nathaniel Pritikin. All rights reserved.
This package is free software and is provided "as is" without express
or implied warranty. It may be used, redistributed and/or modified
--- 182,245 ----
=item * NORMAL TESTS
! These tests are expected to succeed. If they don't something's
screwed up!
=item * SKIPPED TESTS
! Skip is for tests that might or might not be possible to run depending
! on the availability of platform specific features. The first argument
! should evaluate to true (think "yes, please skip") if the required
! feature is not available. After the first argument, skip works
exactly the same way as do normal tests.
=item * TODO TESTS
! TODO tests are designed for maintaining an B<executable TODO list>.
! These tests are expected NOT to succeed. If a TODO test does succeed,
! the feature in question should not be on the TODO list, now should it?
! Packages should NOT be released with succeeding TODO tests. As soon
as a TODO test starts working, it should be promoted to a normal test
! and the newly working feature should be documented in the release
! notes or change log.
=back
+ =head1 RETURN VALUE
+
+ Both C<ok> and C<skip> return true if their test succeeds and false
+ otherwise in a scalar context.
+
=head1 ONFAIL
BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
! While test failures should be enough, extra diagnostics can be
! 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
! had an expected value or a diagnostic string, these will also be
! included.
!
! The B<optional> C<onfail> hook might be used simply to print out the
! version of your package and/or how to report problems. It might also
! be used to generate extremely sophisticated diagnostics for a
! particularly bizarre test failure. However it's not a panacea. Core
! dumps or other unrecoverable errors prevent the C<onfail> hook from
! running. (It is run inside an C<END> block.) Besides, C<onfail> is
! probably over-kill in most cases. (Your test code should be simpler
than the code it is testing, yes?)
=head1 SEE ALSO
! L<Test::Harness> and, perhaps, test coverage analysis tools.
=head1 AUTHOR
! Copyright (c) 1998 Joshua Nathaniel Pritikin. All rights reserved.
This package is free software and is provided "as is" without express
or implied warranty. It may be used, redistributed and/or modified
diff -c 'perl5.005_02/lib/Test/Harness.pm' 'perl5.005_03/lib/Test/Harness.pm'
Index: ./lib/Test/Harness.pm
*** ./lib/Test/Harness.pm Tue Aug 4 22:15:42 1998
--- ./lib/Test/Harness.pm Fri Oct 30 21:56:33 1998
***************
*** 160,166 ****
} else {
push @failed, $next..$max;
$failed = @failed;
! (my $txt, $canon) = canonfailed($max,@failed);
$percent = 100*(scalar @failed)/$max;
print "DIED. ",$txt;
}
--- 160,166 ----
} else {
push @failed, $next..$max;
$failed = @failed;
! (my $txt, $canon) = canonfailed($max,$skipped,@failed);
$percent = 100*(scalar @failed)/$max;
print "DIED. ",$txt;
}
***************
*** 173,179 ****
} elsif ($ok == $max && $next == $max+1) {
if ($max and $skipped + $bonus) {
my @msg;
! push(@msg, "$skipped subtest".($skipped>1?'s':'')." skipped")
if $skipped;
push(@msg, "$bonus subtest".($bonus>1?'s':'').
" unexpectedly succeeded")
--- 173,179 ----
} elsif ($ok == $max && $next == $max+1) {
if ($max and $skipped + $bonus) {
my @msg;
! push(@msg, "$skipped/$max subtest".($skipped>1?'s':'')." skipped")
if $skipped;
push(@msg, "$bonus subtest".($bonus>1?'s':'').
" unexpectedly succeeded")
***************
*** 191,197 ****
push @failed, $next..$max;
}
if (@failed) {
! my ($txt, $canon) = canonfailed($max,@failed);
print $txt;
$failedtests{$test} = { canon => $canon, max => $max,
failed => scalar @failed,
--- 191,197 ----
push @failed, $next..$max;
}
if (@failed) {
! my ($txt, $canon) = canonfailed($max,$skipped,@failed);
print $txt;
$failedtests{$test} = { canon => $canon, max => $max,
failed => scalar @failed,
***************
*** 300,306 ****
}
sub canonfailed ($@) {
! my($max,@failed) = @_;
my %seen;
@failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
my $failed = @failed;
--- 300,306 ----
}
sub canonfailed ($@) {
! my($max,$skipped,@failed) = @_;
my %seen;
@failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
my $failed = @failed;
***************
*** 330,336 ****
}
push @result, "\tFailed $failed/$max tests, ";
! push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay\n";
my $txt = join "", @result;
($txt, $canon);
}
--- 330,341 ----
}
push @result, "\tFailed $failed/$max tests, ";
! push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
! my $ender = 's' x ($skipped > 1);
! my $good = $max - $failed - $skipped;
! my $goodper = sprintf("%.2f",100*($good/$max));
! push @result, " (-$skipped skipped test$ender: $good okay, $goodper%)" if $skipped;
! push @result, "\n";
my $txt = join "", @result;
($txt, $canon);
}
diff -c 'perl5.005_02/lib/Text/ParseWords.pm' 'perl5.005_03/lib/Text/ParseWords.pm'
Index: ./lib/Text/ParseWords.pm
*** ./lib/Text/ParseWords.pm Thu Jul 23 23:00:51 1998
--- ./lib/Text/ParseWords.pm Thu Jan 7 22:07:45 1999
***************
*** 63,69 ****
([\000-\377]*) # and the rest
| # --OR--
^((?:\\.|[^\\"'])*?) # an $unquoted text
! (\Z(?!\n)|$delimiter|(?!^)(?=["']))
# plus EOL, delimiter, or quote
([\000-\377]*) # the rest
/x; # extended layout
--- 63,69 ----
([\000-\377]*) # and the rest
| # --OR--
^((?:\\.|[^\\"'])*?) # an $unquoted text
! (\Z(?!\n)|(?-x:$delimiter)|(?!^)(?=["']))
# plus EOL, delimiter, or quote
([\000-\377]*) # the rest
/x; # extended layout
diff -c 'perl5.005_02/lib/Text/Wrap.pm' 'perl5.005_03/lib/Text/Wrap.pm'
Index: ./lib/Text/Wrap.pm
*** ./lib/Text/Wrap.pm Thu Jul 23 23:00:52 1998
--- ./lib/Text/Wrap.pm Wed Jan 6 22:41:53 1999
***************
*** 1,57 ****
package Text::Wrap;
! use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $columns $debug);
! use strict;
! use Exporter;
- $VERSION = "97.02";
@ISA = qw(Exporter);
! @EXPORT = qw(wrap);
! @EXPORT_OK = qw($columns $tabstop fill);
! use Text::Tabs qw(expand unexpand $tabstop);
BEGIN {
! $columns = 76; # <= screen width
! $debug = 0;
}
sub wrap
{
! my ($ip, $xp, @t) = @_;
!
! my @rv;
! my $t = expand(join(" ",@t));
! my $lead = $ip;
! my $ll = $columns - length(expand($lead)) - 1;
! my $nl = "";
!
! $t =~ s/^\s+//;
! while(length($t) > $ll) {
! # remove up to a line length of things that
! # aren't new lines and tabs.
! if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//) {
! my ($l,$r) = ($1,$2);
! $l =~ s/\s+$//;
! print "WRAP $lead$l..($r)\n" if $debug;
! push @rv, unexpand($lead . $l), "\n";
!
! } elsif ($t =~ s/^([^\n]{$ll})//) {
! print "SPLIT $lead$1..\n" if $debug;
! push @rv, unexpand($lead . $1),"\n";
}
! # recompute the leader
! $lead = $xp;
! $ll = $columns - length(expand($lead)) - 1;
! $t =~ s/^\s+//;
! }
! print "TAIL $lead$t\n" if $debug;
! push @rv, $lead.$t if $t ne "";
! return join '', @rv;
! }
sub fill
{
--- 1,65 ----
package Text::Wrap;
! require Exporter;
@ISA = qw(Exporter);
! @EXPORT = qw(wrap fill);
! @EXPORT_OK = qw($columns $break $huge);
! $VERSION = 98.112902;
+ use vars qw($VERSION $columns $debug $break $huge);
+ use strict;
BEGIN {
! $columns = 76; # <= screen width
! $debug = 0;
! $break = '\s';
! $huge = 'wrap'; # alternatively: 'die'
}
+ use Text::Tabs qw(expand unexpand);
+
sub wrap
{
! my ($ip, $xp, @t) = @_;
! my $r = "";
! my $t = expand(join(" ",@t));
! my $lead = $ip;
! my $ll = $columns - length(expand($ip)) - 1;
! my $nll = $columns - length(expand($xp)) - 1;
! my $nl = "";
! my $remainder = "";
!
! while ($t !~ /^\s*$/) {
! if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//xm) {
! $r .= unexpand($nl . $lead . $1);
! $remainder = $2;
! } elsif ($huge eq 'wrap' && $t =~ s/^([^\n]{$ll})//) {
! $r .= unexpand($nl . $lead . $1);
! $remainder = "\n";
! } elsif ($huge eq 'die') {
! die "couldn't wrap '$t'";
! } else {
! die "This shouldn't happen";
! }
!
! $lead = $xp;
! $ll = $nll;
! $nl = "\n";
}
! $r .= $remainder;
!
! print "-----------$r---------\n" if $debug;
!
! print "Finish up with '$lead', '$t'\n" if $debug;
!
! $r .= $lead . $t if $t ne "";
+ print "-----------$r---------\n" if $debug;;
+ return $r;
+ }
sub fill
{
***************
*** 83,108 ****
use Text::Wrap
print wrap($initial_tab, $subsequent_tab, @text);
! use Text::Wrap qw(wrap $columns $tabstop fill);
$columns = 132;
! $tabstop = 4;
!
! print fill($initial_tab, $subsequent_tab, @text);
! print fill("", "", `cat book`);
=head1 DESCRIPTION
Text::Wrap::wrap() is a very simple paragraph formatter. It formats a
! single paragraph at a time by breaking lines at word boundries.
Indentation is controlled for the first line ($initial_tab) and
! all subsquent lines ($subsequent_tab) independently. $Text::Wrap::columns
! should be set to the full width of your output device.
Text::Wrap::fill() is a simple multi-paragraph formatter. It formats
each paragraph separately and then joins them together when it's done. It
! will destory any whitespace in the original text. It breaks text into
paragraphs by looking for whitespace after a newline. In other respects
it acts like wrap().
--- 91,122 ----
use Text::Wrap
print wrap($initial_tab, $subsequent_tab, @text);
+ print fill($initial_tab, $subsequent_tab, @text);
! use Text::Wrap qw(wrap $columns $huge);
$columns = 132;
! $huge = 'die';
! $huge = 'wrap';
=head1 DESCRIPTION
Text::Wrap::wrap() is a very simple paragraph formatter. It formats a
! single paragraph at a time by breaking lines at word boundaries.
Indentation is controlled for the first line ($initial_tab) and
! all subsequent lines ($subsequent_tab) independently.
!
! Lines are wrapped at $Text::Wrap::columns columns.
! $Text::Wrap::columns should be set to the full width of your output device.
!
! When words that are longer than $columns are encountered, they
! are broken up. Previous versions of wrap() die()ed instead.
! To restore the old (dying) behavior, set $Text::Wrap::huge to
! 'die'.
Text::Wrap::fill() is a simple multi-paragraph formatter. It formats
each paragraph separately and then joins them together when it's done. It
! will destroy any whitespace in the original text. It breaks text into
paragraphs by looking for whitespace after a newline. In other respects
it acts like wrap().
***************
*** 111,125 ****
print wrap("\t","","This is a bit of text that forms
a normal book-style paragraph");
- =head1 BUGS
-
- It's not clear what the correct behavior should be when Wrap() is
- presented with a word that is longer than a line. The previous
- behavior was to die. Now the word is now split at line-length.
-
=head1 AUTHOR
David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
! others. Updated by Jacqui Caren.
- =cut
--- 125,132 ----
print wrap("\t","","This is a bit of text that forms
a normal book-style paragraph");
=head1 AUTHOR
David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
! many many others.
diff -c 'perl5.005_02/lib/Tie/Array.pm' 'perl5.005_03/lib/Tie/Array.pm'
Index: ./lib/Tie/Array.pm
*** ./lib/Tie/Array.pm Thu Jul 23 23:00:52 1998
--- ./lib/Tie/Array.pm Wed Jan 6 22:41:53 1999
***************
*** 176,198 ****
=item STORE this, index, value
! Store datum I<value> into I<index> for the tied array assoicated with
object I<this>. If this makes the array larger then
class's mapping of C<undef> should be returned for new positions.
=item FETCH this, index
! Retrieve the datum in I<index> for the tied array assoicated with
object I<this>.
=item FETCHSIZE this
! Returns the total number of items in the tied array assoicated with
object I<this>. (Equivalent to C<scalar(@array)>).
=item STORESIZE this, count
! Sets the total number of items in the tied array assoicated with
object I<this> to be I<count>. If this makes the array larger then
class's mapping of C<undef> should be returned for new positions.
If the array becomes smaller then entries beyond count should be
--- 176,198 ----
=item STORE this, index, value
! Store datum I<value> into I<index> for the tied array associated with
object I<this>. If this makes the array larger then
class's mapping of C<undef> should be returned for new positions.
=item FETCH this, index
! Retrieve the datum in I<index> for the tied array associated with
object I<this>.
=item FETCHSIZE this
! Returns the total number of items in the tied array associated with
object I<this>. (Equivalent to C<scalar(@array)>).
=item STORESIZE this, count
! Sets the total number of items in the tied array associated with
object I<this> to be I<count>. If this makes the array larger then
class's mapping of C<undef> should be returned for new positions.
If the array becomes smaller then entries beyond count should be
***************
*** 205,211 ****
=item CLEAR this
! Clear (remove, delete, ...) all values from the tied array assoicated with
object I<this>.
=item DESTROY this
--- 205,211 ----
=item CLEAR this
! Clear (remove, delete, ...) all values from the tied array associated with
object I<this>.
=item DESTROY this
***************
*** 227,233 ****
=item UNSHIFT this, LIST
! Insert LIST elements at the begining of the array, moving existing elements
up to make room.
=item SPLICE this, offset, length, LIST
--- 227,233 ----
=item UNSHIFT this, LIST
! Insert LIST elements at the beginning of the array, moving existing elements
up to make room.
=item SPLICE this, offset, length, LIST
diff -c 'perl5.005_02/lib/Tie/Hash.pm' 'perl5.005_03/lib/Tie/Hash.pm'
Index: ./lib/Tie/Hash.pm
*** ./lib/Tie/Hash.pm Thu Jul 23 23:00:52 1998
--- ./lib/Tie/Hash.pm Wed Jan 6 22:41:54 1999
***************
*** 92,98 ****
=head1 MORE INFORMATION
! The packages relating to various DBM-related implemetations (F<DB_File>,
F<NDBM_File>, etc.) show examples of general tied hashes, as does the
L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
good working examples.
--- 92,98 ----
=head1 MORE INFORMATION
! The packages relating to various DBM-related implementations (F<DB_File>,
F<NDBM_File>, etc.) show examples of general tied hashes, as does the
L<Config> module. While these do not utilize B<Tie::Hash>, they serve as
good working examples.
diff -c 'perl5.005_02/lib/Tie/SubstrHash.pm' 'perl5.005_03/lib/Tie/SubstrHash.pm'
Index: ./lib/Tie/SubstrHash.pm
*** ./lib/Tie/SubstrHash.pm Thu Jul 23 23:00:52 1998
--- ./lib/Tie/SubstrHash.pm Sat Jan 2 09:57:02 1999
***************
*** 69,75 ****
sub STORE {
local($self,$key,$val) = @_;
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
! croak("Table is full") if $self[5] == $tsize;
croak(qq/Value "$val" is not $vlen characters long./)
if length($val) != $vlen;
my $writeoffset;
--- 69,75 ----
sub STORE {
local($self,$key,$val) = @_;
local($klen, $vlen, $tsize, $rlen) = @$self[1..4];
! croak("Table is full") if $$self[5] == $tsize;
croak(qq/Value "$val" is not $vlen characters long./)
if length($val) != $vlen;
my $writeoffset;
diff -c 'perl5.005_02/lib/Time/Local.pm' 'perl5.005_03/lib/Time/Local.pm'
Index: ./lib/Time/Local.pm
*** ./lib/Time/Local.pm Thu Jul 23 23:00:52 1998
--- ./lib/Time/Local.pm Sun Jan 24 08:47:49 1999
***************
*** 17,32 ****
=head1 DESCRIPTION
! These routines are quite efficient and yet are always guaranteed to agree
! with localtime() and gmtime(). We manage this by caching the start times
! of any months we've seen before. If we know the start time of the month,
! we can always calculate any time within the month. The start times
! themselves are guessed by successive approximation starting at the
! current time, since most dates seen in practice are close to the
! current date. Unlike algorithms that do a binary search (calling gmtime
! once for each bit of the time value, resulting in 32 calls), this algorithm
! calls it at most 6 times, and usually only once or twice. If you hit
! the month cache, of course, it doesn't call it at all.
timelocal is implemented using the same cache. We just assume that we're
translating a GMT time, and then fudge it when we're done for the timezone
--- 17,34 ----
=head1 DESCRIPTION
! These routines are quite efficient and yet are always guaranteed to
! agree with localtime() and gmtime(), the most notable points being
! that year is year-1900 and month is 0..11. We manage this by caching
! the start times of any months we've seen before. If we know the start
! time of the month, we can always calculate any time within the month.
! The start times themselves are guessed by successive approximation
! starting at the current time, since most dates seen in practice are
! close to the current date. Unlike algorithms that do a binary search
! (calling gmtime once for each bit of the time value, resulting in 32
! calls), this algorithm calls it at most 6 times, and usually only once
! or twice. If you hit the month cache, of course, it doesn't call it
! at all.
timelocal is implemented using the same cache. We just assume that we're
translating a GMT time, and then fudge it when we're done for the timezone
diff -c 'perl5.005_02/lib/Time/gmtime.pm' 'perl5.005_03/lib/Time/gmtime.pm'
Index: ./lib/Time/gmtime.pm
*** ./lib/Time/gmtime.pm Thu Jul 23 23:00:52 1998
--- ./lib/Time/gmtime.pm Thu Jan 7 21:54:05 1999
***************
*** 69,75 ****
named with a preceding C<tm_> in front their method names. Thus,
C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import the fields.
! The gmctime() funtion provides a way of getting at the
scalar sense of the original CORE::gmtime() function.
To access this functionality without the core overrides,
--- 69,75 ----
named with a preceding C<tm_> in front their method names. Thus,
C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import the fields.
! The gmctime() function provides a way of getting at the
scalar sense of the original CORE::gmtime() function.
To access this functionality without the core overrides,
diff -c 'perl5.005_02/lib/Time/localtime.pm' 'perl5.005_03/lib/Time/localtime.pm'
Index: ./lib/Time/localtime.pm
*** ./lib/Time/localtime.pm Thu Jul 23 23:00:52 1998
--- ./lib/Time/localtime.pm Thu Jan 7 21:54:05 1999
***************
*** 65,71 ****
Thus, C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import
the fields.
! The ctime() funtion provides a way of getting at the
scalar sense of the original CORE::localtime() function.
To access this functionality without the core overrides,
--- 65,71 ----
Thus, C<$tm_obj-E<gt>mday()> corresponds to $tm_mday if you import
the fields.
! The ctime() function provides a way of getting at the
scalar sense of the original CORE::localtime() function.
To access this functionality without the core overrides,
diff -c 'perl5.005_02/lib/User/grent.pm' 'perl5.005_03/lib/User/grent.pm'
Index: ./lib/User/grent.pm
*** ./lib/User/grent.pm Thu Jul 23 23:00:52 1998
--- ./lib/User/grent.pm Thu Jan 7 21:54:05 1999
***************
*** 74,80 ****
regular array variables, so C<@{ $group_obj-E<gt>members() }> would be
simply @gr_members.
! The getpw() funtion is a simple front-end that forwards
a numeric argument to getpwuid() and the rest to getpwnam().
To access this functionality without the core overrides,
--- 74,80 ----
regular array variables, so C<@{ $group_obj-E<gt>members() }> would be
simply @gr_members.
! The getpw() function is a simple front-end that forwards
a numeric argument to getpwuid() and the rest to getpwnam().
To access this functionality without the core overrides,
diff -c 'perl5.005_02/lib/User/pwent.pm' 'perl5.005_03/lib/User/pwent.pm'
Index: ./lib/User/pwent.pm
*** ./lib/User/pwent.pm Thu Jul 23 23:00:52 1998
--- ./lib/User/pwent.pm Thu Jan 7 21:54:05 1999
***************
*** 84,90 ****
Thus, C<$passwd_obj-E<gt>shell()> corresponds to $pw_shell if you import
the fields.
! The getpw() funtion is a simple front-end that forwards
a numeric argument to getpwuid() and the rest to getpwnam().
To access this functionality without the core overrides,
--- 84,90 ----
Thus, C<$passwd_obj-E<gt>shell()> corresponds to $pw_shell if you import
the fields.
! The getpw() function is a simple front-end that forwards
a numeric argument to getpwuid() and the rest to getpwnam().
To access this functionality without the core overrides,
diff -c 'perl5.005_02/lib/constant.pm' 'perl5.005_03/lib/constant.pm'
Index: ./lib/constant.pm
*** ./lib/constant.pm Thu Jul 23 23:00:53 1998
--- ./lib/constant.pm Sat Oct 31 19:23:15 1998
***************
*** 20,25 ****
--- 20,37 ----
print "This line does nothing" unless DEBUGGING;
+ # references can be declared constant
+ use constant CHASH => { foo => 42 };
+ use constant CARRAY => [ 1,2,3,4 ];
+ use constant CPSEUDOHASH => [ { foo => 1}, 42 ];
+ use constant CCODE => sub { "bite $_[0]\n" };
+
+ print CHASH->{foo};
+ print CARRAY->[$i];
+ print CPSEUDOHASH->{foo};
+ print CCODE->("me");
+ print CHASH->[10]; # compile-time error
+
=head1 DESCRIPTION
This will declare a symbol to be a constant with the given scalar
***************
*** 85,90 ****
--- 97,104 ----
use constant E2BIG => ($! = 7);
print E2BIG, "\n"; # something like "Arg list too long"
print 0+E2BIG, "\n"; # "7"
+
+ Errors in dereferencing constant references are trapped at compile-time.
=head1 TECHNICAL NOTE
diff -c 'perl5.005_02/lib/diagnostics.pm' 'perl5.005_03/lib/diagnostics.pm'
Index: ./lib/diagnostics.pm
*** ./lib/diagnostics.pm Thu Jul 23 23:00:54 1998
--- ./lib/diagnostics.pm Sat Jan 23 16:09:05 1999
***************
*** 27,33 ****
=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
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.
--- 27,33 ----
=head2 The C<diagnostics> Pragma
This module extends the terse diagnostics normally emitted by both the
! 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.
diff -c 'perl5.005_02/lib/fields.pm' 'perl5.005_03/lib/fields.pm'
Index: ./lib/fields.pm
*** ./lib/fields.pm Thu Jul 23 23:00:54 1998
--- ./lib/fields.pm Sat Jan 2 09:38:31 1999
***************
*** 32,38 ****
If a typed lexical variable holding a reference is used to access a
hash element and the %FIELDS hash of the given type exists, then the
operation is turned into an array access at compile time. The %FIELDS
! hash map from hash element names to the array indices. If the hash
element is not present in the %FIELDS hash, then a compile-time error
is signaled.
--- 32,38 ----
If a typed lexical variable holding a reference is used to access a
hash element and the %FIELDS hash of the given type exists, then the
operation is turned into an array access at compile time. The %FIELDS
! hash maps from hash element names to the array indices. If the hash
element is not present in the %FIELDS hash, then a compile-time error
is signaled.
***************
*** 57,63 ****
{
my $class = shift;
no strict 'refs';
! my $self = bless [\%{"$class\::FIELDS"], $class;
$self;
}
--- 57,63 ----
{
my $class = shift;
no strict 'refs';
! my $self = bless [\%{"$class\::FIELDS"}], $class;
$self;
}
diff -c 'perl5.005_02/lib/overload.pm' 'perl5.005_03/lib/overload.pm'
Index: ./lib/overload.pm
*** ./lib/overload.pm Sat Aug 1 14:58:04 1998
--- ./lib/overload.pm Sat Jan 23 16:54:00 1999
***************
*** 167,179 ****
...
$strval = overload::StrVal $b;
- =head1 CAVEAT SCRIPTOR
-
- Overloading of operators is a subject not to be taken lightly.
- Neither its precise implementation, syntax, nor semantics are
- 100% endorsed by Larry Wall. So any of these may be changed
- at some point in the future.
-
=head1 DESCRIPTION
=head2 Declaration of overloaded functions
--- 167,172 ----
***************
*** 274,280 ****
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
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.
--- 267,273 ----
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 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.
***************
*** 283,289 ****
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
structures until cycles are C<explicitly> broken. You may get problems
when traversing your structures too.
--- 276,282 ----
B<Warning.> Due to the presense of assignment versions of operations,
routines which may be called in assignment context may create
! 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.
***************
*** 537,543 ****
=back
! Same behaviour is triggered by C<$b = $a++>, which is consider a synonim for
C<$b = $a; ++$a>.
=head1 MAGIC AUTOGENERATION
--- 530,536 ----
=back
! Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for
C<$b = $a; ++$a>.
=head1 MAGIC AUTOGENERATION
***************
*** 748,754 ****
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.
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
--- 741,747 ----
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 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
***************
*** 760,767 ****
=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
clash.
Here is a Perl object metaphor:
--- 753,760 ----
=head1 Metaphor clash
! 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:
***************
*** 868,874 ****
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
the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
symbolic 3> contains C<['+', 2, ['n', 3]]>.
--- 861,867 ----
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 encapsulates operations done over
the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
symbolic 3> contains C<['+', 2, ['n', 3]]>.
***************
*** 955,961 ****
conversion routine.
Here is the text of F<symbolic.pm> with such a routine added (and
! slightly modifed str()):
package symbolic; # Primitive symbolic calculator
use overload
--- 948,954 ----
conversion routine.
Here is the text of F<symbolic.pm> with such a routine added (and
! slightly modified str()):
package symbolic; # Primitive symbolic calculator
use overload
***************
*** 994,1000 ****
}
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
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.)
--- 987,993 ----
}
All the work of numeric conversion is done in %subr and num(). Of
! 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.)
***************
*** 1024,1030 ****
(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
the tables of operations, and change the code which fills %subr to
my %subr = ( 'n' => sub {$_[0]} );
--- 1017,1023 ----
(not required without mutators!), and implements only those arithmetic
operations which are used in the example.
! 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]} );
***************
*** 1102,1109 ****
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
$a and $b happen to be of some related type, this may lead to problems.
=head2 I<Really> symbolic calculator
--- 1095,1102 ----
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 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 -c 'perl5.005_02/lib/perl5db.pl' 'perl5.005_03/lib/perl5db.pl'
Index: ./lib/perl5db.pl
*** ./lib/perl5db.pl Sat Aug 1 23:38:35 1998
--- ./lib/perl5db.pl Mon Dec 28 08:55:36 1998
***************
*** 2,8 ****
# Debugger for Perl 5.00x; perl5db.pl patch level:
! $VERSION = 1.0401;
$header = "perl5db.pl version $VERSION";
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
--- 2,8 ----
# Debugger for Perl 5.00x; perl5db.pl patch level:
! $VERSION = 1.0402;
$header = "perl5db.pl version $VERSION";
# Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
***************
*** 235,241 ****
warnLevel($warnLevel);
dieLevel($dieLevel);
signalLevel($signalLevel);
! &pager(defined($ENV{PAGER}) ? $ENV{PAGER} : "|more") unless defined $pager;
&recallCommand("!") unless defined $prc;
&shellBang("!") unless defined $psh;
$maxtrace = 400 unless defined $maxtrace;
--- 235,245 ----
warnLevel($warnLevel);
dieLevel($dieLevel);
signalLevel($signalLevel);
! &pager((defined($ENV{PAGER})
! ? $ENV{PAGER}
! : ($^O eq 'os2'
! ? 'cmd /c more'
! : 'more'))) unless defined $pager;
&recallCommand("!") unless defined $prc;
&shellBang("!") unless defined $psh;
$maxtrace = 400 unless defined $maxtrace;
***************
*** 361,367 ****
# _After_ the perl program is compiled, $single is set to 1:
if ($single and not $second_time++) {
if ($runnonstop) { # Disable until signal
! for ($i=0; $i <= $#stack; ) {
$stack[$i++] &= ~1;
}
$single = 0;
--- 365,371 ----
# _After_ the perl program is compiled, $single is set to 1:
if ($single and not $second_time++) {
if ($runnonstop) { # Disable until signal
! for ($i=0; $i <= $stack_depth; ) {
$stack[$i++] &= ~1;
}
$single = 0;
***************
*** 412,422 ****
$was_signal = $signal;
$signal = 0;
if ($single || ($trace & 1) || $was_signal) {
- $term || &setterm;
if ($emacs) {
$position = "\032\032$filename:$line:0\n";
print $LINEINFO $position;
} elsif ($package eq 'DB::fake') {
print_help(<<EOP);
Debugged program terminated. Use B<q> to quit or B<R> to restart,
use B<O> I<inhibit_exit> to avoid stopping after program termination,
--- 416,426 ----
$was_signal = $signal;
$signal = 0;
if ($single || ($trace & 1) || $was_signal) {
if ($emacs) {
$position = "\032\032$filename:$line:0\n";
print $LINEINFO $position;
} elsif ($package eq 'DB::fake') {
+ $term || &setterm;
print_help(<<EOP);
Debugged program terminated. Use B<q> to quit or B<R> to restart,
use B<O> I<inhibit_exit> to avoid stopping after program termination,
***************
*** 439,445 ****
$position = "$prefix$line$infix$dbline[$line]$after";
}
if ($frame) {
! print $LINEINFO ' ' x $#stack, "$line:\t$dbline[$line]$after";
} else {
print $LINEINFO $position;
}
--- 443,449 ----
$position = "$prefix$line$infix$dbline[$line]$after";
}
if ($frame) {
! print $LINEINFO ' ' x $stack_depth, "$line:\t$dbline[$line]$after";
} else {
print $LINEINFO $position;
}
***************
*** 450,456 ****
$incr_pos = "$prefix$i$infix$dbline[$i]$after";
$position .= $incr_pos;
if ($frame) {
! print $LINEINFO ' ' x $#stack, "$i:\t$dbline[$i]$after";
} else {
print $LINEINFO $incr_pos;
}
--- 454,460 ----
$incr_pos = "$prefix$i$infix$dbline[$i]$after";
$position .= $incr_pos;
if ($frame) {
! print $LINEINFO ' ' x $stack_depth, "$i:\t$dbline[$i]$after";
} else {
print $LINEINFO $incr_pos;
}
***************
*** 463,469 ****
foreach $evalarg (@$pre) {
&eval;
}
! print $OUT $#stack . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
$incr = -1; # for backward motion.
--- 467,473 ----
foreach $evalarg (@$pre) {
&eval;
}
! print $OUT $stack_depth . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
$incr = -1; # for backward motion.
***************
*** 640,647 ****
$arrow .= 'b' if $stop;
$arrow .= 'a' if $action;
print $OUT "$i$arrow\t", $dbline[$i];
! last if $signal;
}
}
$start = $i; # remember in case they want more
$start = $max if $start > $max;
--- 644,652 ----
$arrow .= 'b' if $stop;
$arrow .= 'a' if $action;
print $OUT "$i$arrow\t", $dbline[$i];
! $i++, last if $signal;
}
+ print $OUT "\n" unless $dbline[$i-1] =~ /\n$/;
}
$start = $i; # remember in case they want more
$start = $max if $start > $max;
***************
*** 879,892 ****
}
$dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
}
! for ($i=0; $i <= $#stack; ) {
$stack[$i++] &= ~1;
}
last CMD; };
$cmd =~ /^r$/ && do {
end_report(), next CMD if $finished and $level <= 1;
! $stack[$#stack] |= 1;
! $doret = $option{PrintRet} ? $#stack - 1 : -2;
last CMD; };
$cmd =~ /^R$/ && do {
print $OUT "Warning: some settings and command-line options may be lost!\n";
--- 884,897 ----
}
$dbline{$i} =~ s/($|\0)/;9$1/; # add one-time-only b.p.
}
! for ($i=0; $i <= $stack_depth; ) {
$stack[$i++] &= ~1;
}
last CMD; };
$cmd =~ /^r$/ && do {
end_report(), next CMD if $finished and $level <= 1;
! $stack[$stack_depth] |= 1;
! $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
last CMD; };
$cmd =~ /^R$/ && do {
print $OUT "Warning: some settings and command-line options may be lost!\n";
***************
*** 1169,1192 ****
if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
$al = " for $$sub";
}
! push(@stack, $single);
$single &= 1;
! $single |= 4 if $#stack == $deep;
($frame & 4
! ? ( (print $LINEINFO ' ' x ($#stack - 1), "in "),
# Why -1? But it works! :-(
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
! : print $LINEINFO ' ' x ($#stack - 1), "entering $sub$al\n") if $frame;
if (wantarray) {
@ret = &$sub;
! $single |= pop(@stack);
($frame & 4
! ? ( (print $LINEINFO ' ' x $#stack, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
! : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
! if ($doret eq $#stack or $frame & 16) {
! my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
! print $fh ' ' x $#stack if $frame & 16;
print $fh "list context return from $sub:\n";
dumpit($fh, \@ret );
$doret = -2;
--- 1174,1199 ----
if (length($sub) > 10 && substr($sub, -10, 10) eq '::AUTOLOAD') {
$al = " for $$sub";
}
! local $stack_depth = $stack_depth + 1; # Protect from non-local exits
! $#stack = $stack_depth;
! $stack[-1] = $single;
$single &= 1;
! $single |= 4 if $stack_depth == $deep;
($frame & 4
! ? ( (print $LINEINFO ' ' x ($stack_depth - 1), "in "),
# Why -1? But it works! :-(
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
! : print $LINEINFO ' ' x ($stack_depth - 1), "entering $sub$al\n") if $frame;
if (wantarray) {
@ret = &$sub;
! $single |= $stack[$stack_depth--];
($frame & 4
! ? ( (print $LINEINFO ' ' x $stack_depth, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
! : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
! if ($doret eq $stack_depth or $frame & 16) {
! my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
! print $fh ' ' x $stack_depth if $frame & 16;
print $fh "list context return from $sub:\n";
dumpit($fh, \@ret );
$doret = -2;
***************
*** 1198,1211 ****
} else {
&$sub; undef $ret;
};
! $single |= pop(@stack);
($frame & 4
! ? ( (print $LINEINFO ' ' x $#stack, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
! : print $LINEINFO ' ' x $#stack, "exited $sub$al\n") if $frame & 2;
! if ($doret eq $#stack or $frame & 16 and defined wantarray) {
! my $fh = ($doret eq $#stack ? $OUT : $LINEINFO);
! print $fh (' ' x $#stack) if $frame & 16;
print $fh (defined wantarray
? "scalar context return from $sub: "
: "void context return from $sub\n");
--- 1205,1218 ----
} else {
&$sub; undef $ret;
};
! $single |= $stack[$stack_depth--];
($frame & 4
! ? ( (print $LINEINFO ' ' x $stack_depth, "out "),
print_trace($LINEINFO, -1, 1, 1, "$sub$al") )
! : print $LINEINFO ' ' x $stack_depth, "exited $sub$al\n") if $frame & 2;
! if ($doret eq $stack_depth or $frame & 16 and defined wantarray) {
! my $fh = ($doret eq $stack_depth ? $OUT : $LINEINFO);
! print $fh (' ' x $stack_depth) if $frame & 16;
print $fh (defined wantarray
? "scalar context return from $sub: "
: "void context return from $sub\n");
***************
*** 1226,1232 ****
sub eval {
my @res;
{
- local (@stack) = @stack; # guard against recursive debugging
my $otrace = $trace;
my $osingle = $single;
my $od = $^D;
--- 1233,1238 ----
***************
*** 1284,1290 ****
$filename =~ s/^_<//;
$signal = 1, print $OUT "'$filename' loaded...\n"
if $break_on_load{$filename};
! print $LINEINFO ' ' x $#stack, "Package $filename.\n" if $frame;
return unless $postponed_file{$filename};
$had_breakpoints{$filename}++;
#%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
--- 1290,1296 ----
$filename =~ s/^_<//;
$signal = 1, print $OUT "'$filename' loaded...\n"
if $break_on_load{$filename};
! print $LINEINFO ' ' x $stack_depth, "Package $filename.\n" if $frame;
return unless $postponed_file{$filename};
$had_breakpoints{$filename}++;
#%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
***************
*** 1432,1438 ****
sub setterm {
local $frame = 0;
local $doret = -2;
- local @stack = @stack; # Prevent growth by failing `use'.
eval { require Term::ReadLine } or die $@;
if ($notty) {
if ($tty) {
--- 1438,1443 ----
***************
*** 1747,1759 ****
}
$version{$file} .= $INC{$file};
}
! do 'dumpvar.pl' unless defined &main::dumpValue;
! if (defined &main::dumpValue) {
! local $frame = 0;
! &main::dumpValue(\%version);
! } else {
! print $OUT "dumpvar.pl not available.\n";
! }
}
sub sethelp {
--- 1752,1758 ----
}
$version{$file} .= $INC{$file};
}
! dumpit($OUT,\%version);
}
sub sethelp {
***************
*** 2073,2078 ****
--- 2072,2078 ----
# @stack and $doret are needed in sub sub, which is called for DB::postponed.
# Triggers bug (?) in perl is we postpone this until runtime:
@postponed = @stack = (0);
+ $stack_depth = 0; # Localized $#stack
$doret = -2;
$frame = 0;
}
diff -c 'perl5.005_02/makedepend.SH' 'perl5.005_03/makedepend.SH'
Index: ./makedepend.SH
*** ./makedepend.SH Thu Jul 23 23:00:58 1998
--- ./makedepend.SH Thu Jan 21 19:10:23 1999
***************
*** 67,72 ****
--- 67,73 ----
# 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
***************
*** 98,103 ****
--- 99,113 ----
$echo *.c | $tr ' ' $trnl | $egrep -v '\*' >.clist)
for file in `$cat .clist`; do
# for file in `cat /dev/null`; do
+ if [ "$osname" = uwin ]; then
+ uwinfix="-e s,\\\\\\\\,/,g -e s,\\([a-zA-Z]\\):/,/\\1/,g"
+ else
+ if [ "$osname" = os2 ]; then
+ uwinfix="-e s,\\\\\\\\,/,g"
+ else
+ uwinfix=
+ fi
+ fi
case "$file" in
*.c) filebase=`basename $file .c` ;;
*.y) filebase=`basename $file .y` ;;
***************
*** 126,132 ****
-e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's|: \./|: |' \
! -e 's|\.c\.c|.c|' | \
$uniq | $sort | $uniq >> .deptmp
done
--- 136,142 ----
-e 's/^.*"\(.*\)".*$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's/^# *[0-9][0-9]* \(.*\)$/'$filebase'\$(OBJ_EXT): \1/' \
-e 's|: \./|: |' \
! -e 's|\.c\.c|.c|' $uwinfix | \
$uniq | $sort | $uniq >> .deptmp
done
diff -c 'perl5.005_02/malloc.c' 'perl5.005_03/malloc.c'
Index: ./malloc.c
*** ./malloc.c Sun Aug 2 04:35:23 1998
--- ./malloc.c Wed Mar 3 20:35:39 1999
***************
*** 141,147 ****
#define MIN_BUC_POW2 (sizeof(void*) > 4 ? 3 : 2) /* Allow for 4-byte arena. */
#define MIN_BUCKET (MIN_BUC_POW2 * BUCKETS_PER_POW2)
! #if !(defined(I286) || defined(atarist))
/* take 2k unless the block is bigger than that */
# define LOG_OF_MIN_ARENA 11
#else
--- 141,147 ----
#define MIN_BUC_POW2 (sizeof(void*) > 4 ? 3 : 2) /* Allow for 4-byte arena. */
#define MIN_BUCKET (MIN_BUC_POW2 * BUCKETS_PER_POW2)
! #if !(defined(I286) || defined(atarist) || defined(__MINT__))
/* take 2k unless the block is bigger than that */
# define LOG_OF_MIN_ARENA 11
#else
***************
*** 247,253 ****
#define u_short unsigned short
/* 286 and atarist like big chunks, which gives too much overhead. */
! #if (defined(RCHECK) || defined(I286) || defined(atarist)) && defined(PACK_MALLOC)
# undef PACK_MALLOC
#endif
--- 247,253 ----
#define u_short unsigned short
/* 286 and atarist like big chunks, which gives too much overhead. */
! #if (defined(RCHECK) || defined(I286) || defined(atarist) || defined(__MINT__)) && defined(PACK_MALLOC)
# undef PACK_MALLOC
#endif
***************
*** 570,581 ****
# define BIG_SIZE (1<<16) /* 64K */
# endif
static char *emergency_buffer;
static MEM_SIZE emergency_buffer_size;
static Malloc_t
! emergency_sbrk(size)
! MEM_SIZE size;
{
MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<<LOG_OF_MIN_ARENA;
--- 570,588 ----
# define BIG_SIZE (1<<16) /* 64K */
# endif
+ #ifdef MUTEX_INIT_CALLS_MALLOC
+ # undef MUTEX_LOCK
+ # define MUTEX_LOCK(m) STMT_START { if (*m) mutex_lock(*m); } STMT_END
+ # undef MUTEX_UNLOCK
+ # define MUTEX_UNLOCK(m) STMT_START { if (*m) mutex_unlock(*m); } STMT_END
+ #endif
+
static char *emergency_buffer;
static MEM_SIZE emergency_buffer_size;
+ static Malloc_t emergency_sbrk(MEM_SIZE size);
static Malloc_t
! emergency_sbrk(MEM_SIZE size)
{
MEM_SIZE rsize = (((size - 1)>>LOG_OF_MIN_ARENA) + 1)<<LOG_OF_MIN_ARENA;
***************
*** 599,604 ****
--- 606,612 ----
SV *sv;
char *pv;
int have = 0;
+ STRLEN n_a;
if (emergency_buffer_size) {
add_to_chain(emergency_buffer, emergency_buffer_size, 0);
***************
*** 614,620 ****
return (char *)-1; /* Now die die die... */
}
/* Got it, now detach SvPV: */
! pv = SvPV(sv, PL_na);
/* Check alignment: */
if (((UV)(pv - sizeof(union overhead))) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
--- 622,628 ----
return (char *)-1; /* Now die die die... */
}
/* Got it, now detach SvPV: */
! pv = SvPV(sv, n_a);
/* Check alignment: */
if (((UV)(pv - sizeof(union overhead))) & ((1<<LOG_OF_MIN_ARENA) - 1)) {
PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n");
***************
*** 670,675 ****
--- 678,684 ----
static u_int goodsbrk;
#ifdef DEBUGGING
+ #undef ASSERT
#define ASSERT(p,diag) if (!(p)) botch(diag,STRINGIFY(p)); else
static void
botch(char *diag, char *s)
***************
*** 944,950 ****
/* Second, check alignment. */
slack = 0;
! #ifndef atarist /* on the atari we dont have to worry about this */
# ifndef I286 /* The sbrk(0) call on the I286 always returns the next segment */
/* CHUNK_SHIFT is 1 for PACK_MALLOC, 0 otherwise. */
--- 953,959 ----
/* Second, check alignment. */
slack = 0;
! #if !defined(atarist) && !defined(__MINT__) /* on the atari we dont have to worry about this */
# ifndef I286 /* The sbrk(0) call on the I286 always returns the next segment */
/* CHUNK_SHIFT is 1 for PACK_MALLOC, 0 otherwise. */
***************
*** 954,960 ****
add += slack;
}
# endif
! #endif /* atarist */
if (add) {
DEBUG_m(PerlIO_printf(Perl_debug_log,
--- 963,969 ----
add += slack;
}
# endif
! #endif /* !atarist && !MINT */
if (add) {
DEBUG_m(PerlIO_printf(Perl_debug_log,
***************
*** 1254,1260 ****
* is extern so the caller can modify it). If that fails we just copy
* however many bytes was given to realloc() and hope it's not huge.
*/
! int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
Malloc_t
realloc(void *mp, size_t nbytes)
--- 1263,1269 ----
* is extern so the caller can modify it). If that fails we just copy
* however many bytes was given to realloc() and hope it's not huge.
*/
! int reall_srchlen = 4; /* 4 should be plenty, -1 =>'s whole list */
Malloc_t
realloc(void *mp, size_t nbytes)
***************
*** 1572,1582 ****
#ifdef USE_PERL_SBRK
! # ifdef NeXT
! # define PERL_SBRK_VIA_MALLOC
! # endif
!
! # ifdef __MACHTEN_PPC__
# define PERL_SBRK_VIA_MALLOC
/*
* MachTen's malloc() returns a buffer aligned on a two-byte boundary.
--- 1581,1587 ----
#ifdef USE_PERL_SBRK
! # if defined(__MACHTEN_PPC__) || defined(__NeXT__)
# define PERL_SBRK_VIA_MALLOC
/*
* MachTen's malloc() returns a buffer aligned on a two-byte boundary.
***************
*** 1619,1626 ****
# define PERLSBRK_64_K (1<<16)
Malloc_t
! Perl_sbrk(size)
! int size;
{
IV got;
int small, reqsize;
--- 1624,1630 ----
# define PERLSBRK_64_K (1<<16)
Malloc_t
! Perl_sbrk(int size)
{
IV got;
int small, reqsize;
diff -c 'perl5.005_02/mg.c' 'perl5.005_03/mg.c'
Index: ./mg.c
*** ./mg.c Sun Aug 2 01:08:10 1998
--- ./mg.c Sat Mar 27 12:36:36 1999
***************
*** 1,6 ****
/* mg.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* mg.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 248,254 ****
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
if (isUPPER(mg->mg_type)) {
! sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
count++;
}
}
--- 248,256 ----
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
if (isUPPER(mg->mg_type)) {
! sv_magic(nsv,
! mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : mg->mg_obj,
! toLOWER(mg->mg_type), key, klen);
count++;
}
}
***************
*** 339,346 ****
return (STRLEN)PL_orslen;
}
magic_get(sv,mg);
! if (!SvPOK(sv) && SvNIOK(sv))
! sv_2pv(sv, &PL_na);
if (SvPOK(sv))
return SvCUR(sv);
return 0;
--- 341,350 ----
return (STRLEN)PL_orslen;
}
magic_get(sv,mg);
! if (!SvPOK(sv) && SvNIOK(sv)) {
! STRLEN n_a;
! sv_2pv(sv, &n_a);
! }
if (SvPOK(sv))
return SvCUR(sv);
return 0;
***************
*** 360,365 ****
--- 364,372 ----
case '\001': /* ^A */
sv_setsv(sv, PL_bodytarget);
break;
+ case '\003': /* ^C */
+ sv_setiv(sv, (IV)PL_minus_c);
+ break;
case '\004': /* ^D */
sv_setiv(sv, (IV)(PL_debug & 32767));
break;
***************
*** 382,389 ****
sv_setnv(sv, (double)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
} else {
! if (errno != errno_isOS2)
! Perl_rc = _syserrno();
sv_setnv(sv, (double)Perl_rc);
sv_setpv(sv, os2error(Perl_rc));
}
--- 389,399 ----
sv_setnv(sv, (double)errno);
sv_setpv(sv, errno ? Strerror(errno) : "");
} else {
! if (errno != errno_isOS2) {
! int tmp = _syserrno();
! if (tmp) /* 2nd call to _syserrno() makes it 0 */
! Perl_rc = tmp;
! }
sv_setnv(sv, (double)Perl_rc);
sv_setpv(sv, os2error(Perl_rc));
}
***************
*** 716,722 ****
int
magic_clearenv(SV *sv, MAGIC *mg)
{
! my_setenv(MgPV(mg,PL_na),Nullch);
return 0;
}
--- 726,733 ----
int
magic_clearenv(SV *sv, MAGIC *mg)
{
! STRLEN n_a;
! my_setenv(MgPV(mg,n_a),Nullch);
return 0;
}
***************
*** 729,740 ****
dTHR;
if (PL_localizing) {
HE* entry;
magic_clear_all_env(sv,mg);
hv_iterinit((HV*)sv);
while (entry = hv_iternext((HV*)sv)) {
I32 keylen;
my_setenv(hv_iterkey(entry, &keylen),
! SvPV(hv_iterval((HV*)sv, entry), PL_na));
}
}
#endif
--- 740,752 ----
dTHR;
if (PL_localizing) {
HE* entry;
+ STRLEN n_a;
magic_clear_all_env(sv,mg);
hv_iterinit((HV*)sv);
while (entry = hv_iternext((HV*)sv)) {
I32 keylen;
my_setenv(hv_iterkey(entry, &keylen),
! SvPV(hv_iterval((HV*)sv, entry), n_a));
}
}
#endif
***************
*** 757,763 ****
*end = '\0';
my_setenv(cur,Nullch);
*end = '=';
! cur += strlen(end+1)+1;
}
else if ((len = strlen(cur)))
cur += len+1;
--- 769,775 ----
*end = '\0';
my_setenv(cur,Nullch);
*end = '=';
! cur = end + strlen(end+1)+2;
}
else if ((len = strlen(cur)))
cur += len+1;
***************
*** 782,789 ****
magic_getsig(SV *sv, MAGIC *mg)
{
I32 i;
/* Are we fetching a signal entry? */
! i = whichsig(MgPV(mg,PL_na));
if (i) {
if(psig_ptr[i])
sv_setsv(sv,psig_ptr[i]);
--- 794,802 ----
magic_getsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we fetching a signal entry? */
! i = whichsig(MgPV(mg,n_a));
if (i) {
if(psig_ptr[i])
sv_setsv(sv,psig_ptr[i]);
***************
*** 805,812 ****
magic_clearsig(SV *sv, MAGIC *mg)
{
I32 i;
/* Are we clearing a signal entry? */
! i = whichsig(MgPV(mg,PL_na));
if (i) {
if(psig_ptr[i]) {
SvREFCNT_dec(psig_ptr[i]);
--- 818,826 ----
magic_clearsig(SV *sv, MAGIC *mg)
{
I32 i;
+ STRLEN n_a;
/* Are we clearing a signal entry? */
! i = whichsig(MgPV(mg,n_a));
if (i) {
if(psig_ptr[i]) {
SvREFCNT_dec(psig_ptr[i]);
***************
*** 827,834 ****
register char *s;
I32 i;
SV** svp;
! s = MgPV(mg,PL_na);
if (*s == '_') {
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
--- 841,849 ----
register char *s;
I32 i;
SV** svp;
+ STRLEN n_a;
! s = MgPV(mg,n_a);
if (*s == '_') {
if (strEQ(s,"__DIE__"))
svp = &PL_diehook;
***************
*** 865,871 ****
*svp = SvREFCNT_inc(sv);
return 0;
}
! s = SvPV_force(sv,PL_na);
if (strEQ(s,"IGNORE")) {
if (i)
(void)rsignal(i, SIG_IGN);
--- 880,886 ----
*svp = SvREFCNT_inc(sv);
return 0;
}
! s = SvPV_force(sv,n_a);
if (strEQ(s,"IGNORE")) {
if (i)
(void)rsignal(i, SIG_IGN);
***************
*** 922,928 ****
if (hv) {
(void) hv_iterinit(hv);
! if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
i = HvKEYS(hv);
else {
/*SUPPRESS 560*/
--- 937,943 ----
if (hv) {
(void) hv_iterinit(hv);
! if (! SvTIED_mg((SV*)hv, 'P'))
i = HvKEYS(hv);
else {
/*SUPPRESS 560*/
***************
*** 947,959 ****
/* caller is responsible for stack switching/cleanup */
STATIC int
! magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
{
dSP;
PUSHMARK(SP);
EXTEND(SP, n);
! PUSHs(mg->mg_obj);
if (n > 1) {
if (mg->mg_ptr) {
if (mg->mg_len >= 0)
--- 962,974 ----
/* caller is responsible for stack switching/cleanup */
STATIC int
! magic_methcall(SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val)
{
dSP;
PUSHMARK(SP);
EXTEND(SP, n);
! PUSHs(SvTIED_obj(sv, mg));
if (n > 1) {
if (mg->mg_ptr) {
if (mg->mg_len >= 0)
***************
*** 982,988 ****
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
! if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
sv_setsv(sv, *PL_stack_sp--);
}
--- 997,1003 ----
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
! if (magic_methcall(sv, mg, meth, G_SCALAR, 2, NULL)) {
sv_setsv(sv, *PL_stack_sp--);
}
***************
*** 1007,1013 ****
dSP;
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
! magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
POPSTACK;
LEAVE;
return 0;
--- 1022,1028 ----
dSP;
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
! magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
POPSTACK;
LEAVE;
return 0;
***************
*** 1029,1035 ****
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
! if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
sv = *PL_stack_sp--;
retval = (U32) SvIV(sv)-1;
}
--- 1044,1050 ----
ENTER;
SAVETMPS;
PUSHSTACKi(PERLSI_MAGIC);
! if (magic_methcall(sv, mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
sv = *PL_stack_sp--;
retval = (U32) SvIV(sv)-1;
}
***************
*** 1046,1052 ****
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
! XPUSHs(mg->mg_obj);
PUTBACK;
perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
POPSTACK;
--- 1061,1067 ----
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
! XPUSHs(SvTIED_obj(sv, mg));
PUTBACK;
perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
POPSTACK;
***************
*** 1065,1071 ****
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP, 2);
! PUSHs(mg->mg_obj);
if (SvOK(key))
PUSHs(key);
PUTBACK;
--- 1080,1086 ----
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP, 2);
! PUSHs(SvTIED_obj(sv, mg));
if (SvOK(key))
PUSHs(key);
PUTBACK;
***************
*** 1093,1103 ****
I32 i;
GV* gv;
SV** svp;
gv = PL_DBline;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
! atoi(MgPV(mg,PL_na)), FALSE);
if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
o->op_private = i;
else
--- 1108,1119 ----
I32 i;
GV* gv;
SV** svp;
+ STRLEN n_a;
gv = PL_DBline;
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
! atoi(MgPV(mg,n_a)), FALSE);
if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
o->op_private = i;
else
***************
*** 1193,1202 ****
{
register char *s;
GV* gv;
if (!SvOK(sv))
return 0;
! s = SvPV(sv, PL_na);
if (*s == '*' && s[1])
s++;
gv = gv_fetchpv(s,TRUE, SVt_PVGV);
--- 1209,1219 ----
{
register char *s;
GV* gv;
+ STRLEN n_a;
if (!SvOK(sv))
return 0;
! s = SvPV(sv, n_a);
if (*s == '*' && s[1])
s++;
gv = gv_fetchpv(s,TRUE, SVt_PVGV);
***************
*** 1406,1413 ****
if (svp)
value = *svp;
}
! if (!value || value == &PL_sv_undef)
! croak(no_helem, SvPV(mg->mg_obj, PL_na));
}
else {
AV* av = (AV*)LvTARG(sv);
--- 1423,1432 ----
if (svp)
value = *svp;
}
! if (!value || value == &PL_sv_undef) {
! STRLEN n_a;
! croak(no_helem, SvPV(mg->mg_obj, n_a));
! }
}
else {
AV* av = (AV*)LvTARG(sv);
***************
*** 1498,1503 ****
--- 1517,1525 ----
case '\001': /* ^A */
sv_setsv(PL_bodytarget, sv);
break;
+ case '\003': /* ^C */
+ PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ break;
case '\004': /* ^D */
PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
DEBUG_x(dump_all());
***************
*** 1524,1530 ****
if (PL_inplace)
Safefree(PL_inplace);
if (SvOK(sv))
! PL_inplace = savepv(SvPV(sv,PL_na));
else
PL_inplace = Nullch;
break;
--- 1546,1552 ----
if (PL_inplace)
Safefree(PL_inplace);
if (SvOK(sv))
! PL_inplace = savepv(SvPV(sv,len));
else
PL_inplace = Nullch;
break;
***************
*** 1532,1538 ****
if (PL_osname)
Safefree(PL_osname);
if (SvOK(sv))
! PL_osname = savepv(SvPV(sv,PL_na));
else
PL_osname = Nullch;
break;
--- 1554,1560 ----
if (PL_osname)
Safefree(PL_osname);
if (SvOK(sv))
! PL_osname = savepv(SvPV(sv,len));
else
PL_osname = Nullch;
break;
***************
*** 1559,1570 ****
break;
case '^':
Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
! IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '~':
Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
! IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na));
IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '=':
--- 1581,1592 ----
break;
case '^':
Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
! IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '~':
Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
! IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len));
IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '=':
***************
*** 1621,1627 ****
case '#':
if (PL_ofmt)
Safefree(PL_ofmt);
! PL_ofmt = savepv(SvPV(sv,PL_na));
break;
case '[':
PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
--- 1643,1649 ----
case '#':
if (PL_ofmt)
Safefree(PL_ofmt);
! PL_ofmt = savepv(SvPV(sv,len));
break;
case '[':
PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
***************
*** 1729,1735 ****
case ')':
#ifdef HAS_SETGROUPS
{
! char *p = SvPV(sv, PL_na);
Groups_t gary[NGROUPS];
SET_NUMERIC_STANDARD();
--- 1751,1757 ----
case ')':
#ifdef HAS_SETGROUPS
{
! char *p = SvPV(sv, len);
Groups_t gary[NGROUPS];
SET_NUMERIC_STANDARD();
***************
*** 1777,1783 ****
PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ':':
! PL_chopset = SvPV_force(sv,PL_na);
break;
case '0':
if (!PL_origalen) {
--- 1799,1805 ----
PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
break;
case ':':
! PL_chopset = SvPV_force(sv,len);
break;
case '0':
if (!PL_origalen) {
***************
*** 1790,1796 ****
|| PL_origargv[i] == s + 2
#endif
)
! s += strlen(++s); /* this one is ok too */
else
break;
}
--- 1812,1821 ----
|| PL_origargv[i] == s + 2
#endif
)
! {
! ++s;
! s += strlen(s); /* this one is ok too */
! }
else
break;
}
***************
*** 1803,1810 ****
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
for (i = 0; PL_origenviron[i]; i++)
! if (PL_origenviron[i] == s + 1)
! s += strlen(++s);
else
break;
}
--- 1828,1837 ----
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
for (i = 0; PL_origenviron[i]; i++)
! if (PL_origenviron[i] == s + 1) {
! ++s;
! s += strlen(s);
! }
else
break;
}
***************
*** 1851,1857 ****
croak("panic: magic_mutexfree");
MUTEX_DESTROY(MgMUTEXP(mg));
COND_DESTROY(MgCONDP(mg));
- SvREFCNT_dec(sv);
return 0;
}
#endif /* USE_THREADS */
--- 1878,1883 ----
diff -c 'perl5.005_02/mg.h' 'perl5.005_03/mg.h'
Index: ./mg.h
*** ./mg.h Thu Jul 23 23:01:00 1998
--- ./mg.h Sat Mar 27 11:56:50 1999
***************
*** 1,6 ****
/* mg.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* mg.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 43,45 ****
--- 43,50 ----
#define MgPV(mg,lp) (((lp = (mg)->mg_len) == HEf_SVKEY) ? \
SvPV((SV*)((mg)->mg_ptr),lp) : \
(mg)->mg_ptr)
+
+ #define SvTIED_mg(sv,how) \
+ (SvRMAGICAL(sv) ? mg_find((sv),(how)) : Null(MAGIC*))
+ #define SvTIED_obj(sv,mg) \
+ ((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv)))
diff -c 'perl5.005_02/miniperlmain.c' 'perl5.005_03/miniperlmain.c'
Index: ./miniperlmain.c
*** ./miniperlmain.c Thu Jul 23 23:01:00 1998
--- ./miniperlmain.c Thu Jan 28 19:14:22 1999
***************
*** 13,18 ****
--- 13,24 ----
static void xs_init _((void));
static PerlInterpreter *my_perl;
+ #if defined (__MINT__) || defined (atarist)
+ /* The Atari operating system doesn't have a dynamic stack. The
+ stack size is determined from this value. */
+ long _stksize = 64 * 1024;
+ #endif
+
int
main(int argc, char **argv, char **env)
{
diff -c /dev/null 'perl5.005_03/mint/Makefile'
Index: mint/Makefile
*** mint/Makefile Wed Dec 31 18:00:00 1969
--- mint/Makefile Thu Jan 28 19:14:22 1999
***************
*** 0 ****
--- 1,15 ----
+ # IMPORTANT: This Makefile is not intended to build Perl itself but
+ # only to replace a broken pwd command!
+
+ all: pwd
+
+ pwd: pwd.c
+ $(CC) -O3 -o pwd pwd.c
+
+ install: pwd
+ (new_pwd=`which pwd` && cp -f $$new_pwd $$new_pwd.broken \
+ && cp -f pwd $$new_pwd)
+
+ clean:
+ rm -f pwd.o pwd
+
diff -c /dev/null 'perl5.005_03/mint/README'
Index: mint/README
*** mint/README Wed Dec 31 18:00:00 1969
--- mint/README Thu Jan 28 19:14:22 1999
***************
*** 0 ****
--- 1,14 ----
+ This subdirectory contains some additional files which are necessary
+ (or at least useful) when compiling Perl on MiNT.
+
+ "Makefile" and "pwd.c" will build and install a fixed version of the
+ pwd command if your system pwd is broken.
+
+ The header files are wrappers around broken system header files. Make
+ sure that this directory stands at first place in your include path
+ when compiling Perl.
+
+ The file system.c is an enhanced version of the system() function
+ in the MiNTLib. It is strongly recommended that you insert this
+ version into your libc before you compile Perl (see README.MiNT
+ in the toplevel directory for details).
diff -c /dev/null 'perl5.005_03/mint/errno.h'
Index: mint/errno.h
*** mint/errno.h Wed Dec 31 18:00:00 1969
--- mint/errno.h Thu Jan 28 19:14:22 1999
***************
*** 0 ****
--- 1,32 ----
+ /* Wrapper around broken system errno.h. */
+
+ #ifndef _PERL_WRAPPER_AROUND_ERRNO_H
+ # define _PERL_WRAPPER_AROUND_ERRNO_H 1
+
+ /* First include the system file. */
+ #include_next <errno.h>
+
+ /* Now add the missing stuff.
+ #ifndef EAGAIN
+ # define EAGAIN EWOULDBLOCK
+ #endif
+
+ /* This one is problematic. If you open() a directory with the
+ MiNTLib you can't detect from errno if it is really a directory
+ or if the file simply doesn't exist. You'll get ENOENT
+ ("file not found") in either case.
+
+ Defining EISDIR as ENOENT is actually a bad idea but works fine
+ in general. In praxi, if code checks for errno == EISDIR it
+ will attempt an opendir() call on the file in question and this
+ call will also file if the file really can't be found. But
+ you may get compile-time errors if the errno checking is embedded
+ in a switch statement ("duplicate case value in switch").
+
+ Anyway, here the define works alright. */
+ #ifndef EISDIR
+ # define EISDIR ENOENT
+ #endif
+
+ #endif
+
diff -c /dev/null 'perl5.005_03/mint/pwd.c'
Index: mint/pwd.c
*** mint/pwd.c Wed Dec 31 18:00:00 1969
--- mint/pwd.c Thu Jan 28 19:14:23 1999
***************
*** 0 ****
--- 1,43 ----
+ /* pwd.c - replacement for broken pwd command.
+ * Copyright 1997 Guido Flohr, <gufl0000@stud.uni-sb.de>.
+ * Do with it as you please.
+ */
+ #include <stdio.h>
+ #include <limits.h>
+ #include <unistd.h>
+ #include <string.h>
+ #include <errno.h>
+
+ #if defined(__STDC__) || defined(__cplusplus)
+ int main (int argc, char* argv[])
+ #else
+ int main (argc, argv)
+ int argc;
+ char* argv[];
+ #endif
+ {
+ char path_buf[PATH_MAX + 1];
+
+ if (argc > 1) {
+ int i;
+
+ fflush (stdout);
+ fputs (argv[0], stderr);
+ fputs (": ignoring garbage arguments\n", stderr);
+ }
+
+ if (!getcwd (path_buf, PATH_MAX + 1)) {
+ fflush (stdout);
+ /* Save space, memory and the whales, avoid fprintf. */
+ fputs (argv[0], stderr);
+ fputs (": can\'t get current working directory: ", stderr);
+ fputs (strerror (errno), stderr);
+ fputc ('\n', stderr);
+ return 1;
+ }
+ if (puts (path_buf) < 0) {
+ return 1;
+ }
+ return 0;
+ }
+ /* End of pwd.c. */
diff -c /dev/null 'perl5.005_03/mint/stdio.h'
Index: mint/stdio.h
*** mint/stdio.h Wed Dec 31 18:00:00 1969
--- mint/stdio.h Thu Jan 28 19:14:23 1999
***************
*** 0 ****
--- 1,21 ----
+ /* Wrapper around broken system stdio.h. */
+
+ #ifndef _PERL_WRAPPER_AROUND_STDIO_H
+ # define _PERL_WRAPPER_AROUND_STDIO_H 1
+
+ /* The MiNTLib has a macro called EOS in stdio.h. This conflicts
+ with regnode.h. Who had this glorious idea. */
+ #ifdef EOS
+ # define PERL_EOS EOS
+ #endif
+
+ /* First include the system file. */
+ #include_next <stdio.h>
+
+ #ifdef EOS
+ # undef EOS
+ # define EOS PERL_EOS
+ #endif
+
+ #endif
+
diff -c /dev/null 'perl5.005_03/mint/sys/time.h'
Index: mint/sys/time.h
*** mint/sys/time.h Wed Dec 31 18:00:00 1969
--- mint/sys/time.h Thu Jan 28 19:14:25 1999
***************
*** 0 ****
--- 1,2 ----
+ #include <time.h>
+
diff -c /dev/null 'perl5.005_03/mint/time.h'
Index: mint/time.h
*** mint/time.h Wed Dec 31 18:00:00 1969
--- mint/time.h Thu Jan 28 19:14:25 1999
***************
*** 0 ****
--- 1,22 ----
+ /* Wrapper around broken system time.h. */
+
+ #ifndef _PERL_WRAPPER_AROUND_TIME_H
+ # define _PERL_WRAPPER_AROUND_TIME_H 1
+
+ /* Recent versions of the MiNTLib have a macro HAS_TZNAME in
+ time.h resp. sys/time.h. Wow, I wonder why they didn't
+ define HAVE_CONFIG_H ... */
+ #ifdef HAS_TZNAME
+ # define PERL_HAS_TZNAME HAS_TZNAME
+ #endif
+
+ /* First include the system file. */
+ #include_next <time.h>
+
+ #ifdef HAS_TZNAME
+ # undef HAS_TZNAME
+ # define HAS_TZNAME PERL_HAS_TZNAME
+ #endif
+
+ #endif
+
diff -c 'perl5.005_02/mpeix/relink' 'perl5.005_03/mpeix/relink'
Index: ./mpeix/relink
*** ./mpeix/relink Thu Jul 23 23:01:00 1998
--- ./mpeix/relink Thu Jan 28 19:14:25 1999
***************
*** 4,8 ****
# libraries via gcc or ld. For now, re-run gcc without the external library
# list, and then run the native linker with the list of dynamic libraries.
! gcc -o perl perlmain.o lib/auto/DynaLoader/DynaLoader.a libperl.a `cat ext.libs` -L/BIND/PUB/lib -lbind
! callci 'linkedit "altprog ./perl;xl=/lib/libsvipc.sl,/usr/lib/libsocket.sl,/lib/libm.sl,/lib/libc.sl"'
--- 4,8 ----
# libraries via gcc or ld. For now, re-run gcc without the external library
# list, and then run the native linker with the list of dynamic libraries.
! gcc -o perl perlmain.o lib/auto/DynaLoader/DynaLoader.a libperl.a `cat ext.libs` -L/BIND/PUB/lib -lbind -L/SYSLOG/PUB -lsyslog
! callci 'linkedit "altprog ./perl;xl=/usr/lib/libcurses.sl,/lib/libsvipc.sl,/usr/lib/libsocket.sl,/lib/libm.sl,/lib/libc.sl"'
diff -c 'perl5.005_02/objXSUB.h' 'perl5.005_03/objXSUB.h'
Index: ./objXSUB.h
*** ./objXSUB.h Thu Jul 23 23:01:01 1998
--- ./objXSUB.h Sat Jan 16 12:13:37 1999
***************
*** 19,24 ****
--- 19,26 ----
#define PL_colors pPerl->PL_colors
#undef PL_colorset
#define PL_colorset pPerl->PL_colorset
+ #undef PL_cred_mutex
+ #define PL_cred_mutex pPerl->PL_cred_mutex
#undef PL_curcop
#define PL_curcop pPerl->PL_curcop
#undef PL_curpad
***************
*** 443,448 ****
--- 445,452 ----
#define PL_strchop pPerl->PL_strchop
#undef PL_strtab
#define PL_strtab pPerl->PL_strtab
+ #undef PL_strtab_mutex
+ #define PL_strtab_mutex pPerl->PL_strtab_mutex
#undef PL_sub_generation
#define PL_sub_generation pPerl->PL_sub_generation
#undef PL_sublex_info
***************
*** 902,907 ****
--- 906,913 ----
#define do_vecset pPerl->Perl_do_vecset
#undef do_vop
#define do_vop pPerl->Perl_do_vop
+ #undef dofile
+ #define dofile pPerl->Perl_dofile
#undef dowantarray
#define dowantarray pPerl->Perl_dowantarray
#undef dump_all
***************
*** 966,971 ****
--- 972,979 ----
#define get_opargs pPerl->Perl_get_opargs
#undef get_specialsv_list
#define get_specialsv_list pPerl->Perl_get_specialsv_list
+ #undef get_vtbl
+ #define get_vtbl pPerl->Perl_get_vtbl
#undef gp_free
#define gp_free pPerl->Perl_gp_free
#undef gp_ref
***************
*** 1569,1574 ****
--- 1577,1584 ----
#define save_freeop pPerl->Perl_save_freeop
#undef save_freepv
#define save_freepv pPerl->Perl_save_freepv
+ #undef save_generic_svref
+ #define save_generic_svref pPerl->Perl_generic_save_svref
#undef save_gp
#define save_gp pPerl->Perl_save_gp
#undef save_hash
***************
*** 1977,1984 ****
#define signal PerlProc_signal
#define htonl PerlSock_htonl
#define htons PerlSock_htons
! #define ntohs PerlSock_ntohl
! #define ntohl PerlSock_ntohs
#define accept PerlSock_accept
#define bind PerlSock_bind
#define connect PerlSock_connect
--- 1987,1994 ----
#define signal PerlProc_signal
#define htonl PerlSock_htonl
#define htons PerlSock_htons
! #define ntohl PerlSock_ntohl
! #define ntohs PerlSock_ntohs
#define accept PerlSock_accept
#define bind PerlSock_bind
#define connect PerlSock_connect
diff -c 'perl5.005_02/objpp.h' 'perl5.005_03/objpp.h'
Index: ./objpp.h
*** ./objpp.h Thu Jul 23 23:01:02 1998
--- ./objpp.h Sat Jan 16 12:13:37 1999
***************
*** 3,8 ****
--- 3,12 ----
#undef amagic_call
#define amagic_call CPerlObj::Perl_amagic_call
+ #undef amagic_cmp
+ #define amagic_cmp CPerlObj::amagic_cmp
+ #undef amagic_cmp_locale
+ #define amagic_cmp_locale CPerlObj::amagic_cmp_locale
#undef Gv_AMupdate
#define Gv_AMupdate CPerlObj::Perl_Gv_AMupdate
#undef add_data
***************
*** 289,294 ****
--- 293,300 ----
#define do_vecset CPerlObj::Perl_do_vecset
#undef do_vop
#define do_vop CPerlObj::Perl_do_vop
+ #undef dofile
+ #define dofile CPerlObj::Perl_dofile
#undef do_clean_all
#define do_clean_all CPerlObj::do_clean_all
#undef do_clean_named_objs
***************
*** 375,380 ****
--- 381,388 ----
#define get_opargs CPerlObj::Perl_get_opargs
#undef get_specialsv_list
#define get_specialsv_list CPerlObj::Perl_get_specialsv_list
+ #undef get_vtbl
+ #define get_vtbl CPerlObj::Perl_get_vtbl
#undef getlogin
#define getlogin CPerlObj::getlogin
#undef gp_free
***************
*** 1095,1100 ****
--- 1103,1110 ----
#define save_freeop CPerlObj::Perl_save_freeop
#undef save_freepv
#define save_freepv CPerlObj::Perl_save_freepv
+ #undef save_generic_svref
+ #define save_generic_svref CPerlObj::Perl_save_generic_svref
#undef save_gp
#define save_gp CPerlObj::Perl_save_gp
#undef save_hash
diff -c 'perl5.005_02/op.c' 'perl5.005_03/op.c'
Index: ./op.c
*** ./op.c Mon Aug 3 11:36:04 1998
--- ./op.c Sun Mar 28 10:13:03 1999
***************
*** 1,6 ****
/* op.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* op.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 35,40 ****
--- 35,42 ----
Nullop ) \
: (CHECKCALL[type])((OP*)o))
+ #define PAD_MAX 999999999
+
static bool scalar_mod_type _((OP *o, I32 type));
#ifndef PERL_OBJECT
static I32 list_assignment _((OP *o));
***************
*** 46,52 ****
static OP *too_many_arguments _((OP *o, char* name));
static void null _((OP* o));
static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
! CV* startcv, I32 cx_ix));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
#endif
--- 48,54 ----
static OP *too_many_arguments _((OP *o, char* name));
static void null _((OP* o));
static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
! CV* startcv, I32 cx_ix, I32 saweval, U32 flags));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
#endif
***************
*** 55,62 ****
gv_ename(GV *gv)
{
SV* tmpsv = sv_newmortal();
gv_efullname3(tmpsv, gv, Nullch);
! return SvPV(tmpsv,PL_na);
}
STATIC OP *
--- 57,65 ----
gv_ename(GV *gv)
{
SV* tmpsv = sv_newmortal();
+ STRLEN n_a;
gv_efullname3(tmpsv, gv, Nullch);
! return SvPV(tmpsv,n_a);
}
STATIC OP *
***************
*** 131,140 ****
for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
if ((sv = svp[off])
&& sv != &PL_sv_undef
! && SvIVX(sv) == 999999999 /* var is in open scope */
&& strEQ(name, SvPVX(sv)))
{
! warn("\"my\" variable %s masks earlier declaration in same scope", name);
break;
}
}
--- 134,144 ----
for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
if ((sv = svp[off])
&& sv != &PL_sv_undef
! && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
&& strEQ(name, SvPVX(sv)))
{
! warn("\"my\" variable %s masks earlier declaration in same %s",
! name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
break;
}
}
***************
*** 152,158 ****
PL_sv_objcount++;
}
av_store(PL_comppad_name, off, sv);
! SvNVX(sv) = (double)999999999;
SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
if (!PL_min_intro_pending)
PL_min_intro_pending = off;
--- 156,162 ----
PL_sv_objcount++;
}
av_store(PL_comppad_name, off, sv);
! SvNVX(sv) = (double)PAD_MAX;
SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
if (!PL_min_intro_pending)
PL_min_intro_pending = off;
***************
*** 165,172 ****
return off;
}
STATIC PADOFFSET
! pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
{
dTHR;
CV *cv;
--- 169,179 ----
return off;
}
+ #define FINDLEX_NOSEARCH 1 /* don't search outer contexts */
+
STATIC PADOFFSET
! pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval,
! U32 flags)
{
dTHR;
CV *cv;
***************
*** 174,180 ****
SV *sv;
register I32 i;
register PERL_CONTEXT *cx;
- int saweval;
for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
AV *curlist = CvPADLIST(cv);
--- 181,186 ----
***************
*** 214,221 ****
sv_setpv(namesv, name);
av_store(PL_comppad_name, newoff, namesv);
SvNVX(namesv) = (double)PL_curcop->cop_seq;
! SvIVX(namesv) = 999999999; /* A ref, intro immediately */
SvFAKE_on(namesv); /* A ref, not a real var */
if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
/* "It's closures all the way down." */
CvCLONE_on(PL_compcv);
--- 220,233 ----
sv_setpv(namesv, name);
av_store(PL_comppad_name, newoff, namesv);
SvNVX(namesv) = (double)PL_curcop->cop_seq;
! SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */
SvFAKE_on(namesv); /* A ref, not a real var */
+ if (SvOBJECT(svp[off])) { /* A typed var */
+ SvOBJECT_on(namesv);
+ (void)SvUPGRADE(namesv, SVt_PVMG);
+ SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(svp[off]));
+ PL_sv_objcount++;
+ }
if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
/* "It's closures all the way down." */
CvCLONE_on(PL_compcv);
***************
*** 227,240 ****
CV *bcv;
for (bcv = startcv;
bcv && bcv != cv && !CvCLONE(bcv);
! bcv = CvOUTSIDE(bcv)) {
if (CvANON(bcv))
CvCLONE_on(bcv);
else {
! if (PL_dowarn && !CvUNIQUE(cv))
warn(
"Variable \"%s\" may be unavailable",
name);
break;
}
}
--- 239,256 ----
CV *bcv;
for (bcv = startcv;
bcv && bcv != cv && !CvCLONE(bcv);
! bcv = CvOUTSIDE(bcv))
! {
if (CvANON(bcv))
CvCLONE_on(bcv);
else {
! if (PL_dowarn
! && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
! {
warn(
"Variable \"%s\" may be unavailable",
name);
+ }
break;
}
}
***************
*** 251,275 ****
}
}
/* Nothing in current lexical context--try eval's context, if any.
* This is necessary to let the perldb get at lexically scoped variables.
* XXX This will also probably interact badly with eval tree caching.
*/
- saweval = 0;
for (i = cx_ix; i >= 0; i--) {
cx = &cxstack[i];
! switch (cx->cx_type) {
default:
if (i == 0 && saweval) {
seq = cxstack[saweval].blk_oldcop->cop_seq;
! return pad_findlex(name, newoff, seq, PL_main_cv, 0);
}
break;
case CXt_EVAL:
switch (cx->blk_eval.old_op_type) {
case OP_ENTEREVAL:
! saweval = i;
break;
case OP_REQUIRE:
/* require must have its own scope */
--- 267,294 ----
}
}
+ if (flags & FINDLEX_NOSEARCH)
+ return 0;
+
/* Nothing in current lexical context--try eval's context, if any.
* This is necessary to let the perldb get at lexically scoped variables.
* XXX This will also probably interact badly with eval tree caching.
*/
for (i = cx_ix; i >= 0; i--) {
cx = &cxstack[i];
! switch (CxTYPE(cx)) {
default:
if (i == 0 && saweval) {
seq = cxstack[saweval].blk_oldcop->cop_seq;
! return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
}
break;
case CXt_EVAL:
switch (cx->blk_eval.old_op_type) {
case OP_ENTEREVAL:
! if (CxREALEVAL(cx))
! saweval = i;
break;
case OP_REQUIRE:
/* require must have its own scope */
***************
*** 285,291 ****
continue;
}
seq = cxstack[saweval].blk_oldcop->cop_seq;
! return pad_findlex(name, newoff, seq, cv, i-1);
}
}
--- 304,310 ----
continue;
}
seq = cxstack[saweval].blk_oldcop->cop_seq;
! return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
}
}
***************
*** 301,306 ****
--- 320,327 ----
SV *sv;
SV **svp = AvARRAY(PL_comppad_name);
U32 seq = PL_cop_seqmax;
+ PERL_CONTEXT *cx;
+ CV *outside;
#ifdef USE_THREADS
/*
***************
*** 330,337 ****
}
}
/* See if it's in a nested scope */
! off = pad_findlex(name, 0, seq, CvOUTSIDE(PL_compcv), cxstack_ix);
if (off) {
/* If there is a pending local definition, this new alias must die */
if (pendoff)
--- 351,370 ----
}
}
+ outside = CvOUTSIDE(PL_compcv);
+
+ /* Check if if we're compiling an eval'', and adjust seq to be the
+ * eval's seq number. This depends on eval'' having a non-null
+ * CvOUTSIDE() while it is being compiled. The eval'' itself is
+ * identified by CvEVAL being true and CvGV being null. */
+ if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
+ cx = &cxstack[cxstack_ix];
+ if (CxREALEVAL(cx))
+ seq = cx->blk_oldcop->cop_seq;
+ }
+
/* See if it's in a nested scope */
! off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0);
if (off) {
/* If there is a pending local definition, this new alias must die */
if (pendoff)
***************
*** 355,361 ****
}
/* "Deintroduce" my variables that are leaving with this scope. */
for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
! if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == 999999999)
SvIVX(sv) = PL_cop_seqmax;
}
}
--- 388,394 ----
}
/* "Deintroduce" my variables that are leaving with this scope. */
for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
! if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX)
SvIVX(sv) = PL_cop_seqmax;
}
}
***************
*** 517,527 ****
if (!p)
return NOT_IN_PAD;
key = p - PL_threadsv_names;
svp = av_fetch(thr->threadsv, key, FALSE);
! if (!svp) {
SV *sv = NEWSV(0, 0);
av_store(thr->threadsv, key, sv);
thr->threadsvp = AvARRAY(thr->threadsv);
/*
* Some magic variables used to be automagically initialised
* in gv_fetchpv. Those which are now per-thread magicals get
--- 550,564 ----
if (!p)
return NOT_IN_PAD;
key = p - PL_threadsv_names;
+ MUTEX_LOCK(&thr->mutex);
svp = av_fetch(thr->threadsv, key, FALSE);
! if (svp)
! MUTEX_UNLOCK(&thr->mutex);
! else {
SV *sv = NEWSV(0, 0);
av_store(thr->threadsv, key, sv);
thr->threadsvp = AvARRAY(thr->threadsv);
+ MUTEX_UNLOCK(&thr->mutex);
/*
* Some magic variables used to be automagically initialised
* in gv_fetchpv. Those which are now per-thread magicals get
***************
*** 538,543 ****
--- 575,590 ----
case '`':
case '\'':
PL_sawampersand = TRUE;
+ /* FALL THROUGH */
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9':
SvREADONLY_on(sv);
/* FALL THROUGH */
***************
*** 774,780 ****
SV* sv;
/* assumes no premature commitment */
! if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || PL_error_count
|| o->op_type == OP_RETURN)
return o;
--- 821,828 ----
SV* sv;
/* assumes no premature commitment */
! U8 want = o->op_flags & OPf_WANT;
! if (!o || (want && want != OPf_WANT_SCALAR) || PL_error_count
|| o->op_type == OP_RETURN)
return o;
***************
*** 1076,1081 ****
--- 1124,1130 ----
dTHR;
OP *kid;
SV *sv;
+ STRLEN n_a;
if (!o || PL_error_count)
return o;
***************
*** 1202,1208 ****
PL_modcount++;
if (!type)
croak("Can't localize lexical variable %s",
! SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na));
break;
#ifdef USE_THREADS
--- 1251,1257 ----
PL_modcount++;
if (!type)
croak("Can't localize lexical variable %s",
! SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
break;
#ifdef USE_THREADS
***************
*** 1866,1872 ****
first->op_last = last->op_last;
first->op_children += last->op_children;
if (first->op_children)
! last->op_flags |= OPf_KIDS;
Safefree(last);
return (OP*)first;
--- 1915,1921 ----
first->op_last = last->op_last;
first->op_children += last->op_children;
if (first->op_children)
! first->op_flags |= OPf_KIDS;
Safefree(last);
return (OP*)first;
***************
*** 2179,2186 ****
if (repl) {
OP *curop;
! if (pm->op_pmflags & PMf_EVAL)
curop = 0;
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
&& strchr("&`'123456789+",
--- 2228,2238 ----
if (repl) {
OP *curop;
! if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
+ if (PL_curcop->cop_line < PL_multi_end)
+ PL_curcop->cop_line = PL_multi_end;
+ }
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
&& strchr("&`'123456789+",
***************
*** 2339,2344 ****
--- 2391,2397 ----
sv_setpv(PL_curstname,"<none>");
PL_curstash = Nullhv;
}
+ PL_hints |= HINT_BLOCK_SCOPE;
PL_copline = NOLINE;
PL_expect = XSTATE;
}
***************
*** 2351,2356 ****
--- 2404,2410 ----
OP *rqop;
OP *imop;
OP *veop;
+ GV *gv;
if (id->op_type != OP_CONST)
croak("Module name must be constant");
***************
*** 2402,2409 ****
newUNOP(OP_METHOD, 0, meth)));
}
! /* Fake up a require */
! rqop = newUNOP(OP_REQUIRE, 0, id);
/* Fake up the BEGIN {}, which does its thing immediately. */
newSUB(floor,
--- 2456,2476 ----
newUNOP(OP_METHOD, 0, meth)));
}
! /* Fake up a require, handle override, if any */
! gv = gv_fetchpv("require", FALSE, SVt_PVCV);
! if (!(gv && GvIMPORTED_CV(gv)))
! gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
!
! if (gv && GvIMPORTED_CV(gv)) {
! rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
! append_elem(OP_LIST, id,
! scalar(newUNOP(OP_RV2CV, 0,
! newGVOP(OP_GV, 0,
! gv))))));
! }
! else {
! rqop = newUNOP(OP_REQUIRE, 0, id);
! }
/* Fake up the BEGIN {}, which does its thing immediately. */
newSUB(floor,
***************
*** 2420,2425 ****
--- 2487,2515 ----
}
OP *
+ dofile(OP *term)
+ {
+ OP *doop;
+ GV *gv;
+
+ gv = gv_fetchpv("do", FALSE, SVt_PVCV);
+ if (!(gv && GvIMPORTED_CV(gv)))
+ gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
+
+ if (gv && GvIMPORTED_CV(gv)) {
+ doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, term,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0,
+ gv))))));
+ }
+ else {
+ doop = newUNOP(OP_DOFILE, 0, scalar(term));
+ }
+ return doop;
+ }
+
+ OP *
newSLICEOP(I32 flags, OP *subscript, OP *listval)
{
return newBINOP(OP_LSLICE, flags,
***************
*** 2663,2669 ****
svp = AvARRAY(PL_comppad_name);
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
! SvIVX(sv) = 999999999; /* Don't know scope end yet. */
SvNVX(sv) = (double)PL_cop_seqmax;
}
}
--- 2753,2759 ----
svp = AvARRAY(PL_comppad_name);
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
! SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
SvNVX(sv) = (double)PL_cop_seqmax;
}
}
***************
*** 3115,3127 ****
{
dTHR;
OP *o;
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
o = newOP(type, OPf_SPECIAL);
else {
o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
! ? SvPVx(((SVOP*)label)->op_sv, PL_na)
: ""));
}
op_free(label);
--- 3205,3218 ----
{
dTHR;
OP *o;
+ STRLEN n_a;
if (type != OP_GOTO || label->op_type == OP_CONST) {
/* "last()" means "last" */
if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
o = newOP(type, OPf_SPECIAL);
else {
o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
! ? SvPVx(((SVOP*)label)->op_sv, n_a)
: ""));
}
op_free(label);
***************
*** 3211,3217 ****
cv,
(CvANON(cv) ? "ANON"
: (cv == PL_main_cv) ? "MAIN"
! : CvUNIQUE(outside) ? "UNIQUE"
: CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
outside,
(!outside ? "null"
--- 3302,3308 ----
cv,
(CvANON(cv) ? "ANON"
: (cv == PL_main_cv) ? "MAIN"
! : CvUNIQUE(cv) ? "UNIQUE"
: CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
outside,
(!outside ? "null"
***************
*** 3311,3317 ****
char *name = SvPVX(namesv); /* XXX */
if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
I32 off = pad_findlex(name, ix, SvIVX(namesv),
! CvOUTSIDE(cv), cxstack_ix);
if (!off)
PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
else if (off != ix)
--- 3402,3408 ----
char *name = SvPVX(namesv); /* XXX */
if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
I32 off = pad_findlex(name, ix, SvIVX(namesv),
! CvOUTSIDE(cv), cxstack_ix, 0, 0);
if (!off)
PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
else if (off != ix)
***************
*** 3375,3381 ****
CV *
cv_clone(CV *proto)
{
! return cv_clone2(proto, CvOUTSIDE(proto));
}
void
--- 3466,3476 ----
CV *
cv_clone(CV *proto)
{
! CV *cv;
! MUTEX_LOCK(&PL_cred_mutex); /* XXX create separate mutex */
! cv = cv_clone2(proto, CvOUTSIDE(proto));
! MUTEX_UNLOCK(&PL_cred_mutex); /* XXX create separate mutex */
! return cv;
}
void
***************
*** 3451,3460 ****
newSUB(I32 floor, OP *o, OP *proto, OP *block)
{
dTHR;
! char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch;
GV *gv = gv_fetchpv(name ? name : "__ANON__",
GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
! char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch;
register CV *cv=0;
I32 ix;
--- 3546,3556 ----
newSUB(I32 floor, OP *o, OP *proto, OP *block)
{
dTHR;
! STRLEN n_a;
! char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
GV *gv = gv_fetchpv(name ? name : "__ANON__",
GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
! char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
register CV *cv=0;
I32 ix;
***************
*** 3536,3544 ****
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(cv) = 0;
! if (!CvMUTEXP(cv))
New(666, CvMUTEXP(cv), 1, perl_mutex);
! MUTEX_INIT(CvMUTEXP(cv));
#endif /* USE_THREADS */
if (ps)
--- 3632,3641 ----
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(cv) = 0;
! if (!CvMUTEXP(cv)) {
New(666, CvMUTEXP(cv), 1, perl_mutex);
! MUTEX_INIT(CvMUTEXP(cv));
! }
#endif /* USE_THREADS */
if (ps)
***************
*** 3558,3564 ****
else {
/* force display of errors found but not reported */
sv_catpv(ERRSV, not_safe);
! croak("%s", SvPVx(ERRSV, PL_na));
}
}
}
--- 3655,3661 ----
else {
/* force display of errors found but not reported */
sv_catpv(ERRSV, not_safe);
! croak("%s", SvPVx(ERRSV, n_a));
}
}
}
***************
*** 3683,3688 ****
--- 3780,3786 ----
return cv;
}
+ /* XXX unsafe for threads if eval_owner isn't held */
void
newCONSTSUB(HV *stash, char *name, SV *sv)
{
***************
*** 3729,3735 ****
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
line_t oldline = PL_curcop->cop_line;
! PL_curcop->cop_line = PL_copline;
warn("Subroutine %s redefined",name);
PL_curcop->cop_line = oldline;
}
--- 3827,3834 ----
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
line_t oldline = PL_curcop->cop_line;
! if (PL_copline != NOLINE)
! PL_curcop->cop_line = PL_copline;
warn("Subroutine %s redefined",name);
PL_curcop->cop_line = oldline;
}
***************
*** 3781,3786 ****
--- 3880,3886 ----
if (!PL_initav)
PL_initav = newAV();
av_push(PL_initav, (SV *)cv);
+ GvCV(gv) = 0;
}
}
else
***************
*** 3797,3805 ****
char *name;
GV *gv;
I32 ix;
if (o)
! name = SvPVx(cSVOPo->op_sv, PL_na);
else
name = "STDOUT";
gv = gv_fetchpv(name,TRUE, SVt_PVFM);
--- 3897,3906 ----
char *name;
GV *gv;
I32 ix;
+ STRLEN n_a;
if (o)
! name = SvPVx(cSVOPo->op_sv, n_a);
else
name = "STDOUT";
gv = gv_fetchpv(name,TRUE, SVt_PVFM);
***************
*** 3861,3867 ****
case OP_PADSV:
o->op_type = OP_PADAV;
o->op_ppaddr = ppaddr[OP_PADAV];
! return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
case OP_RV2SV:
o->op_type = OP_RV2AV;
--- 3962,3968 ----
case OP_PADSV:
o->op_type = OP_PADAV;
o->op_ppaddr = ppaddr[OP_PADAV];
! return ref(o, OP_RV2AV);
case OP_RV2SV:
o->op_type = OP_RV2AV;
***************
*** 3884,3890 ****
case OP_PADAV:
o->op_type = OP_PADHV;
o->op_ppaddr = ppaddr[OP_PADHV];
! return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
case OP_RV2SV:
case OP_RV2AV:
--- 3985,3991 ----
case OP_PADAV:
o->op_type = OP_PADHV;
o->op_ppaddr = ppaddr[OP_PADHV];
! return ref(o, OP_RV2HV);
case OP_RV2SV:
case OP_RV2AV:
***************
*** 3914,3920 ****
OP *
newGVREF(I32 type, OP *o)
{
! if (type == OP_MAPSTART)
return newUNOP(OP_NULL, 0, o);
return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
}
--- 4015,4021 ----
OP *
newGVREF(I32 type, OP *o)
{
! if (type == OP_MAPSTART || type == OP_GREPSTART)
return newUNOP(OP_NULL, 0, o);
return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
}
***************
*** 4145,4152 ****
char *name;
int iscv;
GV *gv;
- name = SvPV(kid->op_sv, PL_na);
if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
char *badthing = Nullch;
switch (o->op_type) {
--- 4246,4293 ----
char *name;
int iscv;
GV *gv;
+ SV *kidsv = kid->op_sv;
+ STRLEN n_a;
+
+ /* Is it a constant from cv_const_sv()? */
+ if (SvROK(kidsv) && SvREADONLY(kidsv)) {
+ SV *rsv = SvRV(kidsv);
+ int svtype = SvTYPE(rsv);
+ char *badtype = Nullch;
+
+ switch (o->op_type) {
+ case OP_RV2SV:
+ if (svtype > SVt_PVMG)
+ badtype = "a SCALAR";
+ break;
+ case OP_RV2AV:
+ if (svtype != SVt_PVAV)
+ badtype = "an ARRAY";
+ break;
+ case OP_RV2HV:
+ if (svtype != SVt_PVHV) {
+ if (svtype == SVt_PVAV) { /* pseudohash? */
+ SV **ksv = av_fetch((AV*)rsv, 0, FALSE);
+ if (ksv && SvROK(*ksv)
+ && SvTYPE(SvRV(*ksv)) == SVt_PVHV)
+ {
+ break;
+ }
+ }
+ badtype = "a HASH";
+ }
+ break;
+ case OP_RV2CV:
+ if (svtype != SVt_PVCV)
+ badtype = "a CODE";
+ break;
+ }
+ if (badtype)
+ croak("Constant is not %s reference", badtype);
+ return o;
+ }
+ name = SvPV(kidsv, n_a);
if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
char *badthing = Nullch;
switch (o->op_type) {
***************
*** 4209,4216 ****
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(type, OPf_REF,
! gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO));
op_free(o);
return newop;
}
--- 4350,4358 ----
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+ STRLEN n_a;
OP *newop = newGVOP(type, OPf_REF,
! gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
op_free(o);
return newop;
}
***************
*** 4245,4250 ****
--- 4387,4393 ----
}
if (o->op_flags & OPf_KIDS) {
+ STRLEN n_a;
tokid = &cLISTOPo->op_first;
kid = cLISTOPo->op_first;
if (kid->op_type == OP_PUSHMARK ||
***************
*** 4274,4280 ****
case OA_AVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
! char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
if (PL_dowarn)
--- 4417,4423 ----
case OA_AVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
! char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
if (PL_dowarn)
***************
*** 4292,4298 ****
case OA_HVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
! char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
if (PL_dowarn)
--- 4435,4441 ----
case OA_HVREF:
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
! char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
if (PL_dowarn)
***************
*** 4323,4333 ****
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(OP_GV, 0,
! gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE,
SVt_PVIO) );
op_free(kid);
kid = newop;
}
else {
kid->op_sibling = 0;
kid = newUNOP(OP_RV2GV, 0, scalar(kid));
--- 4466,4480 ----
if (kid->op_type == OP_CONST &&
(kid->op_private & OPpCONST_BARE)) {
OP *newop = newGVOP(OP_GV, 0,
! gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
SVt_PVIO) );
op_free(kid);
kid = newop;
}
+ else if (kid->op_type == OP_READLINE) {
+ /* neophyte patrol: open(<FH>), close(<FH>) etc. */
+ bad_type(numargs, "HANDLE", op_desc[o->op_type], kid);
+ }
else {
kid->op_sibling = 0;
kid = newUNOP(OP_RV2GV, 0, scalar(kid));
***************
*** 4376,4382 ****
--- 4523,4531 ----
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
if (gv && GvIMPORTED_CV(gv)) {
+ #ifndef PERL_OBJECT
static int glob_index;
+ #endif
append_elem(OP_GLOB, o,
newSVOP(OP_CONST, 0, newSViv(glob_index++)));
***************
*** 4455,4460 ****
--- 4604,4611 ----
{
if (o->op_flags & OPf_KIDS) {
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
+ if (kid)
+ kid = kid->op_sibling; /* get past "big" */
if (kid && kid->op_type == OP_CONST)
fbm_compile(((SVOP*)kid)->op_sv, 0);
}
***************
*** 4661,4666 ****
--- 4812,4822 ----
if (o->op_flags & OPf_STACKED) {
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
+
+ if (o->op_type == OP_SORT) {
+ GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
+ GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV));
+ }
kid = kUNOP->op_first; /* get past rv2gv */
if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
***************
*** 4693,4699 ****
kid->op_next = k;
o->op_flags |= OPf_SPECIAL;
}
! }
return o;
}
--- 4849,4857 ----
kid->op_next = k;
o->op_flags |= OPf_SPECIAL;
}
! else if (kid->op_type == OP_RV2SV || kid->op_type == OP_PADSV)
! null(cLISTOPo->op_first->op_sibling);
! }
return o;
}
***************
*** 4762,4767 ****
--- 4920,4926 ----
GV *namegv = 0;
int optional = 0;
I32 arg = 0;
+ STRLEN n_a;
for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
if (cvop->op_type == OP_RV2CV) {
***************
*** 4773,4779 ****
cv = GvCVu(tmpop->op_sv);
if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
! proto = SvPV((SV*)cv, PL_na);
}
}
}
--- 4932,4938 ----
cv = GvCVu(tmpop->op_sv);
if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
! proto = SvPV((SV*)cv, n_a);
}
}
}
***************
*** 4806,4824 ****
bad_type(arg, "block", gv_ename(namegv), o2);
break;
case '*':
proto++;
arg++;
if (o2->op_type == OP_RV2GV)
! goto wrapref;
! {
! OP* kid = o2;
! OP* sib = kid->op_sibling;
! kid->op_sibling = 0;
! o2 = newUNOP(OP_RV2GV, 0, kid);
! o2->op_sibling = sib;
! prev->op_sibling = o2;
! }
! goto wrapref;
case '\\':
proto++;
arg++;
--- 4965,4977 ----
bad_type(arg, "block", gv_ename(namegv), o2);
break;
case '*':
+ /* '*' allows any scalar type, including bareword */
proto++;
arg++;
if (o2->op_type == OP_RV2GV)
! goto wrapref; /* autoconvert GLOB -> GLOBref */
! scalar(o2);
! break;
case '\\':
proto++;
arg++;
***************
*** 4865,4871 ****
default:
oops:
croak("Malformed prototype for %s: %s",
! gv_ename(namegv), SvPV((SV*)cv, PL_na));
}
}
else
--- 5018,5024 ----
default:
oops:
croak("Malformed prototype for %s: %s",
! gv_ename(namegv), SvPV((SV*)cv, n_a));
}
}
else
***************
*** 4909,4914 ****
--- 5062,5068 ----
{
dTHR;
register OP* oldop = 0;
+ STRLEN n_a;
if (!o || o->op_seq)
return;
ENTER;
***************
*** 4997,5020 ****
o->op_seq = PL_op_seqmax++;
break;
- case OP_PADAV:
- if (o->op_next->op_type == OP_RV2AV
- && (o->op_next->op_flags & OPf_REF))
- {
- null(o->op_next);
- o->op_next = o->op_next->op_next;
- }
- break;
-
- case OP_PADHV:
- if (o->op_next->op_type == OP_RV2HV
- && (o->op_next->op_flags & OPf_REF))
- {
- null(o->op_next);
- o->op_next = o->op_next->op_next;
- }
- break;
-
case OP_MAPWHILE:
case OP_GREPWHILE:
case OP_AND:
--- 5151,5156 ----
***************
*** 5088,5094 ****
indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
if (!indsvp) {
croak("No such field \"%s\" in variable %s of type %s",
! key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname)));
}
ind = SvIV(*indsvp);
if (ind < 1)
--- 5224,5230 ----
indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
if (!indsvp) {
croak("No such field \"%s\" in variable %s of type %s",
! key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
}
ind = SvIV(*indsvp);
if (ind < 1)
diff -c 'perl5.005_02/op.h' 'perl5.005_03/op.h'
Index: ./op.h
*** ./op.h Thu Jul 23 23:01:05 1998
--- ./op.h Sat Mar 27 11:56:40 1999
***************
*** 1,6 ****
/* op.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* op.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/opcode.h' 'perl5.005_03/opcode.h'
Index: ./opcode.h
*** ./opcode.h Fri Aug 7 19:05:17 1998
--- ./opcode.h Sat Mar 27 22:31:18 1999
***************
*** 891,897 ****
"line sequence",
"next statement",
"debug next statement",
! "unstack",
"block entry",
"block exit",
"block",
--- 891,897 ----
"line sequence",
"next statement",
"debug next statement",
! "iteration finalizer",
"block entry",
"block exit",
"block",
***************
*** 2320,2326 ****
0x00002505, /* anonhash */
0x02993501, /* splice */
0x0002351d, /* push */
! 0x00003c14, /* pop */
0x00003c04, /* shift */
0x0002351d, /* unshift */
0x0002d501, /* sort */
--- 2320,2326 ----
0x00002505, /* anonhash */
0x02993501, /* splice */
0x0002351d, /* push */
! 0x00003c04, /* pop */
0x00003c04, /* shift */
0x0002351d, /* unshift */
0x0002d501, /* sort */
***************
*** 2385,2391 ****
0x09116504, /* sysopen */
0x00116504, /* sysseek */
0x0917651d, /* sysread */
! 0x0911651d, /* syswrite */
0x0911651d, /* send */
0x0117651d, /* recv */
0x0000ec14, /* eof */
--- 2385,2391 ----
0x09116504, /* sysopen */
0x00116504, /* sysseek */
0x0917651d, /* sysread */
! 0x0991651d, /* syswrite */
0x0911651d, /* send */
0x0117651d, /* recv */
0x0000ec14, /* eof */
diff -c 'perl5.005_02/opcode.pl' 'perl5.005_03/opcode.pl'
Index: ./opcode.pl
*** ./opcode.pl Fri Aug 7 19:03:54 1998
--- ./opcode.pl Sat Mar 27 22:31:09 1999
***************
*** 432,438 ****
splice splice ck_fun m@ A S? S? L
push push ck_fun imst@ A L
! pop pop ck_shift si% A
shift shift ck_shift s% A
unshift unshift ck_fun imst@ A L
sort sort ck_sort m@ C? L
--- 432,438 ----
splice splice ck_fun m@ A S? S? L
push push ck_fun imst@ A L
! pop pop ck_shift s% A
shift shift ck_shift s% A
unshift unshift ck_fun imst@ A L
sort sort ck_sort m@ C? L
***************
*** 470,476 ****
lineseq line sequence ck_null @
nextstate next statement ck_null s;
dbstate debug next statement ck_null s;
! unstack unstack ck_null s0
enter block entry ck_null 0
leave block exit ck_null @
scope block ck_null @
--- 470,476 ----
lineseq line sequence ck_null @
nextstate next statement ck_null s;
dbstate debug next statement ck_null s;
! unstack iteration finalizer ck_null s0
enter block entry ck_null 0
leave block exit ck_null @
scope block ck_null @
***************
*** 519,525 ****
sysopen sysopen ck_fun s@ F S S S?
sysseek sysseek ck_fun s@ F S S
sysread sysread ck_fun imst@ F R S S?
! syswrite syswrite ck_fun imst@ F S S S?
send send ck_fun imst@ F S S S?
recv recv ck_fun imst@ F R S S
--- 519,525 ----
sysopen sysopen ck_fun s@ F S S S?
sysseek sysseek ck_fun s@ F S S
sysread sysread ck_fun imst@ F R S S?
! syswrite syswrite ck_fun imst@ F S S? S?
send send ck_fun imst@ F S S S?
recv recv ck_fun imst@ F R S S
diff -c 'perl5.005_02/os2/Changes' 'perl5.005_03/os2/Changes'
Index: ./os2/Changes
*** ./os2/Changes Thu Jul 23 23:01:06 1998
--- ./os2/Changes Thu Jan 21 19:10:23 1999
***************
*** 198,200 ****
--- 198,223 ----
metachars, or if magic-line asks for sh, or there is no magic
line and EXECSHELL is set to sh.
Shell is supplied the original command line if possible.
+
+ after 5.005_02:
+ Can start PM programs from non-PM sessions by plain system()
+ and friends. Can start DOS/Win programs. Can start
+ fullscreen programs from non-fullscreen sessions too.
+ In fact system(P_PM,...) was broken.
+ We mangle the name of perl*.DLL, to allow coexistence of different
+ versions of Perl executables on the system. Mangling of
+ names of extension DLL is also changed, thus running two
+ different versions of the executable with loaded
+ extensions should not lead to conflicts (since
+ extension-full-name and Perl-version mangling work in the
+ same set ot 576 possible keys, this may lead to clashes).
+ $^E was reset on the second read, and contained ".\r\n" at the end.
+ after 5.005_53:
+ Would segfault system()ing non-existing program;
+ AOUT build was hosed;
+ warning-test for getpriority() might lock the system hard on
+ pre-fixpak22 configuration (calling getpriority() on
+ non-existing process triggers a system-wide bug).
+
+
+ PrfDB was using a bug in processing XSUBs returning U32.
diff -c 'perl5.005_02/os2/Makefile.SHs' 'perl5.005_03/os2/Makefile.SHs'
Index: ./os2/Makefile.SHs
*** ./os2/Makefile.SHs Thu Jul 23 23:01:06 1998
--- ./os2/Makefile.SHs Thu Jan 21 19:10:23 1999
***************
*** 8,23 ****
perl_version="5.00${PATCHLEVEL}_$SUBVERSION"
case "$archname" in
! *-thread) dll_post=_thr
! perl_version="${perl_version}-threaded";;
! *) dll_post='' ;;
esac
$spitshell >>Makefile <<!GROK!THIS!
PERL_VERSION = $perl_version
! AOUT_OPTIMIZE = $optimize
AOUT_CCCMD = \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE)
AOUT_AR = $aout_ar
AOUT_OBJ_EXT = $aout_obj_ext
--- 8,25 ----
perl_version="5.00${PATCHLEVEL}_$SUBVERSION"
case "$archname" in
! *-thread*) perl_version="${perl_version}-threaded";;
esac
+ dll_post="`echo $perl_version | sum | awk '{print $1}'`"
+ dll_post="`printf '%x' $dll_post | tr '[a-z]' '[A-Z]'`"
+
$spitshell >>Makefile <<!GROK!THIS!
PERL_VERSION = $perl_version
! OPTIMIZE = $optimize
! AOUT_OPTIMIZE = \$(OPTIMIZE)
AOUT_CCCMD = \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE)
AOUT_AR = $aout_ar
AOUT_OBJ_EXT = $aout_obj_ext
***************
*** 33,38 ****
--- 35,41 ----
PERL_DLL_BASE = perl$dll_post
PERL_DLL = \$(PERL_DLL_BASE)\$(DLSUFFIX)
+ CONFIG_ARGS = $config_args
!GROK!THIS!
***************
*** 50,61 ****
echo 'emx_malloc emxlibcm 402 ?' >> $@
echo 'emx_realloc emxlibcm 403 ?' >> $@
$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
$(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def
perl5.def: perl.linkexp
echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@
! echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated'" >>$@
echo STACKSIZE 32768 >>$@
echo CODE LOADONCALL >>$@
echo DATA LOADONCALL NONSHARED MULTIPLE >>$@
--- 53,66 ----
echo 'emx_malloc emxlibcm 402 ?' >> $@
echo 'emx_realloc emxlibcm 403 ?' >> $@
+ perl_dll: $(PERL_DLL)
+
$(PERL_DLL): $(obj) perl5.def perl$(OBJ_EXT)
$(LD) $(LD_OPT) $(LDDLFLAGS) -o $@ perl$(OBJ_EXT) $(obj) $(libs) perl5.def
perl5.def: perl.linkexp
echo "LIBRARY '$(PERL_DLL_BASE)' INITINSTANCE TERMINSTANCE" > $@
! echo DESCRIPTION "'Perl interpreter v$(PERL_VERSION), export autogenerated, built with $(CONFIG_ARGS)'" >>$@
echo STACKSIZE 32768 >>$@
echo CODE LOADONCALL >>$@
echo DATA LOADONCALL NONSHARED MULTIPLE >>$@
***************
*** 160,167 ****
sh writemain $(DYNALOADER) $(aout_static_lib) > tmp
sh mv-if-diff tmp aout_perlmain.c
! miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) ext.libs
! $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
perl_: $& aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
$(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
--- 165,172 ----
sh writemain $(DYNALOADER) $(aout_static_lib) > tmp
sh mv-if-diff tmp aout_perlmain.c
! miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL)
! $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(libs)
perl_: $& aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs
$(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs)
***************
*** 197,214 ****
sys_harness: perl_sys
- cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_sys$(EXE_EXT) perl$(EXE_EXT)) && env HARNESS_BAD_EXITCODE=2 ./perl harness </dev/tty
! lib/auto/OS2/*/%.a : ext/OS2/%/Makefile.aout
! cd ext/OS2/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "$make config failed, continuing anyway..."
! cd ext/OS2/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
! lib/auto/*/%.a : ext/%/Makefile.aout
! cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "$make config failed, continuing anyway..."
! cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
! .PRECIOUS : ext/%/Makefile.aout ext/OS2/%/Makefile.aout
! ext/OS2/%/Makefile.aout : miniperl_
! cd $(dir $@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
ext/%/Makefile.aout : miniperl_
cd $(dir $@) ; ../../miniperl_ -I ../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
--- 202,248 ----
sys_harness: perl_sys
- cd t && (rm -f perl_$(EXE_EXT); $(LNS) ../perl_sys$(EXE_EXT) perl$(EXE_EXT)) && env HARNESS_BAD_EXITCODE=2 ./perl harness </dev/tty
! !NO!SUBS!
! # Now we need to find directories in ./ext/ which are two level deep
! dirs=''
! preci='ext/%/Makefile.aout '
! for d in ext/*
! do
! # echo "Checking '$d'..."
! f="`echo $d/*/Makefile.PL`"
! # SDBFile/sdbm, skip kid makefile
! if test ! -e "$d/Makefile.PL" -a ! "$f" = ""; then
! dirs="$dirs $d"
! preci="$preci $d/%/Makefile.aout"
! fi
! done
!
! $spitshell >>Makefile <<!GROK!THIS!
! .PRECIOUS : $preci
!
! !GROK!THIS!
! for d in $dirs
! do
! p=`basename $d`
! $spitshell >>Makefile <<!GROK!THIS!
! lib/auto/$p/*/%.a : ext/$p/%/Makefile.aout
! @cd ext/$p/\$(basename \$(notdir \$@)) ; make -f Makefile.aout config || echo "\$(MAKE) config failed, continuing anyway..."
! cd ext/$p/\$(basename \$(notdir \$@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
!
! $d/%/Makefile.aout : miniperl_
! cd \$(dir \$@) ; ../../../miniperl_ -I ../../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
!
! !GROK!THIS!
!
! done
!
! $spitshell >>Makefile <<'!NO!SUBS!'
! lib/auto/*/%.a : ext/%/Makefile.aout
! @cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout config || echo "\$(MAKE) config failed, continuing anyway..."
! cd ext/$(basename $(notdir $@)) ; make -f Makefile.aout LINKTYPE=static CCCDLFLAGS=
ext/%/Makefile.aout : miniperl_
cd $(dir $@) ; ../../miniperl_ -I ../../lib Makefile.PL MAKEFILE=Makefile.aout INSTALLDIRS=perl
diff -c 'perl5.005_02/os2/OS2/PrfDB/PrfDB.xs' 'perl5.005_03/os2/OS2/PrfDB/PrfDB.xs'
Index: ./os2/OS2/PrfDB/PrfDB.xs
*** ./os2/OS2/PrfDB/PrfDB.xs Thu Jul 23 23:01:07 1998
--- ./os2/OS2/PrfDB/PrfDB.xs Thu Jan 21 19:10:23 1999
***************
*** 33,39 ****
return sv;
}
! U32
Prf_GetLength(HINI hini, PSZ app, PSZ key) {
U32 len;
--- 33,39 ----
return sv;
}
! I32
Prf_GetLength(HINI hini, PSZ app, PSZ key) {
U32 len;
***************
*** 110,116 ****
PSZ s;
ULONG l;
! U32
Prf_GetLength(hini, app, key)
HINI hini;
PSZ app;
--- 110,116 ----
PSZ s;
ULONG l;
! I32
Prf_GetLength(hini, app, key)
HINI hini;
PSZ app;
diff -c 'perl5.005_02/os2/OS2/REXX/REXX.xs' 'perl5.005_03/os2/OS2/REXX/REXX.xs'
Index: ./os2/OS2/REXX/REXX.xs
*** ./os2/OS2/REXX/REXX.xs Thu Jul 23 23:01:08 1998
--- ./os2/OS2/REXX/REXX.xs Wed Dec 30 21:17:05 1998
***************
*** 96,102 ****
}
if (rc || SvTRUE(GvSV(PL_errgv))) {
if (SvTRUE(GvSV(PL_errgv))) {
! die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), PL_na)) ;
}
die ("REXX compartment returned non-zero status %li", rc);
}
--- 96,103 ----
}
if (rc || SvTRUE(GvSV(PL_errgv))) {
if (SvTRUE(GvSV(PL_errgv))) {
! STRLEN n_a;
! die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
}
die ("REXX compartment returned non-zero status %li", rc);
}
diff -c 'perl5.005_02/os2/os2.c' 'perl5.005_03/os2/os2.c'
Index: ./os2/os2.c
*** ./os2/os2.c Thu Jul 23 23:01:10 1998
--- ./os2/os2.c Thu Jan 21 19:10:23 1999
***************
*** 5,10 ****
--- 5,12 ----
#define INCL_DOSERRORS
#include <os2.h>
+ #include <sys/uflags.h>
+
/*
* Various Unix compatibility functions for OS/2
*/
***************
*** 160,166 ****
os2_cond_wait(perl_cond *c, perl_mutex *m)
{
int rc;
! if ((rc = DosResetEventSem(*c,&PL_na)) && (rc != ERROR_ALREADY_RESET))
croak("panic: COND_WAIT-reset: rc=%i", rc);
if (m) MUTEX_UNLOCK(m);
if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
--- 162,169 ----
os2_cond_wait(perl_cond *c, perl_mutex *m)
{
int rc;
! STRLEN n_a;
! if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET))
croak("panic: COND_WAIT-reset: rc=%i", rc);
if (m) MUTEX_UNLOCK(m);
if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT))
***************
*** 378,383 ****
--- 381,428 ----
#define EXECF_TRUEEXEC 2
#define EXECF_SPAWN_NOWAIT 3
+ /* const char* const ptypes[] = { "FS", "DOS", "VIO", "PM", "DETACH" }; */
+
+ static int
+ my_type()
+ {
+ int rc;
+ TIB *tib;
+ PIB *pib;
+
+ if (!(_emx_env & 0x200)) return 1; /* not OS/2. */
+ if (CheckOSError(DosGetInfoBlocks(&tib, &pib)))
+ return -1;
+
+ return (pib->pib_ultype);
+ }
+
+ static ULONG
+ file_type(char *path)
+ {
+ int rc;
+ ULONG apptype;
+
+ if (!(_emx_env & 0x200))
+ croak("file_type not implemented on DOS"); /* not OS/2. */
+ if (CheckOSError(DosQueryAppType(path, &apptype))) {
+ switch (rc) {
+ case ERROR_FILE_NOT_FOUND:
+ case ERROR_PATH_NOT_FOUND:
+ return -1;
+ case ERROR_ACCESS_DENIED: /* Directory with this name found? */
+ return -3;
+ default: /* Found, but not an
+ executable, or some other
+ read error. */
+ return -2;
+ }
+ }
+ return apptype;
+ }
+
+ static ULONG os2_mytype;
+
/* Spawn/exec a program, revert to shell if needed. */
/* global PL_Argv[] contains arguments. */
***************
*** 390,403 ****
{
dTHR;
int trueflag = flag;
! int rc, pass = 1, err;
char *tmps;
! char buf[256], *s = 0;
char *args[4];
static char * fargs[4]
= { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
char **argsp = fargs;
char nargs = 4;
if (flag == P_WAIT)
flag = P_NOWAIT;
--- 435,450 ----
{
dTHR;
int trueflag = flag;
! int rc, pass = 1;
char *tmps;
! char buf[256], *s = 0, scrbuf[280];
char *args[4];
static char * fargs[4]
= { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", };
char **argsp = fargs;
char nargs = 4;
+ int force_shell;
+ STRLEN n_a;
if (flag == P_WAIT)
flag = P_NOWAIT;
***************
*** 412,419 ****
) /* will spawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
/* We should check PERL_SH* and PERLLIB_* as well? */
! if (!really || !*(tmps = SvPV(really, PL_na)))
tmps = PL_Argv[0];
#if 0
rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
#else
--- 459,531 ----
) /* will spawnvp use PATH? */
TAINT_ENV(); /* testing IFS here is overkill, probably */
/* We should check PERL_SH* and PERLLIB_* as well? */
! if (!really || !*(tmps = SvPV(really, n_a)))
tmps = PL_Argv[0];
+
+ reread:
+ force_shell = 0;
+ if (_emx_env & 0x200) { /* OS/2. */
+ int type = file_type(tmps);
+ type_again:
+ if (type == -1) { /* Not found */
+ errno = ENOENT;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -2) { /* Not an EXE */
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ else if (type == -3) { /* Is a directory? */
+ /* Special-case this */
+ char tbuf[512];
+ int l = strlen(tmps);
+
+ if (l + 5 <= sizeof tbuf) {
+ strcpy(tbuf, tmps);
+ strcpy(tbuf + l, ".exe");
+ type = file_type(tbuf);
+ if (type >= -3)
+ goto type_again;
+ }
+
+ errno = ENOEXEC;
+ rc = -1;
+ goto do_script;
+ }
+ switch (type & 7) {
+ /* Ignore WINDOWCOMPAT and FAPI, start them the same type we are. */
+ case FAPPTYP_WINDOWAPI:
+ {
+ if (os2_mytype != 3) { /* not PM */
+ if (flag == P_NOWAIT)
+ flag = P_PM;
+ else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION)
+ warn("Starting PM process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTWINDOWCOMPAT:
+ {
+ if (os2_mytype != 0) { /* not full screen */
+ if (flag == P_NOWAIT)
+ flag = P_SESSION;
+ else if ((flag & 7) != P_SESSION)
+ warn("Starting Full Screen process with flag=%d, mytype=%d",
+ flag, os2_mytype);
+ }
+ }
+ break;
+ case FAPPTYP_NOTSPEC:
+ /* Let the shell handle this... */
+ force_shell = 1;
+ goto doshell_args;
+ break;
+ }
+ }
+
#if 0
rc = result(trueflag, spawnvp(flag,tmps,PL_Argv));
#else
***************
*** 422,435 ****
else if (execf == EXECF_EXEC)
rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
else if (execf == EXECF_SPAWN_NOWAIT)
! rc = spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv);
else /* EXECF_SPAWN */
rc = result(trueflag,
! spawnvp(trueflag | P_NOWAIT,tmps,PL_Argv));
#endif
if (rc < 0 && pass == 1
&& (tmps == PL_Argv[0])) { /* Cannot transfer `really' via shell. */
! err = errno;
if (err == ENOENT || err == ENOEXEC) {
/* No such file, or is a script. */
/* Try adding script extensions to the file name, and
--- 534,550 ----
else if (execf == EXECF_EXEC)
rc = spawnvp(trueflag | P_OVERLAY,tmps,PL_Argv);
else if (execf == EXECF_SPAWN_NOWAIT)
! rc = spawnvp(flag,tmps,PL_Argv);
else /* EXECF_SPAWN */
rc = result(trueflag,
! spawnvp(flag,tmps,PL_Argv));
#endif
if (rc < 0 && pass == 1
&& (tmps == PL_Argv[0])) { /* Cannot transfer `really' via shell. */
! do_script:
! {
! int err = errno;
!
if (err == ENOENT || err == ENOEXEC) {
/* No such file, or is a script. */
/* Try adding script extensions to the file name, and
***************
*** 437,451 ****
char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
if (scr) {
! FILE *file = fopen(scr, "r");
char *s = 0, *s1;
PL_Argv[0] = scr;
if (!file)
goto panic_file;
! if (!fgets(buf, sizeof buf, file)) {
fclose(file);
! goto panic_file;
}
if (fclose(file) != 0) { /* Failure */
panic_file:
--- 552,597 ----
char *scr = find_script(PL_Argv[0], TRUE, NULL, 0);
if (scr) {
! FILE *file;
char *s = 0, *s1;
+ int l;
+ l = strlen(scr);
+
+ if (l >= sizeof scrbuf) {
+ Safefree(scr);
+ longbuf:
+ croak("Size of scriptname too big: %d", l);
+ }
+ strcpy(scrbuf, scr);
+ Safefree(scr);
+ scr = scrbuf;
+
+ file = fopen(scr, "r");
PL_Argv[0] = scr;
if (!file)
goto panic_file;
! if (!fgets(buf, sizeof buf, file)) { /* Empty... */
!
! buf[0] = 0;
fclose(file);
! /* Special case: maybe from -Zexe build, so
! there is an executable around (contrary to
! documentation, DosQueryAppType sometimes (?)
! does not append ".exe", so we could have
! reached this place). */
! if (l + 5 < sizeof scrbuf) {
! strcpy(scrbuf + l, ".exe");
! if (PerlLIO_stat(scrbuf,&PL_statbuf) >= 0
! && !S_ISDIR(PL_statbuf.st_mode)) {
! /* Found */
! tmps = scr;
! pass++;
! goto reread;
! } else
! scrbuf[l] = 0;
! } else
! goto longbuf;
}
if (fclose(file) != 0) { /* Failure */
panic_file:
***************
*** 503,509 ****
char **a = PL_Argv;
char *exec_args[2];
! if (!buf[0] && file) { /* File without magic */
/* In fact we tried all what pdksh would
try. There is no point in calling
pdksh, we may just emulate its logic. */
--- 649,656 ----
char **a = PL_Argv;
char *exec_args[2];
! if (force_shell
! || (!buf[0] && file)) { /* File without magic */
/* In fact we tried all what pdksh would
try. There is no point in calling
pdksh, we may just emulate its logic. */
***************
*** 581,587 ****
/* Not found: restore errno */
errno = err;
}
! } else if (rc < 0 && pass == 2 && err == ENOENT) { /* File not found */
char *no_dir = strrchr(PL_Argv[0], '/');
/* Do as pdksh port does: if not found with /, try without
--- 728,735 ----
/* Not found: restore errno */
errno = err;
}
! }
! } else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */
char *no_dir = strrchr(PL_Argv[0], '/');
/* Do as pdksh port does: if not found with /, try without
***************
*** 596,602 ****
warn("Can't %s \"%s\": %s\n",
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
? "spawn" : "exec"),
! PL_Argv[0], Strerror(err));
if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
&& ((trueflag & 0xFF) == P_WAIT))
rc = 255 << 8; /* Emulate the fork(). */
--- 744,750 ----
warn("Can't %s \"%s\": %s\n",
((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC)
? "spawn" : "exec"),
! PL_Argv[0], Strerror(errno));
if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT)
&& ((trueflag & 0xFF) == P_WAIT))
rc = 255 << 8; /* Emulate the fork(). */
***************
*** 616,621 ****
--- 764,770 ----
char *tmps = NULL;
int rc;
int flag = P_WAIT, trueflag, err, secondtry = 0;
+ STRLEN n_a;
if (sp > mark) {
New(1301,PL_Argv, sp - mark + 3, char*);
***************
*** 628,634 ****
while (++mark <= sp) {
if (*mark)
! *a++ = SvPVx(*mark, PL_na);
else
*a++ = "";
}
--- 777,783 ----
while (++mark <= sp) {
if (*mark)
! *a++ = SvPVx(*mark, n_a);
else
*a++ = "";
}
***************
*** 773,779 ****
do_exec(cmd)
char *cmd;
{
! return do_spawn2(cmd, EXECF_EXEC);
}
bool
--- 922,929 ----
do_exec(cmd)
char *cmd;
{
! do_spawn2(cmd, EXECF_EXEC);
! return FALSE;
}
bool
***************
*** 865,871 ****
int
fork(void)
{
! die(no_func, "Unsupported function fork");
errno = EINVAL;
return -1;
}
--- 1015,1021 ----
int
fork(void)
{
! die(PL_no_func, "Unsupported function fork");
errno = EINVAL;
return -1;
}
***************
*** 1004,1011 ****
if (items < 2 || items > 3)
croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
{
! char * src = (char *)SvPV(ST(0),PL_na);
! char * dst = (char *)SvPV(ST(1),PL_na);
U32 flag;
int RETVAL, rc;
--- 1154,1162 ----
if (items < 2 || items > 3)
croak("Usage: File::Copy::syscopy(src,dst,flag=0)");
{
! STRLEN n_a;
! char * src = (char *)SvPV(ST(0),n_a);
! char * dst = (char *)SvPV(ST(1),n_a);
U32 flag;
int RETVAL, rc;
***************
*** 1022,1027 ****
--- 1173,1180 ----
XSRETURN(1);
}
+ #include "patchlevel.h"
+
char *
mod2fname(sv)
SV *sv;
***************
*** 1032,1037 ****
--- 1185,1191 ----
AV *av;
SV *svp;
char *s;
+ STRLEN n_a;
if (!SvROK(sv)) croak("Not a reference given to mod2fname");
sv = SvRV(sv);
***************
*** 1042,1048 ****
if (avlen < 0)
croak("Empty array reference given to mod2fname");
! s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
strncpy(fname, s, 8);
len = strlen(s);
if (len < 6) pos = len;
--- 1196,1202 ----
if (avlen < 0)
croak("Empty array reference given to mod2fname");
! s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
strncpy(fname, s, 8);
len = strlen(s);
if (len < 6) pos = len;
***************
*** 1052,1058 ****
}
avlen --;
while (avlen >= 0) {
! s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), PL_na);
while (*s) {
sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
}
--- 1206,1212 ----
}
avlen --;
while (avlen >= 0) {
! s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a);
while (*s) {
sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */
}
***************
*** 1061,1066 ****
--- 1215,1221 ----
#ifdef USE_THREADS
sum++; /* Avoid conflict of DLLs in memory. */
#endif
+ sum += PATCHLEVEL * 200 + SUBVERSION * 2; /* */
fname[pos] = 'A' + (sum % 26);
fname[pos + 1] = 'A' + (sum / 26 % 26);
fname[pos + 2] = '\0';
***************
*** 1096,1101 ****
--- 1251,1262 ----
sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc);
else
buf[len] = '\0';
+ if (len > 0 && buf[len - 1] == '\n')
+ buf[len - 1] = '\0';
+ if (len > 1 && buf[len - 2] == '\r')
+ buf[len - 2] = '\0';
+ if (len > 2 && buf[len - 3] == '.')
+ buf[len - 3] = '\0';
return buf;
}
***************
*** 1182,1188 ****
if (items != 1)
croak("Usage: Cwd::sys_chdir(path)");
{
! char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_chdir(path);
--- 1343,1350 ----
if (items != 1)
croak("Usage: Cwd::sys_chdir(path)");
{
! STRLEN n_a;
! char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_chdir(path);
***************
*** 1198,1204 ****
if (items != 1)
croak("Usage: Cwd::change_drive(d)");
{
! char d = (char)*SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = change_drive(d);
--- 1360,1367 ----
if (items != 1)
croak("Usage: Cwd::change_drive(d)");
{
! STRLEN n_a;
! char d = (char)*SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = change_drive(d);
***************
*** 1214,1220 ****
if (items != 1)
croak("Usage: Cwd::sys_is_absolute(path)");
{
! char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_absolute(path);
--- 1377,1384 ----
if (items != 1)
croak("Usage: Cwd::sys_is_absolute(path)");
{
! STRLEN n_a;
! char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_absolute(path);
***************
*** 1230,1236 ****
if (items != 1)
croak("Usage: Cwd::sys_is_rooted(path)");
{
! char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_rooted(path);
--- 1394,1401 ----
if (items != 1)
croak("Usage: Cwd::sys_is_rooted(path)");
{
! STRLEN n_a;
! char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_rooted(path);
***************
*** 1246,1252 ****
if (items != 1)
croak("Usage: Cwd::sys_is_relative(path)");
{
! char * path = (char *)SvPV(ST(0),PL_na);
bool RETVAL;
RETVAL = sys_is_relative(path);
--- 1411,1418 ----
if (items != 1)
croak("Usage: Cwd::sys_is_relative(path)");
{
! STRLEN n_a;
! char * path = (char *)SvPV(ST(0),n_a);
bool RETVAL;
RETVAL = sys_is_relative(path);
***************
*** 1277,1283 ****
if (items < 1 || items > 2)
croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
{
! char * path = (char *)SvPV(ST(0),PL_na);
char * dir;
char p[MAXPATHLEN];
char * RETVAL;
--- 1443,1450 ----
if (items < 1 || items > 2)
croak("Usage: Cwd::sys_abspath(path, dir = NULL)");
{
! STRLEN n_a;
! char * path = (char *)SvPV(ST(0),n_a);
char * dir;
char p[MAXPATHLEN];
char * RETVAL;
***************
*** 1285,1291 ****
if (items < 2)
dir = NULL;
else {
! dir = (char *)SvPV(ST(1),PL_na);
}
if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
path += 2;
--- 1452,1458 ----
if (items < 2)
dir = NULL;
else {
! dir = (char *)SvPV(ST(1),n_a);
}
if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) {
path += 2;
***************
*** 1425,1431 ****
if (items < 1 || items > 2)
croak("Usage: Cwd::extLibpath_set(s, type = 0)");
{
! char * s = (char *)SvPV(ST(0),PL_na);
bool type;
U32 rc;
bool RETVAL;
--- 1592,1599 ----
if (items < 1 || items > 2)
croak("Usage: Cwd::extLibpath_set(s, type = 0)");
{
! STRLEN n_a;
! char * s = (char *)SvPV(ST(0),n_a);
bool type;
U32 rc;
bool RETVAL;
***************
*** 1482,1487 ****
--- 1650,1656 ----
MALLOC_INIT;
settmppath();
OS2_Perl_data.xs_init = &Xs_OS2_init;
+ _uflags (_UF_SBRK_MODEL, _UF_SBRK_ARBITRARY);
if (environ == NULL) {
environ = env;
}
***************
*** 1502,1507 ****
--- 1671,1677 ----
}
}
MUTEX_INIT(&start_thread_mutex);
+ os2_mytype = my_type(); /* Do it before morphing. Needed? */
}
#undef tmpnam
diff -c 'perl5.005_02/os2/os2ish.h' 'perl5.005_03/os2/os2ish.h'
Index: ./os2/os2ish.h
*** ./os2/os2ish.h Sun Aug 2 01:28:28 1998
--- ./os2/os2ish.h Thu Jan 28 19:14:27 1999
***************
*** 152,158 ****
#define pthread_setspecific(k,v) (*_threadstore()=v,0)
#define pthread_self() _gettid()
#define pthread_key_create(keyp,flag) (*keyp=_gettid(),0)
! #define sched_yield() DosSleep(0)
#ifdef PTHREADS_INCLUDED /* For ./x2p stuff. */
int pthread_join(pthread_t tid, void **status);
--- 152,158 ----
#define pthread_setspecific(k,v) (*_threadstore()=v,0)
#define pthread_self() _gettid()
#define pthread_key_create(keyp,flag) (*keyp=_gettid(),0)
! #define YIELD DosSleep(0)
#ifdef PTHREADS_INCLUDED /* For ./x2p stuff. */
int pthread_join(pthread_t tid, void **status);
diff -c 'perl5.005_02/perl.c' 'perl5.005_03/perl.c'
Index: ./perl.c
*** ./perl.c Fri Aug 7 17:28:48 1998
--- ./perl.c Sat Mar 27 11:49:17 1999
***************
*** 1,6 ****
/* perl.c
*
! * Copyright (c) 1987-1998 Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* perl.c
*
! * Copyright (c) 1987-1999 Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 64,69 ****
--- 64,72 ----
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
***************
*** 126,131 ****
--- 129,135 ----
croak("panic: pthread_key_create");
#endif
MUTEX_INIT(&PL_sv_mutex);
+ MUTEX_INIT(&PL_cred_mutex);
/*
* Safe to use basic SV functions from now on (though
* not things like mortals or tainting yet).
***************
*** 551,559 ****
--- 555,568 ----
DEBUG_P(debprofdump());
#ifdef USE_THREADS
+ MUTEX_DESTROY(&PL_strtab_mutex);
MUTEX_DESTROY(&PL_sv_mutex);
+ MUTEX_DESTROY(&PL_cred_mutex);
MUTEX_DESTROY(&PL_eval_mutex);
COND_DESTROY(&PL_eval_cond);
+ #ifdef EMULATE_ATOMIC_REFCOUNTS
+ MUTEX_DESTROY(&PL_svref_mutex);
+ #endif /* EMULATE_ATOMIC_REFCOUNTS */
/* As the penultimate thing, free the non-arena SV for thrsv */
Safefree(SvPVX(PL_thrsv));
***************
*** 719,724 ****
--- 728,736 ----
s = argv[0]+1;
reswitch:
switch (*s) {
+ #ifndef PERL_STRICT_CR
+ case '\r':
+ #endif
case ' ':
case '0':
case 'F':
***************
*** 1138,1143 ****
--- 1150,1156 ----
perl_get_cv(char *name, I32 create)
{
GV* gv = gv_fetchpv(name, create, SVt_PVCV);
+ /* XXX unsafe for threads if eval_owner isn't held */
if (create && !GvCVu(gv))
return newSUB(start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, newSVpv(name,0)),
***************
*** 1440,1447 ****
sv = POPs;
PUTBACK;
! if (croak_on_error && SvTRUE(ERRSV))
! croak(SvPVx(ERRSV, PL_na));
return sv;
}
--- 1453,1462 ----
sv = POPs;
PUTBACK;
! if (croak_on_error && SvTRUE(ERRSV)) {
! STRLEN n_a;
! croak(SvPVx(ERRSV, n_a));
! }
return sv;
}
***************
*** 1713,1719 ****
LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif
! printf("\n\nCopyright 1987-1998, Larry Wall\n");
#ifdef MSDOS
printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
--- 1728,1734 ----
LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
#endif
! printf("\n\nCopyright 1987-1999, Larry Wall\n");
#ifdef MSDOS
printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
***************
*** 1737,1742 ****
--- 1752,1763 ----
#ifdef OEMVS
printf("MVS (OS390) port by Mortice Kern Systems, 1997-1998\n");
#endif
+ #ifdef __VOS__
+ printf("Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
+ #endif
+ #ifdef __MINT__
+ printf("MiNT port by Guido Flohr, 1997\n");
+ #endif
#ifdef BINARY_BUILD_NOTICE
BINARY_BUILD_NOTICE;
#endif
***************
*** 1758,1764 ****
break;
case '-':
case 0:
! #ifdef WIN32
case '\r':
#endif
case '\n':
--- 1779,1785 ----
break;
case '-':
case 0:
! #if defined(WIN32) || !defined(PERL_STRICT_CR)
case '\r':
#endif
case '\n':
***************
*** 1886,1891 ****
--- 1907,1915 ----
about not iterating on it, and not adding tie magic to it.
It is properly deallocated in perl_destruct() */
PL_strtab = newHV();
+ #ifdef USE_THREADS
+ MUTEX_INIT(&PL_strtab_mutex);
+ #endif
HvSHAREKEYS_off(PL_strtab); /* mandatory */
hv_ksplit(PL_strtab, 512);
***************
*** 1913,1919 ****
PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
! sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
}
STATIC void
--- 1937,1943 ----
PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
! sv_setpvn(perl_get_sv("/", TRUE), "\n", 1);
}
STATIC void
***************
*** 2056,2061 ****
--- 2080,2150 ----
}
}
+ #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\" for nosuid",
+ PL_origfilename);
+ return on_nosuid;
+ }
+ #endif /* IAMSUID */
+
STATIC void
validate_suid(char *validarg, char *scriptname, int fdscript)
{
***************
*** 2089,2094 ****
--- 2178,2184 ----
croak("Can't stat script \"%s\"",PL_origfilename);
if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
I32 len;
+ STRLEN n_a;
#ifdef IAMSUID
#ifndef HAS_SETREUID
***************
*** 2123,2128 ****
--- 2213,2222 ----
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);
***************
*** 2161,2172 ****
PL_doswitches = FALSE; /* -s is insecure in suid */
PL_curcop->cop_line++;
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
! strnNE(SvPV(PL_linestr,PL_na),"#!",2) ) /* required even on Sys V */
croak("No #! line");
! s = SvPV(PL_linestr,PL_na)+2;
if (*s == ' ') s++;
while (!isSPACE(*s)) s++;
! for (s2 = s; (s2 > SvPV(PL_linestr,PL_na)+2 &&
(isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ;
if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */
croak("Not a perl script");
--- 2255,2266 ----
PL_doswitches = FALSE; /* -s is insecure in suid */
PL_curcop->cop_line++;
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
! strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
croak("No #! line");
! s = SvPV(PL_linestr,n_a)+2;
if (*s == ' ') s++;
while (!isSPACE(*s)) s++;
! for (s2 = s; (s2 > SvPV(PL_linestr,n_a)+2 &&
(isDIGIT(s2[-1]) || strchr("._-", s2[-1]))); s2--) ;
if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4)) /* sanity check */
croak("Not a perl script");
***************
*** 2705,2711 ****
char *unix;
STRLEN len;
! if ((unix = tounixspec_ts(SvPV(libdir,PL_na),Nullch)) != Nullch) {
len = strlen(unix);
while (unix[len-1] == '/') len--; /* Cosmetic */
sv_usepvn(libdir,unix,len);
--- 2799,2805 ----
char *unix;
STRLEN len;
! if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) {
len = strlen(unix);
while (unix[len-1] == '/') len--; /* Cosmetic */
sv_usepvn(libdir,unix,len);
***************
*** 2713,2719 ****
else
PerlIO_printf(PerlIO_stderr(),
"Failed to unixify @INC element \"%s\"\n",
! SvPV(libdir,PL_na));
#endif
/* .../archname/version if -d .../archname/version/auto */
sv_setsv(subdir, libdir);
--- 2807,2813 ----
else
PerlIO_printf(PerlIO_stderr(),
"Failed to unixify @INC element \"%s\"\n",
! SvPV(libdir,len));
#endif
/* .../archname/version if -d .../archname/version/auto */
sv_setsv(subdir, libdir);
diff -c 'perl5.005_02/perl.h' 'perl5.005_03/perl.h'
Index: ./perl.h
*** ./perl.h Sun Aug 2 01:12:18 1998
--- ./perl.h Sun Mar 28 01:57:16 1999
***************
*** 1,6 ****
/* perl.h
*
! * Copyright (c) 1987-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* perl.h
*
! * Copyright (c) 1987-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 209,214 ****
--- 209,220 ----
# define LIBERAL 1
#endif
+ #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
+ #define ASCIIish
+ #else
+ #undef ASCIIish
+ #endif
+
/*
* The following contortions are brought to you on behalf of all the
* standards, semi-standards, de facto standards, not-so-de-facto standards
***************
*** 244,250 ****
#define TAINT_NOT (PL_tainted = FALSE)
#define TAINT_IF(c) if (c) { PL_tainted = TRUE; }
#define TAINT_ENV() if (PL_tainting) { taint_env(); }
! #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(no_security, s); }
/* XXX All process group stuff is handled in pp_sys.c. Should these
defines move there? If so, I could simplify this a lot. --AD 9/96.
--- 250,256 ----
#define TAINT_NOT (PL_tainted = FALSE)
#define TAINT_IF(c) if (c) { PL_tainted = TRUE; }
#define TAINT_ENV() if (PL_tainting) { taint_env(); }
! #define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); }
/* XXX All process group stuff is handled in pp_sys.c. Should these
defines move there? If so, I could simplify this a lot. --AD 9/96.
***************
*** 585,591 ****
set_vaxc_errno(vmserrcode); \
} STMT_END
#else
! # define SETERRNO(errcode,vmserrcode) errno = (errcode)
#endif
#ifdef USE_THREADS
--- 591,597 ----
set_vaxc_errno(vmserrcode); \
} STMT_END
#else
! # define SETERRNO(errcode,vmserrcode) (errno = (errcode))
#endif
#ifdef USE_THREADS
***************
*** 1109,1115 ****
# if defined(MPE)
# include "mpeix/mpeixish.h"
# else
! # include "unixish.h"
# endif
# endif
# endif
--- 1115,1125 ----
# if defined(MPE)
# include "mpeix/mpeixish.h"
# else
! # if defined(__VOS__)
! # include "vosish.h"
! # else
! # include "unixish.h"
! # endif
# endif
# endif
# endif
***************
*** 1140,1150 ****
# ifdef OS2
# include "os2thread.h"
# else
! # include <pthread.h>
! typedef pthread_t perl_os_thread;
! typedef pthread_mutex_t perl_mutex;
! typedef pthread_cond_t perl_cond;
! typedef pthread_key_t perl_key;
# endif /* OS2 */
# endif /* WIN32 */
# endif /* FAKE_THREADS */
--- 1150,1171 ----
# ifdef OS2
# include "os2thread.h"
# else
! # ifdef I_MACH_CTHREADS
! # include <mach/cthreads.h>
! # ifdef NeXT
! # define MUTEX_INIT_CALLS_MALLOC
! # endif
! typedef cthread_t perl_os_thread;
! typedef mutex_t perl_mutex;
! typedef condition_t perl_cond;
! typedef void * perl_key;
! # else /* Posix threads */
! # include <pthread.h>
! typedef pthread_t perl_os_thread;
! typedef pthread_mutex_t perl_mutex;
! typedef pthread_cond_t perl_cond;
! typedef pthread_key_t perl_key;
! # endif /* I_MACH_CTHREADS */
# endif /* OS2 */
# endif /* WIN32 */
# endif /* FAKE_THREADS */
***************
*** 1360,1366 ****
# define HAS_VTOHS
# define HAS_HTOVL
# define HAS_HTOVS
! # if BYTEORDER == 0x4321
# define vtohl(x) ((((x)&0xFF)<<24) \
+(((x)>>24)&0xFF) \
+(((x)&0x0000FF00)<<8) \
--- 1381,1387 ----
# define HAS_VTOHS
# define HAS_HTOVL
# define HAS_HTOVS
! # if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
# define vtohl(x) ((((x)&0xFF)<<24) \
+(((x)>>24)&0xFF) \
+(((x)&0x0000FF00)<<8) \
***************
*** 1545,1551 ****
#define UNLINK unlnk
I32 unlnk _((char*));
#else
! #define UNLINK unlink
#endif
#ifndef HAS_SETREUID
--- 1566,1572 ----
#define UNLINK unlnk
I32 unlnk _((char*));
#else
! #define UNLINK PerlLIO_unlink
#endif
#ifndef HAS_SETREUID
***************
*** 1585,1592 ****
#endif
#ifdef MYMALLOC
! # define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
! # define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
#else
# define MALLOC_INIT
# define MALLOC_TERM
--- 1606,1627 ----
#endif
#ifdef MYMALLOC
! # ifdef MUTEX_INIT_CALLS_MALLOC
! # define MALLOC_INIT \
! STMT_START { \
! PL_malloc_mutex = NULL; \
! MUTEX_INIT(&PL_malloc_mutex); \
! } STMT_END
! # define MALLOC_TERM \
! STMT_START { \
! perl_mutex tmp = PL_malloc_mutex; \
! PL_malloc_mutex = NULL; \
! MUTEX_DESTROY(&tmp); \
! } STMT_END
! # else
! # define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
! # define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
! # endif
#else
# define MALLOC_INIT
# define MALLOC_TERM
***************
*** 1903,1908 ****
--- 1938,1976 ----
XTERMBLOCK
} expectation;
+ enum { /* pass one of these to get_vtbl */
+ want_vtbl_sv,
+ want_vtbl_env,
+ want_vtbl_envelem,
+ want_vtbl_sig,
+ want_vtbl_sigelem,
+ want_vtbl_pack,
+ want_vtbl_packelem,
+ want_vtbl_dbline,
+ want_vtbl_isa,
+ want_vtbl_isaelem,
+ want_vtbl_arylen,
+ want_vtbl_glob,
+ want_vtbl_mglob,
+ want_vtbl_nkeys,
+ want_vtbl_taint,
+ want_vtbl_substr,
+ want_vtbl_vec,
+ want_vtbl_pos,
+ want_vtbl_bm,
+ want_vtbl_fm,
+ want_vtbl_uvar,
+ want_vtbl_defelem,
+ want_vtbl_regexp,
+ want_vtbl_collxfrm,
+ want_vtbl_amagic,
+ want_vtbl_amagicelem
+ #ifdef USE_THREADS
+ ,
+ want_vtbl_mutex
+ #endif
+ };
+
/* Note: the lowest 8 bits are reserved for
stuffing into op->op_private */
***************
*** 2075,2080 ****
--- 2143,2192 ----
#endif
#ifdef PERL_OBJECT
+ /* from perly.c */
+ #undef yydebug
+ #undef yynerrs
+ #undef yyerrflag
+ #undef yychar
+ #undef yyssp
+ #undef yyvsp
+ #undef yyval
+ #undef yylval
+ #define yydebug PL_yydebug
+ #define yynerrs PL_yynerrs
+ #define yyerrflag PL_yyerrflag
+ #define yychar PL_yychar
+ #define yyssp PL_yyssp
+ #define yyvsp PL_yyvsp
+ #define yyval PL_yyval
+ #define yylval PL_yylval
+ PERLVAR(yydebug, int)
+ PERLVAR(yynerrs, int)
+ PERLVAR(yyerrflag, int)
+ PERLVAR(yychar, int)
+ PERLVAR(yyssp, short*)
+ PERLVAR(yyvsp, YYSTYPE*)
+ PERLVAR(yyval, YYSTYPE)
+ PERLVAR(yylval, YYSTYPE)
+
+ #define efloatbuf PL_efloatbuf
+ #define efloatsize PL_efloatsize
+ PERLVAR(efloatbuf, char *)
+ PERLVAR(efloatsize, STRLEN)
+
+ #define glob_index PL_glob_index
+ #define srand_called PL_srand_called
+ #define uudmap PL_uudmap
+ #define bitcount PL_bitcount
+ #define filter_debug PL_filter_debug
+ PERLVAR(glob_index, int)
+ PERLVAR(srand_called, bool)
+ PERLVAR(uudmap[256], char)
+ PERLVAR(bitcount, char*)
+ PERLVAR(filter_debug, int)
+ PERLVAR(super_bufptr, char*) /* PL_bufptr that was */
+ PERLVAR(super_bufend, char*) /* PL_bufend that was */
+
/*
* The following is a buffer where new variables must
* be defined to maintain binary compatibility with PERL_OBJECT
***************
*** 2448,2452 ****
--- 2560,2578 ----
# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
# endif
#endif
+
+ #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 -c 'perl5.005_02/perl_exp.SH' 'perl5.005_03/perl_exp.SH'
Index: ./perl_exp.SH
*** ./perl_exp.SH Thu Jul 23 23:01:14 1998
--- ./perl_exp.SH Wed Nov 4 20:46:02 1998
***************
*** 49,56 ****
echo "#!" > perl.exp
# No compat3 since 5.004_50.
! # perlio.sym will added below if needed.
! syms="global.sym interp.sym thread.sym"
sed -n '/^[A-Za-z]/ s/^/Perl_/p' $syms >> perl.exp
--- 49,58 ----
echo "#!" > perl.exp
# No compat3 since 5.004_50.
! # No interp.sym since 5.005_03.
! # perlio.sym will added later if needed.
!
! syms="global.sym thread.sym"
sed -n '/^[A-Za-z]/ s/^/Perl_/p' $syms >> perl.exp
***************
*** 59,65 ****
sed -n 's/^PERLVAR.*(T\([^[,]*\).*/PL_\1/p' thrdvar.h >> perl.exp
#
! # If we use the PerlIO abstraction layer, add its symbols
#
if [ $useperlio = "define" ]
--- 61,67 ----
sed -n 's/^PERLVAR.*(T\([^[,]*\).*/PL_\1/p' thrdvar.h >> perl.exp
#
! # If we use the PerlIO abstraction layer, add its symbols.
#
if [ $useperlio = "define" ]
***************
*** 72,78 ****
# not actually be defined, but there's no harm in that).
#
! cat <<END >> perl.exp
perl_init_i18nl10n
perl_init_i18nl14n
perl_new_collate
--- 74,80 ----
# not actually be defined, but there's no harm in that).
#
! cat >> perl.exp <<END
perl_init_i18nl10n
perl_init_i18nl14n
perl_new_collate
***************
*** 97,111 ****
--- 99,130 ----
perl_eval_pv
perl_eval_sv
perl_require_pv
+ cast_i32
+ cast_iv
+ cast_uv
+ END
+
+ case "$ccflags" in
+ *-DHIDEMYMALLOC*)
+ cat >>perl.exp <<END
Mymalloc
Mycalloc
Myremalloc
Myfree
+ END
+ ;;
+ esac
+
+ case "$ccflags" in
+ *-DEMBEDMYMALLOC*)
+ cat >>perl.exp <<END
Perl_malloc
Perl_calloc
Perl_realloc
Perl_free
END
+ ;;
+ esac
# The shebang line nicely sorts as the first one.
sort -o perl.exp -u perl.exp
diff -c 'perl5.005_02/perlio.c' 'perl5.005_03/perlio.c'
Index: ./perlio.c
*** ./perlio.c Thu Jul 23 23:01:14 1998
--- ./perlio.c Thu Mar 4 18:34:29 1999
***************
*** 55,67 ****
#undef PerlIO_tmpfile
PerlIO *
! PerlIO_tmpfile()
{
return sftmp(0);
}
void
! PerlIO_init()
{
/* Force this file to be included in perl binary. Which allows
* this file to force inclusion of other functions that may be
--- 55,67 ----
#undef PerlIO_tmpfile
PerlIO *
! PerlIO_tmpfile(void)
{
return sftmp(0);
}
void
! PerlIO_init(void)
{
/* Force this file to be included in perl binary. Which allows
* this file to force inclusion of other functions that may be
***************
*** 84,112 ****
#undef PerlIO_stderr
PerlIO *
! PerlIO_stderr()
{
return (PerlIO *) stderr;
}
#undef PerlIO_stdin
PerlIO *
! PerlIO_stdin()
{
return (PerlIO *) stdin;
}
#undef PerlIO_stdout
PerlIO *
! PerlIO_stdout()
{
return (PerlIO *) stdout;
}
#undef PerlIO_fast_gets
int
! PerlIO_fast_gets(f)
! PerlIO *f;
{
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
return 1;
--- 84,111 ----
#undef PerlIO_stderr
PerlIO *
! PerlIO_stderr(void)
{
return (PerlIO *) stderr;
}
#undef PerlIO_stdin
PerlIO *
! PerlIO_stdin(void)
{
return (PerlIO *) stdin;
}
#undef PerlIO_stdout
PerlIO *
! PerlIO_stdout(void)
{
return (PerlIO *) stdout;
}
#undef PerlIO_fast_gets
int
! PerlIO_fast_gets(PerlIO *f)
{
#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
return 1;
***************
*** 117,124 ****
#undef PerlIO_has_cntptr
int
! PerlIO_has_cntptr(f)
! PerlIO *f;
{
#if defined(USE_STDIO_PTR)
return 1;
--- 116,122 ----
#undef PerlIO_has_cntptr
int
! PerlIO_has_cntptr(PerlIO *f)
{
#if defined(USE_STDIO_PTR)
return 1;
***************
*** 129,136 ****
#undef PerlIO_canset_cnt
int
! PerlIO_canset_cnt(f)
! PerlIO *f;
{
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
return 1;
--- 127,133 ----
#undef PerlIO_canset_cnt
int
! PerlIO_canset_cnt(PerlIO *f)
{
#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
return 1;
***************
*** 141,149 ****
#undef PerlIO_set_cnt
void
! PerlIO_set_cnt(f,cnt)
! PerlIO *f;
! int cnt;
{
if (cnt < -1)
warn("Setting cnt to %d\n",cnt);
--- 138,144 ----
#undef PerlIO_set_cnt
void
! PerlIO_set_cnt(PerlIO *f, int cnt)
{
if (cnt < -1)
warn("Setting cnt to %d\n",cnt);
***************
*** 156,165 ****
#undef PerlIO_set_ptrcnt
void
! PerlIO_set_ptrcnt(f,ptr,cnt)
! PerlIO *f;
! STDCHAR *ptr;
! int cnt;
{
#ifdef FILE_bufsiz
STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
--- 151,157 ----
#undef PerlIO_set_ptrcnt
void
! PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt)
{
#ifdef FILE_bufsiz
STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
***************
*** 183,190 ****
#undef PerlIO_get_cnt
int
! PerlIO_get_cnt(f)
! PerlIO *f;
{
#ifdef FILE_cnt
return FILE_cnt(f);
--- 175,181 ----
#undef PerlIO_get_cnt
int
! PerlIO_get_cnt(PerlIO *f)
{
#ifdef FILE_cnt
return FILE_cnt(f);
***************
*** 196,203 ****
#undef PerlIO_get_bufsiz
int
! PerlIO_get_bufsiz(f)
! PerlIO *f;
{
#ifdef FILE_bufsiz
return FILE_bufsiz(f);
--- 187,193 ----
#undef PerlIO_get_bufsiz
int
! PerlIO_get_bufsiz(PerlIO *f)
{
#ifdef FILE_bufsiz
return FILE_bufsiz(f);
***************
*** 209,216 ****
#undef PerlIO_get_ptr
STDCHAR *
! PerlIO_get_ptr(f)
! PerlIO *f;
{
#ifdef FILE_ptr
return FILE_ptr(f);
--- 199,205 ----
#undef PerlIO_get_ptr
STDCHAR *
! PerlIO_get_ptr(PerlIO *f)
{
#ifdef FILE_ptr
return FILE_ptr(f);
***************
*** 222,229 ****
#undef PerlIO_get_base
STDCHAR *
! PerlIO_get_base(f)
! PerlIO *f;
{
#ifdef FILE_base
return FILE_base(f);
--- 211,217 ----
#undef PerlIO_get_base
STDCHAR *
! PerlIO_get_base(PerlIO *f)
{
#ifdef FILE_base
return FILE_base(f);
***************
*** 235,242 ****
#undef PerlIO_has_base
int
! PerlIO_has_base(f)
! PerlIO *f;
{
#ifdef FILE_base
return 1;
--- 223,229 ----
#undef PerlIO_has_base
int
! PerlIO_has_base(PerlIO *f)
{
#ifdef FILE_base
return 1;
***************
*** 247,308 ****
#undef PerlIO_puts
int
! PerlIO_puts(f,s)
! PerlIO *f;
! const char *s;
{
return fputs(s,f);
}
#undef PerlIO_open
PerlIO *
! PerlIO_open(path,mode)
! const char *path;
! const char *mode;
{
return fopen(path,mode);
}
#undef PerlIO_fdopen
PerlIO *
! PerlIO_fdopen(fd,mode)
! int fd;
! const char *mode;
{
return fdopen(fd,mode);
}
#undef PerlIO_reopen
PerlIO *
! PerlIO_reopen(name, mode, f)
! const char *name;
! const char *mode;
! PerlIO *f;
{
return freopen(name,mode,f);
}
#undef PerlIO_close
int
! PerlIO_close(f)
! PerlIO *f;
{
return fclose(f);
}
#undef PerlIO_eof
int
! PerlIO_eof(f)
! PerlIO *f;
{
return feof(f);
}
#undef PerlIO_getname
char *
! PerlIO_getname(f,buf)
! PerlIO *f;
! char *buf;
{
#ifdef VMS
return fgetname(f,buf);
--- 234,282 ----
#undef PerlIO_puts
int
! PerlIO_puts(PerlIO *f, const char *s)
{
return fputs(s,f);
}
#undef PerlIO_open
PerlIO *
! PerlIO_open(const char *path, const char *mode)
{
return fopen(path,mode);
}
#undef PerlIO_fdopen
PerlIO *
! PerlIO_fdopen(int fd, const char *mode)
{
return fdopen(fd,mode);
}
#undef PerlIO_reopen
PerlIO *
! PerlIO_reopen(const char *name, const char *mode, PerlIO *f)
{
return freopen(name,mode,f);
}
#undef PerlIO_close
int
! PerlIO_close(PerlIO *f)
{
return fclose(f);
}
#undef PerlIO_eof
int
! PerlIO_eof(PerlIO *f)
{
return feof(f);
}
#undef PerlIO_getname
char *
! PerlIO_getname(PerlIO *f, char *buf)
{
#ifdef VMS
return fgetname(f,buf);
***************
*** 314,361 ****
#undef PerlIO_getc
int
! PerlIO_getc(f)
! PerlIO *f;
{
return fgetc(f);
}
#undef PerlIO_error
int
! PerlIO_error(f)
! PerlIO *f;
{
return ferror(f);
}
#undef PerlIO_clearerr
void
! PerlIO_clearerr(f)
! PerlIO *f;
{
clearerr(f);
}
#undef PerlIO_flush
int
! PerlIO_flush(f)
! PerlIO *f;
{
return Fflush(f);
}
#undef PerlIO_fileno
int
! PerlIO_fileno(f)
! PerlIO *f;
{
return fileno(f);
}
#undef PerlIO_setlinebuf
void
! PerlIO_setlinebuf(f)
! PerlIO *f;
{
#ifdef HAS_SETLINEBUF
setlinebuf(f);
--- 288,329 ----
#undef PerlIO_getc
int
! PerlIO_getc(PerlIO *f)
{
return fgetc(f);
}
#undef PerlIO_error
int
! PerlIO_error(PerlIO *f)
{
return ferror(f);
}
#undef PerlIO_clearerr
void
! PerlIO_clearerr(PerlIO *f)
{
clearerr(f);
}
#undef PerlIO_flush
int
! PerlIO_flush(PerlIO *f)
{
return Fflush(f);
}
#undef PerlIO_fileno
int
! PerlIO_fileno(PerlIO *f)
{
return fileno(f);
}
#undef PerlIO_setlinebuf
void
! PerlIO_setlinebuf(PerlIO *f)
{
#ifdef HAS_SETLINEBUF
setlinebuf(f);
***************
*** 370,444 ****
#undef PerlIO_putc
int
! PerlIO_putc(f,ch)
! PerlIO *f;
! int ch;
{
return putc(ch,f);
}
#undef PerlIO_ungetc
int
! PerlIO_ungetc(f,ch)
! PerlIO *f;
! int ch;
{
return ungetc(ch,f);
}
#undef PerlIO_read
SSize_t
! PerlIO_read(f,buf,count)
! PerlIO *f;
! void *buf;
! Size_t count;
{
return fread(buf,1,count,f);
}
#undef PerlIO_write
SSize_t
! PerlIO_write(f,buf,count)
! PerlIO *f;
! const void *buf;
! Size_t count;
{
return fwrite1(buf,1,count,f);
}
#undef PerlIO_vprintf
int
! PerlIO_vprintf(f,fmt,ap)
! PerlIO *f;
! const char *fmt;
! va_list ap;
{
return vfprintf(f,fmt,ap);
}
#undef PerlIO_tell
! long
! PerlIO_tell(f)
! PerlIO *f;
{
return ftell(f);
}
#undef PerlIO_seek
int
! PerlIO_seek(f,offset,whence)
! PerlIO *f;
! off_t offset;
! int whence;
{
return fseek(f,offset,whence);
}
#undef PerlIO_rewind
void
! PerlIO_rewind(f)
! PerlIO *f;
{
rewind(f);
}
--- 338,394 ----
#undef PerlIO_putc
int
! PerlIO_putc(PerlIO *f, int ch)
{
return putc(ch,f);
}
#undef PerlIO_ungetc
int
! PerlIO_ungetc(PerlIO *f, int ch)
{
return ungetc(ch,f);
}
#undef PerlIO_read
SSize_t
! PerlIO_read(PerlIO *f, void *buf, Size_t count)
{
return fread(buf,1,count,f);
}
#undef PerlIO_write
SSize_t
! PerlIO_write(PerlIO *f, const void *buf, Size_t count)
{
return fwrite1(buf,1,count,f);
}
#undef PerlIO_vprintf
int
! PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap)
{
return vfprintf(f,fmt,ap);
}
#undef PerlIO_tell
! Off_t
! PerlIO_tell(PerlIO *f)
{
return ftell(f);
}
#undef PerlIO_seek
int
! PerlIO_seek(PerlIO *f, Off_t offset, int whence)
{
return fseek(f,offset,whence);
}
#undef PerlIO_rewind
void
! PerlIO_rewind(PerlIO *f)
{
rewind(f);
}
***************
*** 469,515 ****
#undef PerlIO_tmpfile
PerlIO *
! PerlIO_tmpfile()
{
return tmpfile();
}
#undef PerlIO_importFILE
PerlIO *
! PerlIO_importFILE(f,fl)
! FILE *f;
! int fl;
{
return f;
}
#undef PerlIO_exportFILE
FILE *
! PerlIO_exportFILE(f,fl)
! PerlIO *f;
! int fl;
{
return f;
}
#undef PerlIO_findFILE
FILE *
! PerlIO_findFILE(f)
! PerlIO *f;
{
return f;
}
#undef PerlIO_releaseFILE
void
! PerlIO_releaseFILE(p,f)
! PerlIO *p;
! FILE *f;
{
}
void
! PerlIO_init()
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
--- 419,458 ----
#undef PerlIO_tmpfile
PerlIO *
! PerlIO_tmpfile(void)
{
return tmpfile();
}
#undef PerlIO_importFILE
PerlIO *
! PerlIO_importFILE(FILE *f, int fl)
{
return f;
}
#undef PerlIO_exportFILE
FILE *
! PerlIO_exportFILE(PerlIO *f, int fl)
{
return f;
}
#undef PerlIO_findFILE
FILE *
! PerlIO_findFILE(PerlIO *f)
{
return f;
}
#undef PerlIO_releaseFILE
void
! PerlIO_releaseFILE(PerlIO *p, FILE *f)
{
}
void
! PerlIO_init(void)
{
/* Does nothing (yet) except force this file to be included
in perl binary. That allows this file to force inclusion
***************
*** 524,532 ****
#ifndef HAS_FSETPOS
#undef PerlIO_setpos
int
! PerlIO_setpos(f,pos)
! PerlIO *f;
! const Fpos_t *pos;
{
return PerlIO_seek(f,*pos,0);
}
--- 467,473 ----
#ifndef HAS_FSETPOS
#undef PerlIO_setpos
int
! PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
{
return PerlIO_seek(f,*pos,0);
}
***************
*** 534,542 ****
#ifndef PERLIO_IS_STDIO
#undef PerlIO_setpos
int
! PerlIO_setpos(f,pos)
! PerlIO *f;
! const Fpos_t *pos;
{
return fsetpos(f, pos);
}
--- 475,481 ----
#ifndef PERLIO_IS_STDIO
#undef PerlIO_setpos
int
! PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
{
return fsetpos(f, pos);
}
***************
*** 546,554 ****
#ifndef HAS_FGETPOS
#undef PerlIO_getpos
int
! PerlIO_getpos(f,pos)
! PerlIO *f;
! Fpos_t *pos;
{
*pos = PerlIO_tell(f);
return 0;
--- 485,491 ----
#ifndef HAS_FGETPOS
#undef PerlIO_getpos
int
! PerlIO_getpos(PerlIO *f, Fpos_t *pos)
{
*pos = PerlIO_tell(f);
return 0;
***************
*** 557,565 ****
#ifndef PERLIO_IS_STDIO
#undef PerlIO_getpos
int
! PerlIO_getpos(f,pos)
! PerlIO *f;
! Fpos_t *pos;
{
return fgetpos(f, pos);
}
--- 494,500 ----
#ifndef PERLIO_IS_STDIO
#undef PerlIO_getpos
int
! PerlIO_getpos(PerlIO *f, Fpos_t *pos)
{
return fgetpos(f, pos);
}
***************
*** 569,585 ****
#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
int
! vprintf(pat, args)
! char *pat, *args;
{
_doprnt(pat, args, stdout);
return 0; /* wrong, but perl doesn't use the return value */
}
int
! vfprintf(fd, pat, args)
! FILE *fd;
! char *pat, *args;
{
_doprnt(pat, args, fd);
return 0; /* wrong, but perl doesn't use the return value */
--- 504,517 ----
#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
int
! vprintf(char *pat, char *args)
{
_doprnt(pat, args, stdout);
return 0; /* wrong, but perl doesn't use the return value */
}
int
! vfprintf(FILE *fd, char *pat, char *args)
{
_doprnt(pat, args, fd);
return 0; /* wrong, but perl doesn't use the return value */
diff -c 'perl5.005_02/perlvars.h' 'perl5.005_03/perlvars.h'
Index: ./perlvars.h
*** ./perlvars.h Thu Jul 23 23:01:15 1998
--- ./perlvars.h Wed Dec 30 23:29:44 1998
***************
*** 173,180 ****
/* constants (these are not literals to facilitate pointer comparisons) */
PERLVARIC(GYes, char *, "1")
PERLVARIC(GNo, char *, "")
! PERLVARIC(Ghexdigit, char *, "0123456789abcdef0123456789ABCDEFx")
PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
PERLVAR(Gspecialsv_list[4],SV *) /* from byterun.h */
--- 173,183 ----
/* constants (these are not literals to facilitate pointer comparisons) */
PERLVARIC(GYes, char *, "1")
PERLVARIC(GNo, char *, "")
! PERLVARIC(Ghexdigit, char *, "0123456789abcdef0123456789ABCDEF")
PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}")
PERLVAR(Gspecialsv_list[4],SV *) /* from byterun.h */
+ #ifdef USE_THREADS
+ PERLVAR(Gcred_mutex, perl_mutex) /* altered credentials in effect */
+ #endif
diff -c 'perl5.005_02/perly.c' 'perl5.005_03/perly.c'
Index: ./perly.c
Prereq: 1.8
*** ./perly.c Sun Aug 2 00:15:07 1998
--- ./perly.c Fri Feb 19 09:45:20 1999
***************
*** 1276,1281 ****
--- 1276,1282 ----
#define YYMAXDEPTH 500
#endif
#endif
+ #ifndef PERL_OBJECT
int yydebug;
int yynerrs;
int yyerrflag;
***************
*** 1284,1289 ****
--- 1285,1291 ----
YYSTYPE *yyvsp;
YYSTYPE yyval;
YYSTYPE yylval;
+ #endif
#line 643 "perly.y"
/* PROGRAM */
#line 1353 "perly.c"
***************
*** 1405,1413 ****
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
ysave->yyvs = yyvs =
! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
ysave->yyss = yyss =
! (short*)realloc((char*)yyss,yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
yyssp = yyss + yyps_index;
--- 1407,1415 ----
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
ysave->yyvs = yyvs =
! (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
ysave->yyss = yyss =
! (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
yyssp = yyss + yyps_index;
***************
*** 1460,1468 ****
int yyps_index = (yyssp - yyss);
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
! ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs,
yystacksize * sizeof(YYSTYPE));
! ysave->yyss = yyss = (short*)realloc((char*)yyss,
yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
--- 1462,1470 ----
int yyps_index = (yyssp - yyss);
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
! ysave->yyvs = yyvs = (YYSTYPE*)PerlMem_realloc((char*)yyvs,
yystacksize * sizeof(YYSTYPE));
! ysave->yyss = yyss = (short*)PerlMem_realloc((char*)yyss,
yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
***************
*** 1772,1781 ****
break;
case 57:
#line 302 "perly.y"
! { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
! CvUNIQUE_on(PL_compcv);
yyval.opval = yyvsp[0].opval; }
break;
case 58:
--- 1774,1783 ----
break;
case 57:
#line 302 "perly.y"
! { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
! CvSPECIAL_on(PL_compcv);
yyval.opval = yyvsp[0].opval; }
break;
case 58:
***************
*** 1800,1806 ****
break;
case 64:
#line 325 "perly.y"
! { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
break;
case 65:
#line 327 "perly.y"
--- 1802,1808 ----
break;
case 64:
#line 325 "perly.y"
! { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
break;
case 65:
#line 327 "perly.y"
***************
*** 2109,2115 ****
break;
case 135:
#line 515 "perly.y"
! { yyval.opval = newUNOP(OP_DOFILE, 0, scalar(yyvsp[0].opval)); }
break;
case 136:
#line 517 "perly.y"
--- 2111,2117 ----
break;
case 135:
#line 515 "perly.y"
! { yyval.opval = dofile(yyvsp[0].opval); }
break;
case 136:
#line 517 "perly.y"
***************
*** 2346,2354 ****
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
ysave->yyvs = yyvs =
! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
ysave->yyss = yyss =
! (short*)realloc((char*)yyss,yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
yyssp = yyss + yyps_index;
--- 2348,2356 ----
int yypv_index = (yyvsp - yyvs);
yystacksize += YYSTACKSIZE;
ysave->yyvs = yyvs =
! (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
ysave->yyss = yyss =
! (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short));
if (!yyvs || !yyss)
goto yyoverflow;
yyssp = yyss + yyps_index;
diff -c 'perl5.005_02/perly.y' 'perl5.005_03/perly.y'
Index: ./perly.y
*** ./perly.y Sun Aug 2 00:15:07 1998
--- ./perly.y Sat Mar 27 12:04:11 1999
***************
*** 1,6 ****
/* perly.y
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* perly.y
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 299,308 ****
{ $$ = start_subparse(TRUE, 0); }
;
! subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, PL_na);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
! CvUNIQUE_on(PL_compcv);
$$ = $1; }
;
--- 299,308 ----
{ $$ = start_subparse(TRUE, 0); }
;
! subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv, n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
! CvSPECIAL_on(PL_compcv);
$$ = $1; }
;
***************
*** 322,328 ****
;
use : USE startsub
! { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
WORD WORD listexpr ';'
{ utilize($1, $2, $4, $5, $6); }
;
--- 322,328 ----
;
use : USE startsub
! { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
WORD WORD listexpr ';'
{ utilize($1, $2, $4, $5, $6); }
;
***************
*** 512,518 ****
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $3, scalar($2))); }
| DO term %prec UNIOP
! { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
| DO block %prec '('
{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
| DO WORD '(' ')'
--- 512,518 ----
{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, $3, scalar($2))); }
| DO term %prec UNIOP
! { $$ = dofile($2); }
| DO block %prec '('
{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
| DO WORD '(' ')'
diff -c 'perl5.005_02/perly_c.diff' 'perl5.005_03/perly_c.diff'
Index: ./perly_c.diff
*** ./perly_c.diff Sun Aug 2 00:15:07 1998
--- ./perly_c.diff Sat Jan 16 11:02:31 1999
***************
*** 1,23 ****
! *** perly.c.orig Tue Jul 28 15:02:41 1998
! --- perly.c Tue Jul 28 15:14:54 1998
***************
! *** 7,11 ****
! --- 7,19 ----
#include "perl.h"
- + #ifdef PERL_OBJECT
static void
- + Dep(CPerlObj *pPerl)
- + {
- + pPerl->deprecate("\"do\" to call subroutines");
- + }
- + #define dep() Dep(this)
- + #else
- + static void
dep(void)
{
- ***************
- *** 12,86 ****
deprecate("\"do\" to call subroutines");
}
--- 1,12 ----
! *** perly.c.old Wed Jan 06 20:03:41 1999
! --- perly.c Wed Jan 06 18:51:20 1999
***************
! *** 7,86 ****
#include "perl.h"
static void
dep(void)
{
deprecate("\"do\" to call subroutines");
}
***************
*** 93,99 ****
- #define ARROW 314
#define YYERRCODE 256
short yylhs[] = { -1,
! --- 20,26 ----
deprecate("\"do\" to call subroutines");
}
+ #endif
--- 82,101 ----
- #define ARROW 314
#define YYERRCODE 256
short yylhs[] = { -1,
! --- 7,26 ----
! #include "perl.h"
!
! + #ifdef PERL_OBJECT
! static void
! + Dep(CPerlObj *pPerl)
! + {
! + pPerl->deprecate("\"do\" to call subroutines");
! + }
! + #define dep() Dep(this)
! + #else
! + static void
! dep(void)
! {
deprecate("\"do\" to call subroutines");
}
+ #endif
***************
*** 102,113 ****
#define YYERRCODE 256
short yylhs[] = { -1,
***************
*** 1345,1365 ****
YYSTYPE yyval;
YYSTYPE yylval;
! - short yyss[YYSTACKSIZE];
! - YYSTYPE yyvs[YYSTACKSIZE];
! - #define yystacksize YYSTACKSIZE
#line 643 "perly.y"
/* PROGRAM */
! #line 1353 "y.tab.c"
--- 104,123 ----
#define YYERRCODE 256
short yylhs[] = { -1,
***************
+ *** 1337,1340 ****
+ --- 1277,1281 ----
+ #endif
+ #endif
+ + #ifndef PERL_OBJECT
+ int yydebug;
+ int yynerrs;
+ ***************
*** 1345,1365 ****
YYSTYPE yyval;
YYSTYPE yylval;
! ! short yyss[YYSTACKSIZE];
! ! YYSTYPE yyvs[YYSTACKSIZE];
! ! #define yystacksize YYSTACKSIZE
#line 643 "perly.y"
/* PROGRAM */
! #line 1353 "y.tab.c"
***************
*** 124,132 ****
if (yys = getenv("YYDEBUG"))
{
! --- 1285,1349 ----
YYSTYPE yyval;
YYSTYPE yylval;
#line 643 "perly.y"
/* PROGRAM */
! #line 1353 "perly.c"
--- 134,143 ----
if (yys = getenv("YYDEBUG"))
{
! --- 1286,1351 ----
YYSTYPE yyval;
YYSTYPE yylval;
+ ! #endif
#line 643 "perly.y"
/* PROGRAM */
! #line 1353 "perly.c"
***************
*** 176,182 ****
extern char *getenv();
+ #endif
+ #endif
!
+ struct ysv *ysave;
+ New(73, ysave, 1, struct ysv);
+ SAVEDESTRUCTOR(yydestruct, ysave);
--- 187,193 ----
extern char *getenv();
+ #endif
+ #endif
! +
+ struct ysv *ysave;
+ New(73, ysave, 1, struct ysv);
+ SAVEDESTRUCTOR(yydestruct, ysave);
***************
*** 186,198 ****
+ ysave->oldyychar = yychar;
+ ysave->oldyyval = yyval;
+ ysave->oldyylval = yylval;
! +
+ #if YYDEBUG
if (yys = getenv("YYDEBUG"))
{
***************
*** 1374,1377 ****
! --- 1358,1371 ----
yychar = (-1);
+ /*
--- 197,209 ----
+ ysave->oldyychar = yychar;
+ ysave->oldyyval = yyval;
+ ysave->oldyylval = yylval;
!
+ #if YYDEBUG
if (yys = getenv("YYDEBUG"))
{
***************
*** 1374,1377 ****
! --- 1360,1373 ----
yychar = (-1);
+ /*
***************
*** 214,246 ****
! printf("yydebug: state %d, reading %d (%s)\n", yystate,
yychar, yys);
}
! --- 1383,1387 ----
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate,
yychar, yys);
}
***************
! *** 1399,1403 ****
#if YYDEBUG
if (yydebug)
! printf("yydebug: state %d, shifting to state %d\n",
yystate, yytable[yyn]);
#endif
- --- 1393,1397 ----
- #if YYDEBUG
- if (yydebug)
- ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n",
- yystate, yytable[yyn]);
- #endif
- ***************
- *** 1404,1408 ****
if (yyssp >= yyss + yystacksize - 1)
{
! goto yyoverflow;
}
*++yyssp = yystate = yytable[yyn];
! --- 1398,1416 ----
if (yyssp >= yyss + yystacksize - 1)
{
! /*
--- 225,254 ----
! printf("yydebug: state %d, reading %d (%s)\n", yystate,
yychar, yys);
}
! --- 1385,1389 ----
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n", yystate,
yychar, yys);
}
***************
! *** 1399,1408 ****
#if YYDEBUG
if (yydebug)
! printf("yydebug: state %d, shifting to state %d\n",
yystate, yytable[yyn]);
#endif
if (yyssp >= yyss + yystacksize - 1)
{
! goto yyoverflow;
}
*++yyssp = yystate = yytable[yyn];
! --- 1395,1418 ----
! #if YYDEBUG
! if (yydebug)
! ! PerlIO_printf(Perl_debug_log, "yydebug: state %d, shifting to state %d\n",
! yystate, yytable[yyn]);
! #endif
if (yyssp >= yyss + yystacksize - 1)
{
! /*
***************
*** 251,259 ****
! int yypv_index = (yyvsp - yyvs);
! yystacksize += YYSTACKSIZE;
! ysave->yyvs = yyvs =
! ! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
! ysave->yyss = yyss =
! ! (short*)realloc((char*)yyss,yystacksize * sizeof(short));
! if (!yyvs || !yyss)
! goto yyoverflow;
! yyssp = yyss + yyps_index;
--- 259,267 ----
! int yypv_index = (yyvsp - yyvs);
! yystacksize += YYSTACKSIZE;
! ysave->yyvs = yyvs =
! ! (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
! ysave->yyss = yyss =
! ! (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short));
! if (!yyvs || !yyss)
! goto yyoverflow;
! yyssp = yyss + yyps_index;
***************
*** 272,278 ****
! goto yyoverflow;
}
*++yyssp = yystate = yytable[yyn];
! --- 1448,1472 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
--- 280,286 ----
! goto yyoverflow;
}
*++yyssp = yystate = yytable[yyn];
! --- 1450,1474 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
***************
*** 288,296 ****
! int yyps_index = (yyssp - yyss);
! int yypv_index = (yyvsp - yyvs);
! yystacksize += YYSTACKSIZE;
! ! ysave->yyvs = yyvs = (YYSTYPE*)realloc((char*)yyvs,
! yystacksize * sizeof(YYSTYPE));
! ! ysave->yyss = yyss = (short*)realloc((char*)yyss,
! yystacksize * sizeof(short));
! if (!yyvs || !yyss)
! goto yyoverflow;
--- 296,304 ----
! int yyps_index = (yyssp - yyss);
! int yypv_index = (yyvsp - yyvs);
! yystacksize += YYSTACKSIZE;
! ! ysave->yyvs = yyvs = (YYSTYPE*)PerlMem_realloc((char*)yyvs,
! yystacksize * sizeof(YYSTYPE));
! ! ysave->yyss = yyss = (short*)PerlMem_realloc((char*)yyss,
! yystacksize * sizeof(short));
! if (!yyvs || !yyss)
! goto yyoverflow;
***************
*** 306,312 ****
! *yyssp);
#endif
if (yyssp <= yyss) goto yyabort;
! --- 1478,1484 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
--- 314,320 ----
! *yyssp);
#endif
if (yyssp <= yyss) goto yyabort;
! --- 1480,1486 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
***************
*** 322,328 ****
! yystate, yychar, yys);
}
#endif
! --- 1497,1503 ----
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
! PerlIO_printf(Perl_debug_log,
--- 330,336 ----
! yystate, yychar, yys);
}
#endif
! --- 1499,1505 ----
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
! PerlIO_printf(Perl_debug_log,
***************
*** 337,343 ****
! printf("yydebug: state %d, reducing by rule %d (%s)\n",
yystate, yyn, yyrule[yyn]);
#endif
! --- 1508,1512 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n",
--- 345,351 ----
! printf("yydebug: state %d, reducing by rule %d (%s)\n",
yystate, yyn, yyrule[yyn]);
#endif
! --- 1510,1514 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reducing by rule %d (%s)\n",
***************
*** 350,356 ****
! #line 2270 "y.tab.c"
}
yyssp -= yym;
! --- 2292,2296 ----
{ yyval.opval = yyvsp[0].opval; }
break;
! #line 2270 "perly.c"
--- 358,364 ----
! #line 2270 "y.tab.c"
}
yyssp -= yym;
! --- 2294,2298 ----
{ yyval.opval = yyvsp[0].opval; }
break;
! #line 2270 "perly.c"
***************
*** 364,370 ****
! state %d\n", YYFINAL);
#endif
yystate = YYFINAL;
! --- 2302,2308 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
--- 372,378 ----
! state %d\n", YYFINAL);
#endif
yystate = YYFINAL;
! --- 2304,2310 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
***************
*** 379,385 ****
! printf("yydebug: state %d, reading %d (%s)\n",
YYFINAL, yychar, yys);
}
! --- 2318,2322 ----
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n",
--- 387,393 ----
! printf("yydebug: state %d, reading %d (%s)\n",
YYFINAL, yychar, yys);
}
! --- 2320,2324 ----
if (yychar <= YYMAXTOKEN) yys = yyname[yychar];
if (!yys) yys = "illegal-symbol";
! PerlIO_printf(Perl_debug_log, "yydebug: state %d, reading %d (%s)\n",
***************
*** 397,403 ****
! goto yyoverflow;
}
*++yyssp = yystate;
! --- 2333,2357 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
--- 405,411 ----
! goto yyoverflow;
}
*++yyssp = yystate;
! --- 2335,2359 ----
#if YYDEBUG
if (yydebug)
! PerlIO_printf(Perl_debug_log,
***************
*** 414,422 ****
! int yypv_index = (yyvsp - yyvs);
! yystacksize += YYSTACKSIZE;
! ysave->yyvs = yyvs =
! ! (YYSTYPE*)realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
! ysave->yyss = yyss =
! ! (short*)realloc((char*)yyss,yystacksize * sizeof(short));
! if (!yyvs || !yyss)
! goto yyoverflow;
! yyssp = yyss + yyps_index;
--- 422,430 ----
! int yypv_index = (yyvsp - yyvs);
! yystacksize += YYSTACKSIZE;
! ysave->yyvs = yyvs =
! ! (YYSTYPE*)PerlMem_realloc((char*)yyvs,yystacksize * sizeof(YYSTYPE));
! ysave->yyss = yyss =
! ! (short*)PerlMem_realloc((char*)yyss,yystacksize * sizeof(short));
! if (!yyvs || !yyss)
! goto yyoverflow;
! yyssp = yyss + yyps_index;
***************
*** 433,439 ****
yyaccept:
! return (0);
}
! --- 2359,2366 ----
goto yyloop;
yyoverflow:
! yyerror("Out of memory for yacc stack");
--- 441,447 ----
yyaccept:
! return (0);
}
! --- 2361,2368 ----
goto yyloop;
yyoverflow:
! yyerror("Out of memory for yacc stack");
diff -c 'perl5.005_02/pod/Makefile' 'perl5.005_03/pod/Makefile'
Index: ./pod/Makefile
*** ./pod/Makefile Thu Jul 23 23:01:19 1998
--- ./pod/Makefile Sun Mar 28 10:13:03 1999
***************
*** 16,27 ****
--- 16,29 ----
POD = \
perl.pod \
perldelta.pod \
+ perl5004delta.pod \
perldata.pod \
perlsyn.pod \
perlop.pod \
perlre.pod \
perlrun.pod \
perlfunc.pod \
+ perlopentut.pod \
perlvar.pod \
perlsub.pod \
perlmod.pod \
***************
*** 30,35 ****
--- 32,38 ----
perlform.pod \
perllocale.pod \
perlref.pod \
+ perlreftut.pod \
perldsc.pod \
perllol.pod \
perltoot.pod \
***************
*** 37,42 ****
--- 40,46 ----
perltie.pod \
perlbot.pod \
perlipc.pod \
+ perlthrtut.pod \
perldebug.pod \
perldiag.pod \
perlsec.pod \
***************
*** 51,56 ****
--- 55,61 ----
perlxstut.pod \
perlguts.pod \
perlcall.pod \
+ perlhist.pod \
perlfaq.pod \
perlfaq1.pod \
perlfaq2.pod \
***************
*** 66,77 ****
--- 71,84 ----
MAN = \
perl.man \
perldelta.man \
+ perl5004delta.man \
perldata.man \
perlsyn.man \
perlop.man \
perlre.man \
perlrun.man \
perlfunc.man \
+ perlopentut.man \
perlvar.man \
perlsub.man \
perlmod.man \
***************
*** 80,85 ****
--- 87,93 ----
perlform.man \
perllocale.man \
perlref.man \
+ perlreftut.man \
perldsc.man \
perllol.man \
perltoot.man \
***************
*** 87,92 ****
--- 95,101 ----
perltie.man \
perlbot.man \
perlipc.man \
+ perlthrtut.man \
perldebug.man \
perldiag.man \
perlsec.man \
***************
*** 101,106 ****
--- 110,116 ----
perlxstut.man \
perlguts.man \
perlcall.man \
+ perlhist.man \
perlfaq.man \
perlfaq1.man \
perlfaq2.man \
***************
*** 116,127 ****
--- 126,139 ----
HTML = \
perl.html \
perldelta.html \
+ perl5004delta.html \
perldata.html \
perlsyn.html \
perlop.html \
perlre.html \
perlrun.html \
perlfunc.html \
+ perlopentut.html \
perlvar.html \
perlsub.html \
perlmod.html \
***************
*** 130,135 ****
--- 142,148 ----
perlform.html \
perllocale.html \
perlref.html \
+ perlreftut.html \
perldsc.html \
perllol.html \
perltoot.html \
***************
*** 137,142 ****
--- 150,156 ----
perltie.html \
perlbot.html \
perlipc.html \
+ perlthrtut.html \
perldebug.html \
perldiag.html \
perlsec.html \
***************
*** 151,156 ****
--- 165,171 ----
perlxstut.html \
perlguts.html \
perlcall.html \
+ perlhist.html \
perlfaq.html \
perlfaq1.html \
perlfaq2.html \
***************
*** 166,177 ****
--- 181,194 ----
TEX = \
perl.tex \
perldelta.tex \
+ perl5004delta.tex \
perldata.tex \
perlsyn.tex \
perlop.tex \
perlre.tex \
perlrun.tex \
perlfunc.tex \
+ perlopentut.tex \
perlvar.tex \
perlsub.tex \
perlmod.tex \
***************
*** 180,185 ****
--- 197,204 ----
perlform.tex \
perllocale.tex \
perlref.tex \
+ perlreftut.tex \
+ perlopentut.tex \
perldsc.tex \
perllol.tex \
perltoot.tex \
***************
*** 187,192 ****
--- 206,212 ----
perltie.tex \
perlbot.tex \
perlipc.tex \
+ perlthrtut.tex \
perldebug.tex \
perldiag.tex \
perlsec.tex \
***************
*** 201,206 ****
--- 221,227 ----
perlxstut.tex \
perlguts.tex \
perlcall.tex \
+ perlhist.tex \
perlfaq.tex \
perlfaq1.tex \
perlfaq2.tex \
diff -c 'perl5.005_02/pod/buildtoc' 'perl5.005_03/pod/buildtoc'
Index: ./pod/buildtoc
*** ./pod/buildtoc Thu Jul 23 23:01:19 1998
--- ./pod/buildtoc Thu Feb 11 18:06:05 1999
***************
*** 6,15 ****
@pods = qw(
perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
! perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata
! perlsyn perlop perlre perlrun perlfunc perlvar perlsub
perlmod perlmodlib perlmodinstall perlform perllocale perlref perldsc
! perllol perltoot perlobj perltie perlbot perlipc perldebug
perldiag perlsec perltrap perlport perlstyle perlpod perlbook
perlembed perlapio perlxs perlxstut perlguts perlcall
perlhist
--- 6,15 ----
@pods = qw(
perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5
! perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata perlopentut
! perlsyn perlop perlre perlreftut perlrun perlfunc perlvar perlsub
perlmod perlmodlib perlmodinstall perlform perllocale perlref perldsc
! perllol perltoot perlobj perltie perlthrtut perlbot perlipc perldebug
perldiag perlsec perltrap perlport perlstyle perlpod perlbook
perlembed perlapio perlxs perlxstut perlguts perlcall
perlhist
diff -c 'perl5.005_02/pod/perl.pod' 'perl5.005_03/pod/perl.pod'
Index: ./pod/perl.pod
*** ./pod/perl.pod Thu Jul 23 23:01:19 1998
--- ./pod/perl.pod Sun Mar 28 10:13:04 1999
***************
*** 20,25 ****
--- 20,26 ----
perl Perl overview (this section)
perldelta Perl changes since previous version
+ perl5004delta Perl changes in version 5.004
perlfaq Perl frequently asked questions
perltoc Perl documentation table of contents
***************
*** 29,34 ****
--- 30,36 ----
perlre Perl regular expressions
perlrun Perl execution and options
perlfunc Perl builtin functions
+ perlopentut Perl open() tutorial
perlvar Perl predefined variables
perlsub Perl subroutines
perlmod Perl modules: how they work
***************
*** 38,43 ****
--- 40,46 ----
perllocale Perl locale support
perlref Perl references
+ perlreftut Perl references short introduction
perldsc Perl data structures intro
perllol Perl data structures: lists of lists
perltoot Perl OO tutorial
***************
*** 45,50 ****
--- 48,54 ----
perltie Perl objects hidden behind simple variables
perlbot Perl OO tricks and examples
perlipc Perl interprocess communication
+ perlthrtut Perl threads tutorial
perldebug Perl debugging
perldiag Perl diagnostic messages
***************
*** 68,75 ****
(If you're intending to read these straight through for the first time,
the suggested order will tend to reduce the number of forward references.)
! By default, all of the above manpages are installed in the
! F</usr/local/man/> directory.
Extensive additional documentation for Perl modules is available. The
default configuration for perl will place this additional documentation
--- 72,79 ----
(If you're intending to read these straight through for the first time,
the suggested order will tend to reduce the number of forward references.)
! By default, all of the above manpages are installed in the
! F</usr/local/man/> directory.
Extensive additional documentation for Perl modules is available. The
default configuration for perl will place this additional documentation
***************
*** 116,124 ****
expression syntax. Unlike most Unix utilities, Perl does not
arbitrarily limit the size of your data--if you've got the memory,
Perl can slurp in your whole file as a single string. Recursion is of
! unlimited depth. And the tables used by hashes (previously called
"associative arrays") grow as necessary to prevent degraded
! performance. Perl uses sophisticated pattern matching techniques to
scan large amounts of data very quickly. Although optimized for
scanning text, Perl can also deal with binary data, and can make dbm
files look like hashes. Setuid Perl scripts are safer than C programs
--- 120,128 ----
expression syntax. Unlike most Unix utilities, Perl does not
arbitrarily limit the size of your data--if you've got the memory,
Perl can slurp in your whole file as a single string. Recursion is of
! unlimited depth. And the tables used by hashes (sometimes called
"associative arrays") grow as necessary to prevent degraded
! performance. Perl can use sophisticated pattern matching techniques to
scan large amounts of data very quickly. Although optimized for
scanning text, Perl can also deal with binary data, and can make dbm
files look like hashes. Setuid Perl scripts are safer than C programs
***************
*** 239,244 ****
--- 243,321 ----
Okay, that's I<definitely> enough hype.
+ =head1 AVAILABILITY
+
+ Perl is available for the vast majority of operating system platforms,
+ including most Unix-like platforms. The following situation is as of
+ February 1999 and Perl 5.005_03.
+
+ The following platforms are able to build Perl from the standard
+ source code distribution available at
+ F<http://www.perl.com/CPAN/src/index.html>
+
+ AIX Linux SCO ODT/OSR
+ A/UX MachTen Solaris
+ BeOS MPE/iX SunOS
+ BSD/OS NetBSD SVR4
+ DG/UX NextSTEP Tru64 UNIX 3)
+ DomainOS OpenBSD Ultrix
+ DOS DJGPP 1) OpenSTEP UNICOS
+ DYNIX/ptx OS/2 VMS
+ FreeBSD OS390 2) VOS
+ HP-UX PowerMAX Windows 3.1 1)
+ Hurd QNX Windows 95 1) 4)
+ IRIX Windows 98 1) 4)
+ Windows NT 1) 4)
+
+ 1) in DOS mode either the DOS or OS/2 ports can be used
+ 2) formerly known as MVS
+ 3) formerly known as Digital UNIX and before that DEC OSF/1
+ 4) compilers: Borland, Cygwin32, Mingw32 EGCS/GCC, VC++
+
+ The following platforms have been known to build Perl from the source
+ but for the Perl release 5.005_03 we haven't been able to verify them,
+ either because the hardware/software platforms are rather rare or
+ because we don't have an active champion on these platforms, or both.
+
+ 3b1 FPS Plan 9
+ AmigaOS GENIX PowerUX
+ ConvexOS Greenhills RISC/os
+ CX/UX ISC Stellar
+ DC/OSx MachTen 68k SVR2
+ DDE SMES MiNT TI1500
+ DOS EMX MPC TitanOS
+ Dynix NEWS-OS UNICOS/mk
+ EP/IX Opus Unisys Dynix
+ ESIX Unixware
+
+ The following platforms are planned to be supported in the standard
+ source code distribution of the Perl release 5.006 but are not
+ supported in the Perl release 5.005_03:
+
+ BS2000
+ Netware
+ Rhapsody
+ VM/ESA
+
+ The following platforms have their own source code distributions and
+ binaries available via F<http://www.perl.com/CPAN/ports/index.html>.
+
+ Perl release
+
+ AS/400 5.003
+ MacOS 5.004
+ Netware 5.003_07
+ Tandem Guardian 5.004
+
+ The following platforms have only binaries available via
+ F<http://www.perl.com/CPAN/ports/index.html>.
+
+ Perl release
+
+ Acorn RISCOS 5.005_02
+ AOS 5.002
+ LynxOS 5.004_02
+
=head1 ENVIRONMENT
See L<perlrun>.
***************
*** 247,260 ****
Larry Wall <F<larry@wall.org>>, with the help of oodles of other folks.
! If your Perl success stories and testimonials may be of help to others
! who wish to advocate the use of Perl in their applications,
! or if you wish to simply express your gratitude to Larry and the
Perl developers, please write to <F<perl-thanks@perl.org>>.
=head1 FILES
- "/tmp/perl-e$$" temporary file for -e commands
"@INC" locations of perl libraries
=head1 SEE ALSO
--- 324,336 ----
Larry Wall <F<larry@wall.org>>, with the help of oodles of other folks.
! If your Perl success stories and testimonials may be of help to others
! who wish to advocate the use of Perl in their applications,
! or if you wish to simply express your gratitude to Larry and the
Perl developers, please write to <F<perl-thanks@perl.org>>.
=head1 FILES
"@INC" locations of perl libraries
=head1 SEE ALSO
***************
*** 296,304 ****
While none of the built-in data types have any arbitrary size limits
(apart from memory size), there are still a few arbitrary limits: a
! given variable name may not be longer than 255 characters, and no
! component of your PATH may be longer than 255 if you use B<-S>. A regular
! expression may not compile to more than 32767 bytes internally.
You may mail your bug reports (be sure to include full configuration
information as output by the myconfig program in the perl source tree,
--- 372,381 ----
While none of the built-in data types have any arbitrary size limits
(apart from memory size), there are still a few arbitrary limits: a
! given variable name may not be longer than 251 characters. Line numbers
! displayed by diagnostics are internally stored as short integers,
! so they are limited to a maximum of 65535 (higher numbers usually being
! affected by wraparound).
You may mail your bug reports (be sure to include full configuration
information as output by the myconfig program in the perl source tree,
diff -c 'perl5.005_02/pod/perl5004delta.pod' 'perl5.005_03/pod/perl5004delta.pod'
Index: ./pod/perl5004delta.pod
*** ./pod/perl5004delta.pod Thu Jul 23 23:01:21 1998
--- ./pod/perl5004delta.pod Sat Mar 27 13:40:52 1999
***************
*** 1432,1438 ****
=item Stub found while resolving method `%s' overloading `%s' in package `%s'
(P) Overloading resolution over @ISA tree may be broken by importing stubs.
! Stubs should never be implicitely created, but explicit calls to C<can>
may break this.
=item Too late for "B<-T>" option
--- 1432,1438 ----
=item Stub found while resolving method `%s' overloading `%s' in package `%s'
(P) Overloading resolution over @ISA tree may be broken by importing stubs.
! Stubs should never be implicitly created, but explicit calls to C<can>
may break this.
=item Too late for "B<-T>" option
diff -c 'perl5.005_02/pod/perlcall.pod' 'perl5.005_03/pod/perlcall.pod'
Index: ./pod/perlcall.pod
*** ./pod/perlcall.pod Sat Aug 1 22:40:14 1998
--- ./pod/perlcall.pod Sat Mar 27 13:47:40 1999
***************
*** 72,78 ****
=over 5
! =item B<perl_call_sv>
I<perl_call_sv> takes two parameters, the first, C<sv>, is an SV*.
This allows you to specify the Perl subroutine to be called either as a
--- 72,78 ----
=over 5
! =item perl_call_sv
I<perl_call_sv> takes two parameters, the first, C<sv>, is an SV*.
This allows you to specify the Perl subroutine to be called either as a
***************
*** 80,86 ****
subroutine. The section, I<Using perl_call_sv>, shows how you can make
use of I<perl_call_sv>.
! =item B<perl_call_pv>
The function, I<perl_call_pv>, is similar to I<perl_call_sv> except it
expects its first parameter to be a C char* which identifies the Perl
--- 80,86 ----
subroutine. The section, I<Using perl_call_sv>, shows how you can make
use of I<perl_call_sv>.
! =item perl_call_pv
The function, I<perl_call_pv>, is similar to I<perl_call_sv> except it
expects its first parameter to be a C char* which identifies the Perl
***************
*** 88,94 ****
subroutine you want to call is in another package, just include the
package name in the string, e.g., C<"pkg::fred">.
! =item B<perl_call_method>
The function I<perl_call_method> is used to call a method from a Perl
class. The parameter C<methname> corresponds to the name of the method
--- 88,94 ----
subroutine you want to call is in another package, just include the
package name in the string, e.g., C<"pkg::fred">.
! =item perl_call_method
The function I<perl_call_method> is used to call a method from a Perl
class. The parameter C<methname> corresponds to the name of the method
***************
*** 99,105 ****
static and virtual methods and L<Using perl_call_method> for an example
of using I<perl_call_method>.
! =item B<perl_call_argv>
I<perl_call_argv> calls the Perl subroutine specified by the C string
stored in the C<subname> parameter. It also takes the usual C<flags>
--- 99,105 ----
static and virtual methods and L<Using perl_call_method> for an example
of using I<perl_call_method>.
! =item perl_call_argv
I<perl_call_argv> calls the Perl subroutine specified by the C string
stored in the C<subname> parameter. It also takes the usual C<flags>
***************
*** 971,977 ****
/* Check the eval first */
if (SvTRUE(ERRSV))
{
! printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ;
POPs ;
}
else
--- 971,978 ----
/* Check the eval first */
if (SvTRUE(ERRSV))
{
! STRLEN n_a;
! printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
POPs ;
}
else
***************
*** 1013,1019 ****
if (SvTRUE(ERRSV))
{
! printf ("Uh oh - %s\n", SvPV(ERRSV, PL_na)) ;
POPs ;
}
--- 1014,1021 ----
if (SvTRUE(ERRSV))
{
! STRLEN n_a;
! printf ("Uh oh - %s\n", SvPV(ERRSV, n_a)) ;
POPs ;
}
***************
*** 1923,1930 ****
=head2 Creating and calling an anonymous subroutine in C
As we've already shown, C<perl_call_sv> can be used to invoke an
! anonymous subroutine. However, our example showed how Perl script
! invoking an XSUB to preform this operation. Let's see how it can be
done inside our C code:
...
--- 1925,1932 ----
=head2 Creating and calling an anonymous subroutine in C
As we've already shown, C<perl_call_sv> can be used to invoke an
! anonymous subroutine. However, our example showed a Perl script
! invoking an XSUB to perform this operation. Let's see how it can be
done inside our C code:
...
diff -c 'perl5.005_02/pod/perldata.pod' 'perl5.005_03/pod/perldata.pod'
Index: ./pod/perldata.pod
*** ./pod/perldata.pod Thu Jul 23 23:01:22 1998
--- ./pod/perldata.pod Tue Dec 29 08:35:38 1998
***************
*** 253,259 ****
single-quoted strings are not (except for "C<\'>" and "C<\\>").
The usual Unix backslash rules apply for making characters such as
newline, tab, etc., as well as some more exotic forms. See
! L<perlop/Quote and Quotelike Operators> for a list.
Octal or hex representations in string literals (e.g. '0xffff') are not
automatically converted to their integer representation. The hex() and
--- 253,259 ----
single-quoted strings are not (except for "C<\'>" and "C<\\>").
The usual Unix backslash rules apply for making characters such as
newline, tab, etc., as well as some more exotic forms. See
! L<perlop/"Quote and Quotelike Operators"> for a list.
Octal or hex representations in string literals (e.g. '0xffff') are not
automatically converted to their integer representation. The hex() and
***************
*** 471,477 ****
($map{'red'}, $map{'blue'}, $map{'green'}) = (0x00f, 0x0f0, 0xf00);
! Array assignment in a scalar context returns the number of elements
produced by the expression on the right side of the assignment:
$x = (($foo,$bar) = (3,2,1)); # set $x to 3, not 2
--- 471,477 ----
($map{'red'}, $map{'blue'}, $map{'green'}) = (0x00f, 0x0f0, 0xf00);
! List assignment in a scalar context returns the number of elements
produced by the expression on the right side of the assignment:
$x = (($foo,$bar) = (3,2,1)); # set $x to 3, not 2
diff -c 'perl5.005_02/pod/perldebug.pod' 'perl5.005_03/pod/perldebug.pod'
Index: ./pod/perldebug.pod
*** ./pod/perldebug.pod Thu Jul 23 23:01:24 1998
--- ./pod/perldebug.pod Sun Mar 28 10:13:08 1999
***************
*** 1109,1115 ****
Perl is I<very> frivolous with memory. There is a saying that to
estimate memory usage of Perl, assume a reasonable algorithm of
! allocation, and multiply your estimages by 10. This is not absolutely
true, but may give you a good grasp of what happens.
Say, an integer cannot take less than 20 bytes of memory, a float
--- 1109,1115 ----
Perl is I<very> frivolous with memory. There is a saying that to
estimate memory usage of Perl, assume a reasonable algorithm of
! allocation, and multiply your estimates by 10. This is not absolutely
true, but may give you a good grasp of what happens.
Say, an integer cannot take less than 20 bytes of memory, a float
***************
*** 1161,1167 ****
Total sbrk(): 215040/47:145. Odd ends: pad+heads+chain+tail: 0+2192+0+6144.
It is possible to ask for such a statistic at arbitrary moment by
! usind Devel::Peek::mstats() (module Devel::Peek is available on CPAN).
Here is the explanation of different parts of the format:
--- 1161,1167 ----
Total sbrk(): 215040/47:145. Odd ends: pad+heads+chain+tail: 0+2192+0+6144.
It is possible to ask for such a statistic at arbitrary moment by
! using Devel::Peek::mstats() (module Devel::Peek is available on CPAN).
Here is the explanation of different parts of the format:
***************
*** 1195,1201 ****
buckets "above".
Say, with the above example the memory footprints are (with current
! algorith)
free: 8 16 32 64 128 256 512 1024 2048 4096 8192
4 12 24 48 80
--- 1195,1201 ----
buckets "above".
Say, with the above example the memory footprints are (with current
! algorithm)
free: 8 16 32 64 128 256 512 1024 2048 4096 8192
4 12 24 48 80
***************
*** 1328,1334 ****
It also creates C arrays to keep data for the stash (this is one HV,
but it grows, thus there are 4 big allocations: the big chunks are not
! freeed, but are kept as additional arenas for C<SV> allocations).
=item C<054>
--- 1328,1334 ----
It also creates C arrays to keep data for the stash (this is one HV,
but it grows, thus there are 4 big allocations: the big chunks are not
! freed, but are kept as additional arenas for C<SV> allocations).
=item C<054>
diff -c 'perl5.005_02/pod/perldelta.pod' 'perl5.005_03/pod/perldelta.pod'
Index: ./pod/perldelta.pod
*** ./pod/perldelta.pod Sun Aug 2 00:15:07 1998
--- ./pod/perldelta.pod Sat Mar 27 21:55:18 1999
***************
*** 85,91 ****
names without the C<Perl_> prefix are supported with macros, but this
support may cease in a future release.
! See L<perlguts/API LISTING>.
=item Enabling threads has source compatibility issues
--- 85,91 ----
names without the C<Perl_> prefix are supported with macros, but this
support may cease in a future release.
! See L<perlguts/"API LISTING">.
=item Enabling threads has source compatibility issues
***************
*** 100,106 ****
backward compatible with existing perls and provides source compatibility
with threading is enabled.
! See L<API Changes for more information>.
=back
--- 100,106 ----
backward compatible with existing perls and provides source compatibility
with threading is enabled.
! See L<"C Source Compatibility"> for more information.
=back
***************
*** 153,158 ****
--- 153,161 ----
See L<README.threads>.
+ Mach cthreads (NEXTSTEP, OPENSTEP, Rhapsody) are now supported by
+ the Thread extension.
+
=head2 Compiler
WARNING: The Compiler and related tools are considered B<experimental>.
***************
*** 310,316 ****
Perl used to complain if it encountered literal carriage returns in
scripts. Now they are mostly treated like whitespace within program text.
Inside string literals and here documents, literal carriage returns are
! ignored if they occur paired with newlines, or get interpreted as newlines
if they stand alone. This behavior means that literal carriage returns
in files should be avoided. You can get the older, more compatible (but
less generous) behavior by defining the preprocessor symbol
--- 313,319 ----
Perl used to complain if it encountered literal carriage returns in
scripts. Now they are mostly treated like whitespace within program text.
Inside string literals and here documents, literal carriage returns are
! ignored if they occur paired with linefeeds, or get interpreted as whitespace
if they stand alone. This behavior means that literal carriage returns
in files should be avoided. You can get the older, more compatible (but
less generous) behavior by defining the preprocessor symbol
***************
*** 488,493 ****
--- 491,520 ----
E<lt>E<gt> will read in records instead of lines. For more info, see
L<perlvar/$/>.
+ =head2 pack() format 'Z' supported
+
+ The new format type 'Z' is useful for packing and unpacking null-terminated
+ strings. See L<perlfunc/"pack">.
+
+ =head1 Significant bug fixes
+
+ =head2 E<lt>HANDLEE<gt> on empty files
+
+ With C<$/> set to C<undef>, slurping an empty file returns a string of
+ zero length (instead of C<undef>, as it used to) for the first time the
+ HANDLE is read. Subsequent reads yield C<undef>.
+
+ This means that the following will append "foo" to an empty file (it used
+ to not do anything before):
+
+ perl -0777 -pi -e 's/^/foo/' empty_file
+
+ Note that the behavior of:
+
+ perl -pi -e 's/^/foo/' empty_file
+
+ is unchanged (it continues to leave the file empty).
+
=head1 Supported Platforms
Configure has many incremental improvements. Site-wide policy for building
***************
*** 500,508 ****
DOS is now supported under the DJGPP tools. See L<README.dos>.
MPE/iX is now supported. See L<README.mpeix>.
! MVS (OS390) is now supported. See L<README.os390>.
=head2 Changes in existing support
--- 527,541 ----
DOS is now supported under the DJGPP tools. See L<README.dos>.
+ GNU/Hurd is now supported.
+
+ MiNT is now supported. See L<README.mint>.
+
MPE/iX is now supported. See L<README.mpeix>.
! MVS (aka OS390, aka Open Edition) is now supported. See L<README.os390>.
!
! Stratus VOS is now supported. See L<README.vos>.
=head2 Changes in existing support
***************
*** 528,533 ****
--- 561,570 ----
A module to pretty print Perl data. See L<Data::Dumper>.
+ =item Dumpvalue
+
+ A module to dump perl values to the screen. See L<Dumpvalue>.
+
=item Errno
A module to look up errors more conveniently. See L<Errno>.
***************
*** 587,596 ****
--- 624,675 ----
=over
+ =item Benchmark
+
+ You can now run tests for I<n> seconds instead of guessing the right
+ number of tests to run: e.g. timethese(-5, ...) will run each of the
+ codes for at least 5 CPU seconds. Zero as the "number of repetitions"
+ means "for at least 3 CPU seconds". The output format has also
+ changed. For example:
+
+ use Benchmark;$x=3;timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}})
+
+ will now output something like this:
+
+ Benchmark: running a, b, each for at least 5 CPU seconds...
+ a: 5 wallclock secs ( 5.77 usr + 0.00 sys = 5.77 CPU) @ 200551.91/s (n=1156516)
+ b: 4 wallclock secs ( 5.00 usr + 0.02 sys = 5.02 CPU) @ 159605.18/s (n=800686)
+
+ New features: "each for at least N CPU seconds...", "wallclock secs",
+ and the "@ operations/CPU second (n=operations)".
+
+ =item Carp
+
+ Carp has a new function cluck(). cluck() warns, like carp(), but also adds
+ a stack backtrace to the error message, like confess().
+
=item CGI
CGI has been updated to version 2.42.
+ =item Fcntl
+
+ More Fcntl constants added: F_SETLK64, F_SETLKW64, O_LARGEFILE for
+ large (more than 4G) file access (the 64-bit support is not yet
+ working, though, so no need to get overly excited), Free/Net/OpenBSD
+ locking behaviour flags F_FLOCK, F_POSIX, Linux F_SHLCK, and
+ O_ACCMODE: the mask of O_RDONLY, O_WRONLY, and O_RDWR.
+
+ =item Math::Complex
+
+ The accessor methods Re, Im, arg, abs, rho, and theta, can now also
+ act as mutators (accessor $z->Re(), mutator $z->Re(3)).
+
+ =item Math::Trig
+
+ A little bit of radial trigonometry (cylindrical and spherical) added:
+ radial coordinate conversions and the great circle distance.
+
=item POSIX
POSIX now has its own platform-specific hints files.
***************
*** 655,660 ****
--- 734,745 ----
Some more Perl traps are documented now. See L<perltrap>.
+ L<perlopentut> gives a tutorial on using open().
+
+ L<perlreftut> gives a tutorial on references.
+
+ L<perlthrtut> gives a tutorial on threads.
+
=head1 New Diagnostics
=over
***************
*** 697,702 ****
--- 782,791 ----
process $BADREF 1,2,3;
$BADREF->process(1,2,3);
+ =item Can't check filesystem of script "%s" for nosuid
+
+ (P) For some reason you can't check the filesystem of the script for nosuid.
+
=item Can't coerce array into hash
(F) You used an array where a hash was expected, but the array has no
***************
*** 776,782 ****
(W) You are blessing a reference to a zero length string. This has
the effect of blessing the reference into the package main. This is
usually not what you want. Consider providing a default target
! package, e.g. bless($ref, $p or 'MyPackage');
=item Illegal hex digit ignored
--- 865,871 ----
(W) You are blessing a reference to a zero length string. This has
the effect of blessing the reference into the package main. This is
usually not what you want. Consider providing a default target
! package, e.g. bless($ref, $p || 'MyPackage');
=item Illegal hex digit ignored
***************
*** 860,866 ****
is a "default locale" called "C" that Perl can and will use, the
script will be run. Before you really fix the problem, however, you
will get the same error message each time you run Perl. How to really
! fix the problem can be found in L<perllocale> section B<LOCALE PROBLEMS>.
=back
--- 949,955 ----
is a "default locale" called "C" that Perl can and will use, the
script will be run. Before you really fix the problem, however, you
will get the same error message each time you run Perl. How to really
! fix the problem can be found in L<perllocale/"LOCALE PROBLEMS">.
=back
***************
*** 874,890 ****
--- 963,1000 ----
(F) The mktemp() routine failed for some reason while trying to process
a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
+ Removed because B<-e> doesn't use temporary files any more.
+
=item Can't write to temp file for B<-e>: %s
(F) The write routine failed for some reason while trying to process
a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
+ Removed because B<-e> doesn't use temporary files any more.
+
=item Cannot open temporary file
(F) The create routine failed for some reason while trying to process
a B<-e> switch. Maybe your /tmp partition is full, or clobbered.
+ Removed because B<-e> doesn't use temporary files any more.
+
+ =item regexp too big
+
+ (F) The current implementation of regular expressions uses shorts as
+ address offsets within a string. Unfortunately this means that if
+ the regular expression compiles to longer than 32767, it'll blow up.
+ Usually when you want a regular expression this big, there is a better
+ way to do it with multiple statements. See L<perlre>.
+
=back
+
+ =head1 Configuration Changes
+
+ You can use "Configure -Uinstallusrbinperl" which causes installperl
+ to skip installing perl also as /usr/bin/perl. This is useful if you
+ prefer not to modify /usr/bin for some reason or another but harmful
+ because many scripts assume to find Perl in /usr/bin/perl.
=head1 BUGS
diff -c 'perl5.005_02/pod/perldiag.pod' 'perl5.005_03/pod/perldiag.pod'
Index: ./pod/perldiag.pod
*** ./pod/perldiag.pod Sun Aug 2 01:44:13 1998
--- ./pod/perldiag.pod Sun Mar 28 10:13:12 1999
***************
*** 33,43 ****
to try to declare one with a package qualifier on the front. Use local()
if you want to localize a package variable.
! =item "my" variable %s masks earlier declaration in same scope
! (W) A lexical variable has been redeclared in the same scope, effectively
! eliminating all access to the previous instance. This is almost always
! a typographical error. Note that the earlier variable will still exist
until the end of the scope or until all closure referents to it are
destroyed.
--- 33,43 ----
to try to declare one with a package qualifier on the front. Use local()
if you want to localize a package variable.
! =item "my" variable %s masks earlier declaration in same %s
! (W) A lexical variable has been redeclared in the current scope or statement,
! effectively eliminating all access to the previous instance. This is almost
! always a typographical error. Note that the earlier variable will still exist
until the end of the scope or until all closure referents to it are
destroyed.
***************
*** 143,148 ****
--- 143,160 ----
instead of Perl. Check the #! line, or manually feed your script
into Perl yourself.
+ =item (in cleanup) %s
+
+ (W) This prefix usually indicates that a DESTROY() method raised
+ the indicated exception. Since destructors are usually called by
+ the system at arbitrary points during execution, and often a vast
+ number of times, the warning is issued only once for any number
+ of failures that would otherwise result in the same message being
+ repeated.
+
+ Failure of user callbacks dispatched using the C<G_KEEPERR> flag
+ could also result in this warning. See L<perlcall/G_KEEPERR>.
+
=item (Missing semicolon on previous line?)
(S) This is an educated guess made in conjunction with the message "%s
***************
*** 376,382 ****
=item Bareword "%s" not allowed while "strict subs" in use
(F) With "strict subs" in use, a bareword is only allowed as a
! subroutine identifier, in curly braces or to the left of the "=>" symbol.
Perhaps you need to predeclare a subroutine?
=item Bareword "%s" refers to nonexistent package
--- 388,394 ----
=item Bareword "%s" not allowed while "strict subs" in use
(F) With "strict subs" in use, a bareword is only allowed as a
! subroutine identifier, in curly brackets or to the left of the "=>" symbol.
Perhaps you need to predeclare a subroutine?
=item Bareword "%s" refers to nonexistent package
***************
*** 499,504 ****
--- 511,520 ----
(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" for nosuid
+
+ (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
***************
*** 1002,1007 ****
--- 1018,1031 ----
(W) You tried to do a connect on a closed socket. Did you forget to check
the return value of your socket() call? See L<perlfunc/connect>.
+ =item Constant is not %s reference
+
+ (F) A constant value (perhaps declared using the C<use constant> pragma)
+ is being dereferenced, but it amounts to the wrong type of reference. The
+ message indicates the type of reference that was expected. This usually
+ indicates a syntax error in dereferencing the constant value.
+ See L<perlsub/"Constant Functions"> and L<constant>.
+
=item Constant subroutine %s redefined
(S) You redefined a subroutine which had previously been eligible for
***************
*** 1162,1168 ****
(W) You are blessing a reference to a zero length string. This has
the effect of blessing the reference into the package main. This is
usually not what you want. Consider providing a default target
! package, e.g. bless($ref, $p or 'MyPackage');
=item Fatal VMS error at %s, line %d
--- 1186,1192 ----
(W) You are blessing a reference to a zero length string. This has
the effect of blessing the reference into the package main. This is
usually not what you want. Consider providing a default target
! package, e.g. bless($ref, $p || 'MyPackage');
=item Fatal VMS error at %s, line %d
***************
*** 1258,1264 ****
(S) A warning peculiar to VMS. The call to C<sys$getuai> underlying the
C<getpwnam> operator returned an invalid UIC.
-
=item Glob not terminated
(F) The lexer saw a left angle bracket in a place where it was expecting
--- 1282,1287 ----
***************
*** 1404,1410 ****
(S) A warning peculiar to VMS. Perl keeps track of the number
of times you've called C<fork> and C<exec>, to determine
whether the current call to C<exec> should affect the current
! script or a subprocess (see L<perlvms/exec>). Somehow, this count
has become scrambled, so Perl is making a guess and treating
this C<exec> as a request to terminate the Perl script
and execute the specified command.
--- 1427,1433 ----
(S) A warning peculiar to VMS. Perl keeps track of the number
of times you've called C<fork> and C<exec>, to determine
whether the current call to C<exec> should affect the current
! script or a subprocess (see L<perlvms/"exec LIST">). Somehow, this count
has become scrambled, so Perl is making a guess and treating
this C<exec> as a request to terminate the Perl script
and execute the specified command.
***************
*** 1413,1428 ****
(P) Something went badly wrong in the regular expression parser.
! =item internal error: glob failed
! (P) Something went wrong with the external program(s) used for C<glob>
! and C<E<lt>*.cE<gt>>. This may mean that your csh (C shell) is
! broken. If so, you should change all of the csh-related variables in
! config.sh: If you have tcsh, make the variables refer to it as if it
! were csh (e.g. C<full_csh='/usr/bin/tcsh'>); otherwise, make them all
! empty (except that C<d_csh> should be C<'undef'>) so that Perl will
! think csh is missing. In either case, after editing config.sh, run
! C<./Configure -S> and rebuild Perl.
=item internal urp in regexp at /%s/
--- 1436,1454 ----
(P) Something went badly wrong in the regular expression parser.
! =item glob failed (%s)
! (W) Something went wrong with the external program(s) used for C<glob>
! and C<E<lt>*.cE<gt>>. Usually, this means that you supplied a C<glob>
! pattern that caused the external program to fail and exit with a nonzero
! status. If the message indicates that the abnormal exit resulted in a
! coredump, this may also mean that your csh (C shell) is broken. If so,
! you should change all of the csh-related variables in config.sh: If you
! have tcsh, make the variables refer to it as if it were csh (e.g.
! C<full_csh='/usr/bin/tcsh'>); otherwise, make them all empty (except that
! C<d_csh> should be C<'undef'>) so that Perl will think csh is missing.
! In either case, after editing config.sh, run C<./Configure -S> and
! rebuild Perl.
=item internal urp in regexp at /%s/
***************
*** 2322,2333 ****
server can't find it, basically, more or less. Please see the following
for more information:
! http://www.perl.com/perl/faq/idiots-guide.html
! http://www.perl.com/perl/faq/perl-cgi-faq.html
ftp://rtfm.mit.edu/pub/usenet/news.answers/www/cgi-faq
http://hoohoo.ncsa.uiuc.edu/cgi/interface.html
http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
=item setegid() not implemented
(F) You tried to assign to C<$)>, and your operating system doesn't support
--- 2348,2361 ----
server can't find it, basically, more or less. Please see the following
for more information:
! http://www.perl.com/CPAN/doc/FAQs/cgi/idiots-guide.html
! http://www.perl.com/CPAN/doc/FAQs/cgi/perl-cgi-faq.html
ftp://rtfm.mit.edu/pub/usenet/news.answers/www/cgi-faq
http://hoohoo.ncsa.uiuc.edu/cgi/interface.html
http://www-genome.wi.mit.edu/WWW/faqs/www-security-faq.html
+ You should also look at L<perlfaq9>.
+
=item setegid() not implemented
(F) You tried to assign to C<$)>, and your operating system doesn't support
***************
*** 2404,2409 ****
--- 2432,2445 ----
there was a failure. You probably wanted to use system() instead,
which does return. To suppress this warning, put the exec() in a block
by itself.
+
+ =item Strange *+?{} on zero-length expression
+
+ (W) You applied a regular expression quantifier in a place where it
+ makes no sense, such as on a zero-width assertion.
+ Try putting the quantifier inside the assertion instead. For example,
+ the way to match "abc" provided that it is followed by three
+ repetitions of "xyz" is C</abc(?=(?:xyz){3})/>, not C</abc(?=xyz){3}/>.
=item Stub found while resolving method `%s' overloading `%s' in package `%s'
diff -c 'perl5.005_02/pod/perldsc.pod' 'perl5.005_03/pod/perldsc.pod'
Index: ./pod/perldsc.pod
*** ./pod/perldsc.pod Thu Jul 23 23:01:27 1998
--- ./pod/perldsc.pod Sat Mar 27 13:48:25 1999
***************
*** 690,696 ****
print $rec->{TEXT};
! print $rec->{LIST}[0];
$last = pop @ { $rec->{SEQUENCE} };
print $rec->{LOOKUP}{"key"};
--- 690,696 ----
print $rec->{TEXT};
! print $rec->{SEQUENCE}[0];
$last = pop @ { $rec->{SEQUENCE} };
print $rec->{LOOKUP}{"key"};
diff -c 'perl5.005_02/pod/perlembed.pod' 'perl5.005_03/pod/perlembed.pod'
Index: ./pod/perlembed.pod
*** ./pod/perlembed.pod Sun Aug 2 02:09:43 1998
--- ./pod/perlembed.pod Sat Mar 27 13:48:38 1999
***************
*** 141,147 ****
If the B<ExtUtils::Embed> module isn't part of your Perl distribution,
you can retrieve it from
! http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils::Embed. (If
this documentation came from your Perl distribution, then you're
running 5.004 or better and you already have it.)
--- 141,147 ----
If the B<ExtUtils::Embed> module isn't part of your Perl distribution,
you can retrieve it from
! http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils/. (If
this documentation came from your Perl distribution, then you're
running 5.004 or better and you already have it.)
***************
*** 285,290 ****
--- 285,291 ----
main (int argc, char **argv, char **env)
{
+ STRLEN n_a;
char *embedding[] = { "", "-e", "0" };
my_perl = perl_alloc();
***************
*** 303,309 ****
/** Treat $a as a string **/
perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
! printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), PL_na));
perl_destruct(my_perl);
perl_free(my_perl);
--- 304,310 ----
/** Treat $a as a string **/
perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
! printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a));
perl_destruct(my_perl);
perl_free(my_perl);
***************
*** 325,332 ****
from I<perl_eval_pv()> instead. Example:
...
SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE);
! printf("%s\n", SvPV(val,PL_na));
...
This way, we avoid namespace pollution by not creating global
--- 326,334 ----
from I<perl_eval_pv()> instead. Example:
...
+ STRLEN n_a;
SV *val = perl_eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE);
! printf("%s\n", SvPV(val,n_a));
...
This way, we avoid namespace pollution by not creating global
***************
*** 371,376 ****
--- 373,379 ----
{
dSP;
SV* retval;
+ STRLEN n_a;
PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR);
***************
*** 380,386 ****
PUTBACK;
if (croak_on_error && SvTRUE(ERRSV))
! croak(SvPVx(ERRSV, PL_na));
return retval;
}
--- 383,389 ----
PUTBACK;
if (croak_on_error && SvTRUE(ERRSV))
! croak(SvPVx(ERRSV, n_a));
return retval;
}
***************
*** 395,403 ****
I32 match(SV *string, char *pattern)
{
SV *command = NEWSV(1099, 0), *retval;
sv_setpvf(command, "my $string = '%s'; $string =~ %s",
! SvPV(string,PL_na), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
--- 398,407 ----
I32 match(SV *string, char *pattern)
{
SV *command = NEWSV(1099, 0), *retval;
+ STRLEN n_a;
sv_setpvf(command, "my $string = '%s'; $string =~ %s",
! SvPV(string,n_a), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
***************
*** 416,424 ****
I32 substitute(SV **string, char *pattern)
{
SV *command = NEWSV(1099, 0), *retval;
sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
! SvPV(*string,PL_na), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
--- 420,429 ----
I32 substitute(SV **string, char *pattern)
{
SV *command = NEWSV(1099, 0), *retval;
+ STRLEN n_a;
sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
! SvPV(*string,n_a), pattern);
retval = my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
***************
*** 439,447 ****
{
SV *command = NEWSV(1099, 0);
I32 num_matches;
sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
! SvPV(string,PL_na), pattern);
my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
--- 444,453 ----
{
SV *command = NEWSV(1099, 0);
I32 num_matches;
+ STRLEN n_a;
sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
! SvPV(string,n_a), pattern);
my_perl_eval_sv(command, TRUE);
SvREFCNT_dec(command);
***************
*** 459,464 ****
--- 465,471 ----
AV *match_list;
I32 num_matches, i;
SV *text = NEWSV(1099,0);
+ STRLEN n_a;
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
***************
*** 480,486 ****
printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
for (i = 0; i < num_matches; i++)
! printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),PL_na));
printf("\n");
/** Remove all vowels from text **/
--- 487,493 ----
printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
for (i = 0; i < num_matches; i++)
! printf("match: %s\n", SvPV(*av_fetch(match_list, i, FALSE),n_a));
printf("\n");
/** Remove all vowels from text **/
***************
*** 488,494 ****
if (num_matches) {
printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
num_matches);
! printf("Now text is: %s\n\n", SvPV(text,PL_na));
}
/** Attempt a substitution **/
--- 495,501 ----
if (num_matches) {
printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
num_matches);
! printf("Now text is: %s\n\n", SvPV(text,n_a));
}
/** Attempt a substitution **/
***************
*** 726,731 ****
--- 733,739 ----
char *args[] = { "", DO_CLEAN, NULL };
char filename [1024];
int exitstatus = 0;
+ STRLEN n_a;
if((perl = perl_alloc()) == NULL) {
fprintf(stderr, "no memory!");
***************
*** 747,753 ****
/* check $@ */
if(SvTRUE(ERRSV))
! fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,PL_na));
}
}
--- 755,761 ----
/* check $@ */
if(SvTRUE(ERRSV))
! fprintf(stderr, "eval error: %s\n", SvPV(ERRSV,n_a));
}
}
***************
*** 955,961 ****
examples in this documentation, as significant changes were made to
the internal Perl API. However, it is possible to embed ActiveState's
Perl runtime. For details, see the Perl for Win32 FAQ at
! http://www.perl.com/perl/faq/win32/Perl_for_Win32_FAQ.html.
With the "official" Perl version 5.004 or higher, all the examples
within this documentation will compile and run untouched, although
--- 963,969 ----
examples in this documentation, as significant changes were made to
the internal Perl API. However, it is possible to embed ActiveState's
Perl runtime. For details, see the Perl for Win32 FAQ at
! http://www.perl.com/CPAN/doc/FAQs/win32/perlwin32faq.html.
With the "official" Perl version 5.004 or higher, all the examples
within this documentation will compile and run untouched, although
diff -c 'perl5.005_02/pod/perlfaq.pod' 'perl5.005_03/pod/perlfaq.pod'
Index: ./pod/perlfaq.pod
*** ./pod/perlfaq.pod Wed Aug 5 17:02:28 1998
--- ./pod/perlfaq.pod Sat Mar 27 13:50:10 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq - frequently asked questions about Perl ($Date: 1998/08/05 12:09:32 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq - frequently asked questions about Perl ($Date: 1999/01/08 05:54:52 $)
=head1 DESCRIPTION
***************
*** 16,57 ****
--- 16,697 ----
Very general, high-level information about Perl.
+ =over 4
+
+ =item * What is Perl?
+
+ =item * Who supports Perl? Who develops it? Why is it free?
+
+ =item * Which version of Perl should I use?
+
+ =item * What are perl4 and perl5?
+
+ =item * What is perl6?
+
+ =item * How stable is Perl?
+
+ =item * Is Perl difficult to learn?
+
+ =item * How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl?
+
+ =item * Can I do [task] in Perl?
+
+ =item * When shouldn't I program in Perl?
+
+ =item * What's the difference between "perl" and "Perl"?
+
+ =item * Is it a Perl program or a Perl script?
+
+ =item * What is a JAPH?
+
+ =item * Where can I get a list of Larry Wall witticisms?
+
+ =item * How can I convince my sysadmin/supervisor/employees to use version (5/5.005/Perl instead of some other language)?
+
+ =back
+
+
=item L<perlfaq2>: Obtaining and Learning about Perl
Where to find source and documentation to Perl, support,
and related matters.
+ =over 4
+
+ =item * What machines support Perl? Where do I get it?
+
+ =item * How can I get a binary version of Perl?
+
+ =item * I don't have a C compiler on my system. How can I compile perl?
+
+ =item * I copied the Perl binary from one machine to another, but scripts don't work.
+
+ =item * I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work?
+
+ =item * What modules and extensions are available for Perl? What is CPAN? What does CPAN/src/... mean?
+
+ =item * Is there an ISO or ANSI certified version of Perl?
+
+ =item * Where can I get information on Perl?
+
+ =item * What are the Perl newsgroups on USENET? Where do I post questions?
+
+ =item * Where should I post source code?
+
+ =item * Perl Books
+
+ =item * Perl in Magazines
+
+ =item * Perl on the Net: FTP and WWW Access
+
+ =item * What mailing lists are there for perl?
+
+ =item * Archives of comp.lang.perl.misc
+
+ =item * Where can I buy a commercial version of Perl?
+
+ =item * Where do I send bug reports?
+
+ =item * What is perl.com?
+
+ =back
+
+
=item L<perlfaq3>: Programming Tools
Programmer tools and programming support.
+ =over 4
+
+ =item * How do I do (anything)?
+
+ =item * How can I use Perl interactively?
+
+ =item * Is there a Perl shell?
+
+ =item * How do I debug my Perl programs?
+
+ =item * How do I profile my Perl programs?
+
+ =item * How do I cross-reference my Perl programs?
+
+ =item * Is there a pretty-printer (formatter) for Perl?
+
+ =item * Is there a ctags for Perl?
+
+ =item * Is there an IDE or Windows Perl Editor?
+
+ =item * Where can I get Perl macros for vi?
+
+ =item * Where can I get perl-mode for emacs?
+
+ =item * How can I use curses with Perl?
+
+ =item * How can I use X or Tk with Perl?
+
+ =item * How can I generate simple menus without using CGI or Tk?
+
+ =item * What is undump?
+
+ =item * How can I make my Perl program run faster?
+
+ =item * How can I make my Perl program take less memory?
+
+ =item * Is it unsafe to return a pointer to local data?
+
+ =item * How can I free an array or hash so my program shrinks?
+
+ =item * How can I make my CGI script more efficient?
+
+ =item * How can I hide the source for my Perl program?
+
+ =item * How can I compile my Perl program into byte code or C?
+
+ =item * How can I compile Perl into Java?
+
+ =item * How can I get C<#!perl> to work on [MS-DOS,NT,...]?
+
+ =item * Can I write useful perl programs on the command line?
+
+ =item * Why don't perl one-liners work on my DOS/Mac/VMS system?
+
+ =item * Where can I learn about CGI or Web programming in Perl?
+
+ =item * Where can I learn about object-oriented Perl programming?
+
+ =item * Where can I learn about linking C with Perl? [h2xs, xsubpp]
+
+ =item * I've read perlembed, perlguts, etc., but I can't embed perl in
+ my C program, what am I doing wrong?
+
+ =item * When I tried to run my script, I got this message. What does it
+ mean?
+
+ =item * What's MakeMaker?
+
+ =back
+
+
=item L<perlfaq4>: Data Manipulation
Manipulating numbers, dates, strings, arrays, hashes, and
miscellaneous data issues.
+ =over 4
+
+ =item * Why am I getting long decimals (eg, 19.9499999999999) instead of the numbers I should be getting (eg, 19.95)?
+
+ =item * Why isn't my octal data interpreted correctly?
+
+ =item * Does Perl have a round() function? What about ceil() and floor()? Trig functions?
+
+ =item * How do I convert bits into ints?
+
+ =item * Why doesn't & work the way I want it to?
+
+ =item * How do I multiply matrices?
+
+ =item * How do I perform an operation on a series of integers?
+
+ =item * How can I output Roman numerals?
+
+ =item * Why aren't my random numbers random?
+
+ =item * How do I find the week-of-the-year/day-of-the-year?
+
+ =item * How can I compare two dates and find the difference?
+
+ =item * How can I take a string and turn it into epoch seconds?
+
+ =item * How can I find the Julian Day?
+
+ =item * How do I find yesterday's date?
+
+ =item * Does Perl have a year 2000 problem? Is Perl Y2K compliant?
+
+ =item * How do I validate input?
+
+ =item * How do I unescape a string?
+
+ =item * How do I remove consecutive pairs of characters?
+
+ =item * How do I expand function calls in a string?
+
+ =item * How do I find matching/nesting anything?
+
+ =item * How do I reverse a string?
+
+ =item * How do I expand tabs in a string?
+
+ =item * How do I reformat a paragraph?
+
+ =item * How can I access/change the first N letters of a string?
+
+ =item * How do I change the Nth occurrence of something?
+
+ =item * How can I count the number of occurrences of a substring within a string?
+
+ =item * How do I capitalize all the words on one line?
+
+ =item * How can I split a [character] delimited string except when inside
+ [character]? (Comma-separated files)
+
+ =item * How do I strip blank space from the beginning/end of a string?
+
+ =item * How do I pad a string with blanks or pad a number with zeroes?
+
+ =item * How do I extract selected columns from a string?
+
+ =item * How do I find the soundex value of a string?
+
+ =item * How can I expand variables in text strings?
+
+ =item * What's wrong with always quoting "$vars"?
+
+ =item * Why don't my E<lt>E<lt>HERE documents work?
+
+ =item * What is the difference between a list and an array?
+
+ =item * What is the difference between $array[1] and @array[1]?
+
+ =item * How can I extract just the unique elements of an array?
+
+ =item * How can I tell whether a list or array contains a certain element?
+
+ =item * How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
+
+ =item * How do I test whether two arrays or hashes are equal?
+
+ =item * How do I find the first array element for which a condition is true?
+
+ =item * How do I handle linked lists?
+
+ =item * How do I handle circular lists?
+
+ =item * How do I shuffle an array randomly?
+
+ =item * How do I process/modify each element of an array?
+
+ =item * How do I select a random element from an array?
+
+ =item * How do I permute N elements of a list?
+
+ =item * How do I sort an array by (anything)?
+
+ =item * How do I manipulate arrays of bits?
+
+ =item * Why does defined() return true on empty arrays and hashes?
+
+ =item * How do I process an entire hash?
+
+ =item * What happens if I add or remove keys from a hash while iterating over it?
+
+ =item * How do I look up a hash element by value?
+
+ =item * How can I know how many entries are in a hash?
+
+ =item * How do I sort a hash (optionally by value instead of key)?
+
+ =item * How can I always keep my hash sorted?
+
+ =item * What's the difference between "delete" and "undef" with hashes?
+
+ =item * Why don't my tied hashes make the defined/exists distinction?
+
+ =item * How do I reset an each() operation part-way through?
+
+ =item * How can I get the unique keys from two hashes?
+
+ =item * How can I store a multidimensional array in a DBM file?
+
+ =item * How can I make my hash remember the order I put elements into it?
+
+ =item * Why does passing a subroutine an undefined element in a hash create it?
+
+ =item * How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays?
+
+ =item * How can I use a reference as a hash key?
+
+ =item * How do I handle binary data correctly?
+
+ =item * How do I determine whether a scalar is a number/whole/integer/float?
+
+ =item * How do I keep persistent data across program calls?
+
+ =item * How do I print out or copy a recursive data structure?
+
+ =item * How do I define methods for every class/object?
+
+ =item * How do I verify a credit card checksum?
+
+ =item * How do I pack arrays of doubles or floats for XS code?
+
+ =back
+
+
=item L<perlfaq5>: Files and Formats
I/O and the "f" issues: filehandles, flushing, formats and footers.
+ =over 4
+
+ =item * How do I flush/unbuffer an output filehandle? Why must I do this?
+
+ =item * How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file?
+
+ =item * How do I count the number of lines in a file?
+
+ =item * How do I make a temporary file name?
+
+ =item * How can I manipulate fixed-record-length files?
+
+ =item * How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles?
+
+ =item * How can I use a filehandle indirectly?
+
+ =item * How can I set up a footer format to be used with write()?
+
+ =item * How can I write() into a string?
+
+ =item * How can I output my numbers with commas added?
+
+ =item * How can I translate tildes (~) in a filename?
+
+ =item * How come when I open a file read-write it wipes it out?
+
+ =item * Why do I sometimes get an "Argument list too long" when I use E<lt>*E<gt>?
+
+ =item * Is there a leak/bug in glob()?
+
+ =item * How can I open a file with a leading "E<gt>" or trailing blanks?
+
+ =item * How can I reliably rename a file?
+
+ =item * How can I lock a file?
+
+ =item * Why can't I just open(FH, ">file.lock")?
+
+ =item * I still don't get locking. I just want to increment the number in the file. How can I do this?
+
+ =item * How do I randomly update a binary file?
+
+ =item * How do I get a file's timestamp in perl?
+
+ =item * How do I set a file's timestamp in perl?
+
+ =item * How do I print to more than one file at once?
+
+ =item * How can I read in a file by paragraphs?
+
+ =item * How can I read a single character from a file? From the keyboard?
+
+ =item * How can I tell whether there's a character waiting on a filehandle?
+
+ =item * How do I do a C<tail -f> in perl?
+
+ =item * How do I dup() a filehandle in Perl?
+
+ =item * How do I close a file descriptor by number?
+
+ =item * Why can't I use "C:\temp\foo" in DOS paths? What doesn't `C:\temp\foo.exe` work?
+
+ =item * Why doesn't glob("*.*") get all the files?
+
+ =item * Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl?
+
+ =item * How do I select a random line from a file?
+
+ =item * Why do I get weird spaces when I print an array of lines?
+
+ =back
+
+
=item L<perlfaq6>: Regexps
Pattern matching and regular expressions.
+ =over 4
+
+ =item * How can I hope to use regular expressions without creating illegible and unmaintainable code?
+
+ =item * I'm having trouble matching over more than one line. What's wrong?
+
+ =item * How can I pull out lines between two patterns that are themselves on different lines?
+
+ =item * I put a regular expression into $/ but it didn't work. What's wrong?
+
+ =item * How do I substitute case insensitively on the LHS, but preserving case on the RHS?
+
+ =item * How can I make C<\w> match national character sets?
+
+ =item * How can I match a locale-smart version of C</[a-zA-Z]/>?
+
+ =item * How can I quote a variable to use in a regexp?
+
+ =item * What is C</o> really for?
+
+ =item * How do I use a regular expression to strip C style comments from a file?
+
+ =item * Can I use Perl regular expressions to match balanced text?
+
+ =item * What does it mean that regexps are greedy? How can I get around it?
+
+ =item * How do I process each word on each line?
+
+ =item * How can I print out a word-frequency or line-frequency summary?
+
+ =item * How can I do approximate matching?
+
+ =item * How do I efficiently match many regular expressions at once?
+
+ =item * Why don't word-boundary searches with C<\b> work for me?
+
+ =item * Why does using $&, $`, or $' slow my program down?
+
+ =item * What good is C<\G> in a regular expression?
+
+ =item * Are Perl regexps DFAs or NFAs? Are they POSIX compliant?
+
+ =item * What's wrong with using grep or map in a void context?
+
+ =item * How can I match strings with multibyte characters?
+
+ =item * How do I match a pattern that is supplied by the user?
+
+ =back
+
+
=item L<perlfaq7>: General Perl Language Issues
General Perl language issues that don't clearly fit into any of the
other sections.
+ =over 4
+
+ =item * Can I get a BNF/yacc/RE for the Perl language?
+
+ =item * What are all these $@%* punctuation signs, and how do I know when to use them?
+
+ =item * Do I always/never have to quote my strings or use semicolons and commas?
+
+ =item * How do I skip some return values?
+
+ =item * How do I temporarily block warnings?
+
+ =item * What's an extension?
+
+ =item * Why do Perl operators have different precedence than C operators?
+
+ =item * How do I declare/create a structure?
+
+ =item * How do I create a module?
+
+ =item * How do I create a class?
+
+ =item * How can I tell if a variable is tainted?
+
+ =item * What's a closure?
+
+ =item * What is variable suicide and how can I prevent it?
+
+ =item * How can I pass/return a {Function, FileHandle, Array, Hash, Method, Regexp}?
+
+ =item * How do I create a static variable?
+
+ =item * What's the difference between dynamic and lexical (static) scoping? Between local() and my()?
+
+ =item * How can I access a dynamic variable while a similarly named lexical is in scope?
+
+ =item * What's the difference between deep and shallow binding?
+
+ =item * Why doesn't "my($foo) = E<lt>FILEE<gt>;" work right?
+
+ =item * How do I redefine a builtin function, operator, or method?
+
+ =item * What's the difference between calling a function as &foo and foo()?
+
+ =item * How do I create a switch or case statement?
+
+ =item * How can I catch accesses to undefined variables/functions/methods?
+
+ =item * Why can't a method included in this same file be found?
+
+ =item * How can I find out my current package?
+
+ =item * How can I comment out a large block of perl code?
+
+ =item * How do I clear a package?
+
+ =back
+
+
=item L<perlfaq8>: System Interaction
Interprocess communication (IPC), control over the user-interface
(keyboard, screen and pointing devices).
+ =over 4
+
+ =item * How do I find out which operating system I'm running under?
+
+ =item * How come exec() doesn't return?
+
+ =item * How do I do fancy stuff with the keyboard/screen/mouse?
+
+ =item * How do I print something out in color?
+
+ =item * How do I read just one key without waiting for a return key?
+
+ =item * How do I check whether input is ready on the keyboard?
+
+ =item * How do I clear the screen?
+
+ =item * How do I get the screen size?
+
+ =item * How do I ask the user for a password?
+
+ =item * How do I read and write the serial port?
+
+ =item * How do I decode encrypted password files?
+
+ =item * How do I start a process in the background?
+
+ =item * How do I trap control characters/signals?
+
+ =item * How do I modify the shadow password file on a Unix system?
+
+ =item * How do I set the time and date?
+
+ =item * How can I sleep() or alarm() for under a second?
+
+ =item * How can I measure time under a second?
+
+ =item * How can I do an atexit() or setjmp()/longjmp()? (Exception handling)
+
+ =item * Why doesn't my sockets program work under System V (Solaris)? What does the error message "Protocol not supported" mean?
+
+ =item * How can I call my system's unique C functions from Perl?
+
+ =item * Where do I get the include files to do ioctl() or syscall()?
+
+ =item * Why do setuid perl scripts complain about kernel problems?
+
+ =item * How can I open a pipe both to and from a command?
+
+ =item * Why can't I get the output of a command with system()?
+
+ =item * How can I capture STDERR from an external command?
+
+ =item * Why doesn't open() return an error when a pipe open fails?
+
+ =item * What's wrong with using backticks in a void context?
+
+ =item * How can I call backticks without shell processing?
+
+ =item * Why can't my script read from STDIN after I gave it EOF (^D on Unix, ^Z on MS-DOS)?
+
+ =item * How can I convert my shell script to perl?
+
+ =item * Can I use perl to run a telnet or ftp session?
+
+ =item * How can I write expect in Perl?
+
+ =item * Is there a way to hide perl's command line from programs such as "ps"?
+
+ =item * I {changed directory, modified my environment} in a perl script. How come the change disappeared when I exited the script? How do I get my changes to be visible?
+
+ =item * How do I close a process's filehandle without waiting for it to complete?
+
+ =item * How do I fork a daemon process?
+
+ =item * How do I make my program run with sh and csh?
+
+ =item * How do I find out if I'm running interactively or not?
+
+ =item * How do I timeout a slow event?
+
+ =item * How do I set CPU limits?
+
+ =item * How do I avoid zombies on a Unix system?
+
+ =item * How do I use an SQL database?
+
+ =item * How do I make a system() exit on control-C?
+
+ =item * How do I open a file without blocking?
+
+ =item * How do I install a CPAN module?
+
+ =item * What's the difference between require and use?
+
+ =item * How do I keep my own module/library directory?
+
+ =item * How do I add the directory my program lives in to the module/library search path?
+
+ =item * How do I add a directory to my include path at runtime?
+
+ =item * What is socket.ph and where do I get it?
+
+ =back
+
+
=item L<perlfaq9>: Networking
Networking, the Internet, and a few on the web.
+ =over 4
+
+ =item * My CGI script runs from the command line but not the browser. (500 Server Error)
+
+ =item * How can I get better error messages from a CGI program?
+
+ =item * How do I remove HTML from a string?
+
+ =item * How do I extract URLs?
+
+ =item * How do I download a file from the user's machine? How do I open a file on another machine?
+
+ =item * How do I make a pop-up menu in HTML?
+
+ =item * How do I fetch an HTML file?
+
+ =item * How do I automate an HTML form submission?
+
+ =item * How do I decode or create those %-encodings on the web?
+
+ =item * How do I redirect to another page?
+
+ =item * How do I put a password on my web pages?
+
+ =item * How do I edit my .htpasswd and .htgroup files with Perl?
+
+ =item * How do I make sure users can't enter values into a form that cause my CGI script to do bad things?
+
+ =item * How do I parse a mail header?
+
+ =item * How do I decode a CGI form?
+
+ =item * How do I check a valid mail address?
+
+ =item * How do I decode a MIME/BASE64 string?
+
+ =item * How do I return the user's mail address?
+
+ =item * How do I send mail?
+
+ =item * How do I read mail?
+
+ =item * How do I find out my hostname/domainname/IP address?
+
+ =item * How do I fetch a news article or the active newsgroups?
+
+ =item * How do I fetch/put an FTP file?
+
+ =item * How can I do RPC in Perl?
+
+ =back
+
+
=back
=head2 Where to get this document
***************
*** 66,71 ****
--- 706,712 ----
You may mail corrections, additions, and suggestions to
perlfaq-suggestions@perl.com . This alias should not be
used to I<ask> FAQs. It's for fixing the current FAQ.
+ Send questions to the comp.lang.perl.misc newsgroup.
=head2 What will happen if you mail your Perl programming problems to the authors
***************
*** 88,94 ****
=head1 Author and Copyright Information
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
=head2 Bundled Distributions
--- 729,735 ----
=head1 Author and Copyright Information
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
=head2 Bundled Distributions
***************
*** 117,122 ****
--- 758,768 ----
=over 4
+ =item 7/January/99
+
+ Small touchups here and there. Added all questions in this
+ document as a sort of table of contents.
+
=item 22/June/98
Significant changes throughout in preparation for the 5.005
***************
*** 170,172 ****
--- 816,819 ----
have been no changes since its initial release.
=back
+
diff -c 'perl5.005_02/pod/perlfaq1.pod' 'perl5.005_03/pod/perlfaq1.pod'
Index: ./pod/perlfaq1.pod
*** ./pod/perlfaq1.pod Wed Aug 5 17:02:28 1998
--- ./pod/perlfaq1.pod Sat Mar 27 13:51:03 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq1 - General Questions About Perl ($Revision: 1.15 $, $Date: 1998/08/05 11:52:24 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq1 - General Questions About Perl ($Revision: 1.20 $, $Date: 1999/01/08 04:22:09 $)
=head1 DESCRIPTION
***************
*** 32,43 ****
distribution for more details. See L<perlhist> (new as of 5.005)
for Perl's milestone releases.
! In particular, the core development team (known as the Perl
! Porters) are a rag-tag band of highly altruistic individuals
! committed to producing better software for free than you
! could hope to purchase for money. You may snoop on pending
! developments via news://genetics.upenn.edu/perl.porters-gw/ and
! http://www.frii.com/~gnat/perl/porters/summary.html.
While the GNU project includes Perl in its distributions, there's no
such thing as "GNU Perl". Perl is not produced nor maintained by the
--- 32,45 ----
distribution for more details. See L<perlhist> (new as of 5.005)
for Perl's milestone releases.
! In particular, the core development team (known as the Perl Porters)
! are a rag-tag band of highly altruistic individuals committed
! to producing better software for free than you could hope to
! purchase for money. You may snoop on pending developments via
! nntp://news.perl.com/perl.porters-gw/ and the Deja News archive at
! http://www.dejanews.com/ using the perl.porters-gw newsgroup, or you can
! subscribe to the mailing list by sending perl5-porters-request@perl.org
! a subscription request.
While the GNU project includes Perl in its distributions, there's no
such thing as "GNU Perl". Perl is not produced nor maintained by the
***************
*** 51,62 ****
=head2 Which version of Perl should I use?
You should definitely use version 5. Version 4 is old, limited, and
! no longer maintained; its last patch (4.036) was in 1992. The most
! recent production release is 5.005_01. Further references to the Perl
! language in this document refer to this production release unless
! otherwise specified. There may be one or more official bug fixes for
! 5.005_01 by the time you read this, and also perhaps some experimental
! versions on the way to the next release.
=head2 What are perl4 and perl5?
--- 53,68 ----
=head2 Which version of Perl should I use?
You should definitely use version 5. Version 4 is old, limited, and
! no longer maintained; its last patch (4.036) was in 1992, long ago and
! far away. Sure, it's stable, but so is anything that's dead; in fact,
! perl4 had been called a dead, flea-bitten camel carcass. The most recent
! production release is 5.005_02 (although 5.004_04 is still supported).
! The most cutting-edge development release is 5.005_54. Further references
! to the Perl language in this document refer to the production release
! unless otherwise specified. There may be one or more official bug
! fixes for 5.005_02 by the time you read this, and also perhaps some
! experimental versions on the way to the next release. All releases
! prior to 5.004 were subject to buffer overruns, a grave security issue.
=head2 What are perl4 and perl5?
***************
*** 68,78 ****
while perl4 was the fourth major release (March 1991). There was also a
perl1 (in January 1988), a perl2 (June 1988), and a perl3 (October 1989).
! The 5.0 release is, essentially, a complete rewrite of the perl source
! code from the ground up. It has been modularized, object-oriented,
! tweaked, trimmed, and optimized until it almost doesn't look like the
! old code. However, the interface is mostly the same, and compatibility
! with previous releases is very high.
To avoid the "what language is perl5?" confusion, some people prefer to
simply use "perl" to refer to the latest version of perl and avoid using
--- 74,85 ----
while perl4 was the fourth major release (March 1991). There was also a
perl1 (in January 1988), a perl2 (June 1988), and a perl3 (October 1989).
! The 5.0 release is, essentially, a ground-up rewrite of the original
! perl source code from releases 1 through 4. It has been modularized,
! object-oriented, tweaked, trimmed, and optimized until it almost doesn't
! look like the old code. However, the interface is mostly the same, and
! compatibility with previous releases is very high. See L<perltrap/"Perl4
! to Perl5 Traps">.
To avoid the "what language is perl5?" confusion, some people prefer to
simply use "perl" to refer to the latest version of perl and avoid using
***************
*** 80,85 ****
--- 87,113 ----
See L<perlhist> for a history of Perl revisions.
+ =head2 What is perl6?
+
+ Perl6 is a semi-jocular reference to the Topaz project. Headed by Chip
+ Salzenberg, Topaz is yet-another ground-up rewrite of the current release
+ of Perl, one whose major goal is to create a more maintainable core than
+ found in release 5. Written in nominally portable C++, Topaz hopes to
+ maintain 100% source-compatibility with previous releases of Perl but to
+ run significantly faster and smaller. The Topaz team hopes to provide
+ an XS compatibility interface to allow most XS modules to work unchanged,
+ albeit perhaps without the efficiency that the new interface uowld allow.
+ New features in Topaz are as yet undetermined, and will be addressed
+ once compatibility and performance goals are met.
+
+ If you are a hard-working C++ wizard with a firm command of Perl's
+ internals, and you would like to work on the project, send a request to
+ perl6-porters-request@perl.org to subscribe to the Topaz mailing list.
+
+ There is no ETA for Topaz. It is expected to be several years before it
+ achieves enough robustness, compatibility, portability, and performance
+ to replace perl5 for ordinary use by mere mortals.
+
=head2 How stable is Perl?
Production releases, which incorporate bug fixes and new functionality,
***************
*** 106,123 ****
learning curve is therefore shallow (easy to learn) and long (there's
a whole lot you can do if you really want).
! Finally, Perl is (frequently) an interpreted language. This means
! that you can write your programs and test them without an intermediate
! compilation step, allowing you to experiment and test/debug quickly
! and easily. This ease of experimentation flattens the learning curve
! even more.
Things that make Perl easier to learn: Unix experience, almost any kind
of programming experience, an understanding of regular expressions, and
the ability to understand other people's code. If there's something you
need to do, then it's probably already been done, and a working example is
usually available for free. Don't forget the new perl modules, either.
! They're discussed in Part 3 of this FAQ, along with the CPAN, which is
discussed in Part 2.
=head2 How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl?
--- 134,151 ----
learning curve is therefore shallow (easy to learn) and long (there's
a whole lot you can do if you really want).
! Finally, because Perl is frequently (but not always, and certainly not by
! definition) an interpreted language, you can write your programs and test
! them without an intermediate compilation step, allowing you to experiment
! and test/debug quickly and easily. This ease of experimentation flattens
! the learning curve even more.
Things that make Perl easier to learn: Unix experience, almost any kind
of programming experience, an understanding of regular expressions, and
the ability to understand other people's code. If there's something you
need to do, then it's probably already been done, and a working example is
usually available for free. Don't forget the new perl modules, either.
! They're discussed in Part 3 of this FAQ, along with CPAN, which is
discussed in Part 2.
=head2 How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl?
***************
*** 130,151 ****
set of tasks. These languages have their own newsgroups in which you
can learn about (but hopefully not argue about) them.
=head2 Can I do [task] in Perl?
! Perl is flexible and extensible enough for you to use on almost any
! task, from one-line file-processing tasks to complex systems. For
! many people, Perl serves as a great replacement for shell scripting.
! For others, it serves as a convenient, high-level replacement for most
! of what they'd program in low-level languages like C or C++. It's
! ultimately up to you (and possibly your management ...) which tasks
! you'll use Perl for and which you won't.
If you have a library that provides an API, you can make any component
of it available as just another Perl function or variable using a Perl
extension written in C or C++ and dynamically linked into your main
perl interpreter. You can also go the other direction, and write your
main program in C or C++, and then link in some Perl code on the fly,
! to create a powerful application.
That said, there will always be small, focused, special-purpose
languages dedicated to a specific problem domain that are simply more
--- 158,182 ----
set of tasks. These languages have their own newsgroups in which you
can learn about (but hopefully not argue about) them.
+ Some comparison documents can be found at http://language.perl.com/versus/
+ if you really can't stop yourself.
+
=head2 Can I do [task] in Perl?
! Perl is flexible and extensible enough for you to use on virtually any
! task, from one-line file-processing tasks to large, elaborate systems.
! For many people, Perl serves as a great replacement for shell scripting.
! For others, it serves as a convenient, high-level replacement for most of
! what they'd program in low-level languages like C or C++. It's ultimately
! up to you (and possibly your management) which tasks you'll use Perl
! for and which you won't.
If you have a library that provides an API, you can make any component
of it available as just another Perl function or variable using a Perl
extension written in C or C++ and dynamically linked into your main
perl interpreter. You can also go the other direction, and write your
main program in C or C++, and then link in some Perl code on the fly,
! to create a powerful application. See L<perlembed>.
That said, there will always be small, focused, special-purpose
languages dedicated to a specific problem domain that are simply more
***************
*** 164,180 ****
For various reasons, Perl is probably not well-suited for real-time
embedded systems, low-level operating systems development work like
! device drivers or context-switching code, complex multithreaded
shared-memory applications, or extremely large applications. You'll
notice that perl is not itself written in Perl.
! The new native-code compiler for Perl may reduce the limitations given
! in the previous statement to some degree, but understand that Perl
! remains fundamentally a dynamically typed language, and not a
! statically typed one. You certainly won't be chastized if you don't
! trust nuclear-plant or brain-surgery monitoring code to it. And
! Larry will sleep easier, too -- Wall Street programs not
! withstanding. :-)
=head2 What's the difference between "perl" and "Perl"?
--- 195,210 ----
For various reasons, Perl is probably not well-suited for real-time
embedded systems, low-level operating systems development work like
! device drivers or context-switching code, complex multi-threaded
shared-memory applications, or extremely large applications. You'll
notice that perl is not itself written in Perl.
! The new, native-code compiler for Perl may eventually reduce the
! limitations given in the previous statement to some degree, but understand
! that Perl remains fundamentally a dynamically typed language, not
! a statically typed one. You certainly won't be chastised if you don't
! trust nuclear-plant or brain-surgery monitoring code to it. And Larry
! will sleep easier, too -- Wall Street programs not withstanding. :-)
=head2 What's the difference between "perl" and "Perl"?
***************
*** 183,215 ****
i.e. the current interpreter. Hence Tom's quip that "Nothing but perl
can parse Perl." You may or may not choose to follow this usage. For
example, parallelism means "awk and perl" and "Python and Perl" look
! ok, while "awk and Perl" and "Python and perl" do not.
=head2 Is it a Perl program or a Perl script?
! It doesn't matter.
! In "standard terminology" a I<program> has been compiled to physical
! machine code once, and can then be be run multiple times, whereas a
! I<script> must be translated by a program each time it's used. Perl
! programs, however, are usually neither strictly compiled nor strictly
! interpreted. They can be compiled to a byte code form (something of a
Perl virtual machine) or to completely different languages, like C or
! assembly language. You can't tell just by looking whether the source
! is destined for a pure interpreter, a parse-tree interpreter, a byte
! code interpreter, or a native-code compiler, so it's hard to give a
! definitive answer here.
=head2 What is a JAPH?
These are the "just another perl hacker" signatures that some people
! sign their postings with. About 100 of the of the earlier ones are
! available from http://www.perl.com/CPAN/misc/japh .
=head2 Where can I get a list of Larry Wall witticisms?
Over a hundred quips by Larry, from postings of his or source code,
! can be found at http://www.perl.com/CPAN/misc/lwall-quotes .
=head2 How can I convince my sysadmin/supervisor/employees to use version (5/5.005/Perl instead of some other language)?
--- 213,270 ----
i.e. the current interpreter. Hence Tom's quip that "Nothing but perl
can parse Perl." You may or may not choose to follow this usage. For
example, parallelism means "awk and perl" and "Python and Perl" look
! ok, while "awk and Perl" and "Python and perl" do not. But never
! write "PERL", because perl isn't really an acronym, aprocryphal
! folklore and post-facto expansions notwithstanding.
=head2 Is it a Perl program or a Perl script?
! Larry doesn't really care. He says (half in jest) that "a script is
! what you give the actors. A program is what you give the audience."
!
! Originally, a script was a canned sequence of normally interactive
! commands, that is, a chat script. Something like a uucp or ppp chat
! script or an expect script fits the bill nicely, as do configuration
! scripts run by a program at its start up, such F<.cshrc> or F<.ircrc>,
! for example. Chat scripts were just drivers for existing programs,
! not stand-alone programs in their own right.
!
! A computer scientist will correctly explain that all programs are
! interpreted, and that the only question is at what level. But if you
! ask this question of someone who isn't a computer scientist, they might
! tell you that a I<program> has been compiled to physical machine code
! once, and can then be run multiple times, whereas a I<script> must be
! translated by a program each time it's used.
! Perl programs are (usually) neither strictly compiled nor strictly
! interpreted. They can be compiled to a byte-code form (something of a
Perl virtual machine) or to completely different languages, like C or
! assembly language. You can't tell just by looking at it whether the
! source is destined for a pure interpreter, a parse-tree interpreter,
! a byte-code interpreter, or a native-code compiler, so it's hard to give
! a definitive answer here.
!
! Now that "script" and "scripting" are terms that have been seized by
! unscrupulous or unknowing marketeers for their own nefarious purposes,
! they have begun to take on strange and often pejorative meanings,
! like "non serious" or "not real programming". Consequently, some perl
! programmers prefer to avoid them altogether.
=head2 What is a JAPH?
These are the "just another perl hacker" signatures that some people
! sign their postings with. Randal Schwartz made these famous. About
! 100 of the earlier ones are available from
! http://www.perl.com/CPAN/misc/japh .
=head2 Where can I get a list of Larry Wall witticisms?
Over a hundred quips by Larry, from postings of his or source code,
! can be found at http://www.perl.com/CPAN/misc/lwall-quotes.txt.gz .
!
! Newer examples can be found by perusing Larry's postings:
!
! http://x1.dejanews.com/dnquery.xp?QRY=*&DBS=2&ST=PS&defaultOp=AND&LNG=ALL&format=terse&showsort=date&maxhits=100&subjects=&groups=&authors=larry@*wall.org&fromdate=&todate=
=head2 How can I convince my sysadmin/supervisor/employees to use version (5/5.005/Perl instead of some other language)?
***************
*** 232,263 ****
just a news-posting away, if you can't find the answer in the
I<comprehensive> documentation, including this FAQ.
If you face reluctance to upgrading from an older version of perl,
then point out that version 4 is utterly unmaintained and unsupported
by the Perl Development Team. Another big sell for Perl5 is the large
number of modules and extensions which greatly reduce development time
for any given task. Also mention that the difference between version
4 and version 5 of Perl is like the difference between awk and C++.
! (Well, ok, maybe not quite that distinct, but you get the idea.) If
! you want support and a reasonable guarantee that what you're
! developing will continue to work in the future, then you have to run
! the supported version. That probably means running the 5.005 release,
! although 5.004 isn't that bad (it's just one year and one release
! behind). Several important bugs were fixed from the 5.000 through
5.003 versions, though, so try upgrading past them if possible.
Of particular note is the massive bughunt for buffer overflow
problems that went into the 5.004 release. All releases prior to
that, including perl4, are considered insecure and should be upgraded
! as soon as possible.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this works is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
--- 287,319 ----
just a news-posting away, if you can't find the answer in the
I<comprehensive> documentation, including this FAQ.
+ See http://www.perl.org/advocacy/ for more information.
+
If you face reluctance to upgrading from an older version of perl,
then point out that version 4 is utterly unmaintained and unsupported
by the Perl Development Team. Another big sell for Perl5 is the large
number of modules and extensions which greatly reduce development time
for any given task. Also mention that the difference between version
4 and version 5 of Perl is like the difference between awk and C++.
! (Well, ok, maybe not quite that distinct, but you get the idea.) If you
! want support and a reasonable guarantee that what you're developing
! will continue to work in the future, then you have to run the supported
! version. That probably means running the 5.005 release, although 5.004
! isn't that bad. Several important bugs were fixed from the 5.000 through
5.003 versions, though, so try upgrading past them if possible.
Of particular note is the massive bughunt for buffer overflow
problems that went into the 5.004 release. All releases prior to
that, including perl4, are considered insecure and should be upgraded
! as soon as possible.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this work is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
***************
*** 266,268 ****
--- 322,325 ----
derivatives thereof in your own programs for fun or for profit as you
see fit. A simple comment in the code giving credit to the FAQ would
be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq2.pod' 'perl5.005_03/pod/perlfaq2.pod'
Index: ./pod/perlfaq2.pod
*** ./pod/perlfaq2.pod Wed Aug 5 17:02:28 1998
--- ./pod/perlfaq2.pod Sat Mar 27 13:51:47 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.25 $, $Date: 1998/08/05 11:47:25 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.30 $, $Date: 1998/12/29 19:43:32 $)
=head1 DESCRIPTION
***************
*** 12,18 ****
The standard release of Perl (the one maintained by the perl
development team) is distributed only in source code form. You
! can find this at http://www.perl.com/CPAN/src/latest.tar.gz, which
in standard Internet format (a gzipped archive in POSIX tar format).
Perl builds and runs on a bewildering number of platforms. Virtually
--- 12,18 ----
The standard release of Perl (the one maintained by the perl
development team) is distributed only in source code form. You
! can find this at http://www.perl.com/CPAN/src/latest.tar.gz , which
in standard Internet format (a gzipped archive in POSIX tar format).
Perl builds and runs on a bewildering number of platforms. Virtually
***************
*** 22,28 ****
for MPE/iX.
Binary distributions for some proprietary platforms, including
! Apple systems can be found http://www.perl.com/CPAN/ports/ directory.
Because these are not part of the standard distribution, they may
and in fact do differ from the base Perl port in a variety of ways.
You'll have to check their respective release notes to see just
--- 22,28 ----
for MPE/iX.
Binary distributions for some proprietary platforms, including
! Apple systems, can be found http://www.perl.com/CPAN/ports/ directory.
Because these are not part of the standard distribution, they may
and in fact do differ from the base Perl port in a variety of ways.
You'll have to check their respective release notes to see just
***************
*** 31,52 ****
are not supported in the source release of perl) or negative (e.g.
might be based upon a less current source release of perl).
- A useful FAQ for Win32 Perl users is
- http://www.endcontsw.com/people/evangelo/Perl_for_Win32_FAQ.html
-
=head2 How can I get a binary version of Perl?
! If you don't have a C compiler because for whatever reasons your
! vendor did not include one with your system, the best thing to do is
grab a binary version of gcc from the net and use that to compile perl
with. CPAN only has binaries for systems that are terribly hard to
get free compilers for, not for Unix systems.
! Your first stop should be http://www.perl.com/CPAN/ports to see what
! information is already available. A simple installation guide for
! MS-DOS is available at http://www.cs.ruu.nl/~piet/perl5dos.html , and
! similarly for Windows 3.1 at http://www.cs.ruu.nl/~piet/perlwin3.html
! .
=head2 I don't have a C compiler on my system. How can I compile perl?
--- 31,53 ----
are not supported in the source release of perl) or negative (e.g.
might be based upon a less current source release of perl).
=head2 How can I get a binary version of Perl?
! If you don't have a C compiler because your vendor for whatever
! reasons did not include one with your system, the best thing to do is
grab a binary version of gcc from the net and use that to compile perl
with. CPAN only has binaries for systems that are terribly hard to
get free compilers for, not for Unix systems.
! Some URLs that might help you are:
!
! http://language.perl.com/info/software.html
! http://www.perl.com/latest/
! http://www.perl.com/CPAN/ports/
!
! If you want information on proprietary systems. A simple installation
! guide for MS-DOS is available at http://www.cs.ruu.nl/~piet/perl5dos.html
! and similarly for Windows 3.1 at http://www.cs.ruu.nl/~piet/perlwin3.html .
=head2 I don't have a C compiler on my system. How can I compile perl?
***************
*** 67,77 ****
One simple way to check that things are in the right place is to print out
the hard-coded @INC which perl is looking for.
! perl -e 'print join("\n",@INC)'
If this command lists any paths which don't exist on your system, then you
may need to move the appropriate libraries to these locations, or create
! symlinks, aliases, or shortcuts appropriately.
You might also want to check out L<perlfaq8/"How do I keep my own
module/library directory?">.
--- 68,81 ----
One simple way to check that things are in the right place is to print out
the hard-coded @INC which perl is looking for.
! % perl -e 'print join("\n",@INC)'
If this command lists any paths which don't exist on your system, then you
may need to move the appropriate libraries to these locations, or create
! symlinks, aliases, or shortcuts appropriately. @INC is also printed as
! part of the output of
!
! % perl -V
You might also want to check out L<perlfaq8/"How do I keep my own
module/library directory?">.
***************
*** 79,85 ****
=head2 I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work?
Read the F<INSTALL> file, which is part of the source distribution.
! It describes in detail how to cope with most idiosyncracies that the
Configure script can't work around for any given system or
architecture.
--- 83,89 ----
=head2 I grabbed the sources and tried to compile but gdbm/dynamic loading/malloc/linking/... failed. How do I make it work?
Read the F<INSTALL> file, which is part of the source distribution.
! It describes in detail how to cope with most idiosyncrasies that the
Configure script can't work around for any given system or
architecture.
***************
*** 141,146 ****
--- 145,160 ----
Many good books have been written about Perl -- see the section below
for more details.
+ Tutorial documents are included in current or upcoming Perl releases
+ include L<perltoot> for objects, L<perlopentut> for file opening
+ semantics, L<perlreftut> for managing references, and L<perlxstut>
+ for linking C and Perl together. There may be more by the
+ time you read this. The following URLs might also be of
+ assistance:
+
+ http://language.perl.com/info/documentation.html
+ http://reference.perl.com/query.cgi?tutorials
+
=head2 What are the Perl newsgroups on USENET? Where do I post questions?
The now defunct comp.lang.perl newsgroup has been superseded by the
***************
*** 154,173 ****
comp.infosystems.www.authoring.cgi Writing CGI scripts for the Web.
- Actually, the moderated group hasn't passed yet, but we're
- keeping our fingers crossed.
-
There is also USENET gateway to the mailing list used by the crack
Perl development team (perl5-porters) at
news://news.perl.com/perl.porters-gw/ .
=head2 Where should I post source code?
! You should post source code to whichever group is most appropriate,
! but feel free to cross-post to comp.lang.perl.misc. If you want to
! cross-post to alt.sources, please make sure it follows their posting
! standards, including setting the Followup-To header line to NOT
! include alt.sources; see their FAQ for details.
If you're just looking for software, first use Alta Vista, Deja News, and
search CPAN. This is faster and more productive than just posting
--- 168,184 ----
comp.infosystems.www.authoring.cgi Writing CGI scripts for the Web.
There is also USENET gateway to the mailing list used by the crack
Perl development team (perl5-porters) at
news://news.perl.com/perl.porters-gw/ .
=head2 Where should I post source code?
! You should post source code to whichever group is most appropriate, but
! feel free to cross-post to comp.lang.perl.misc. If you want to cross-post
! to alt.sources, please make sure it follows their posting standards,
! including setting the Followup-To header line to NOT include alt.sources;
! see their FAQ (http://www.faqs.org/faqs/alt-sources-intro/) for details.
If you're just looking for software, first use Alta Vista, Deja News, and
search CPAN. This is faster and more productive than just posting
***************
*** 184,190 ****
the creator of Perl, is now in its second edition:
Programming Perl (the "Camel Book"):
! Authors: Larry Wall, Tom Christiansen, and Randal Schwartz
ISBN 1-56592-149-6 (English)
ISBN 4-89052-384-7 (Japanese)
URL: http://www.oreilly.com/catalog/pperl2/
--- 195,201 ----
the creator of Perl, is now in its second edition:
Programming Perl (the "Camel Book"):
! by Larry Wall, Tom Christiansen, and Randal Schwartz
ISBN 1-56592-149-6 (English)
ISBN 4-89052-384-7 (Japanese)
URL: http://www.oreilly.com/catalog/pperl2/
***************
*** 196,202 ****
(first premiering at the 1998 Perl Conference), is:
The Perl Cookbook (the "Ram Book"):
! Authors: Tom Christiansen and Nathan Torkington,
with Foreword by Larry Wall
ISBN: 1-56592-243-3
URL: http://perl.oreilly.com/cookbook/
--- 207,213 ----
(first premiering at the 1998 Perl Conference), is:
The Perl Cookbook (the "Ram Book"):
! by Tom Christiansen and Nathan Torkington,
with Foreword by Larry Wall
ISBN: 1-56592-243-3
URL: http://perl.oreilly.com/cookbook/
***************
*** 206,212 ****
out:
Learning Perl (the "Llama Book"):
! Authors: Randal Schwartz and Tom Christiansen
with Foreword by Larry Wall
ISBN: 1-56592-284-0
URL: http://www.oreilly.com/catalog/lperl2/
--- 217,223 ----
out:
Learning Perl (the "Llama Book"):
! by Randal Schwartz and Tom Christiansen
with Foreword by Larry Wall
ISBN: 1-56592-284-0
URL: http://www.oreilly.com/catalog/lperl2/
***************
*** 230,236 ****
What follows is a list of the books that the FAQ authors found personally
useful. Your mileage may (but, we hope, probably won't) vary.
! Recommended books on (or muchly on) Perl follow; those marked with
a star may be ordered from O'Reilly.
=over
--- 241,247 ----
What follows is a list of the books that the FAQ authors found personally
useful. Your mileage may (but, we hope, probably won't) vary.
! Recommended books on (or mostly on) Perl follow; those marked with
a star may be ordered from O'Reilly.
=over
***************
*** 262,268 ****
MacPerl: Power and Ease
by Vicki Brown and Chris Nandor, foreword by Matthias Neeracher
! =item Task-Oriented
*The Perl Cookbook
by Tom Christiansen and Nathan Torkington
--- 273,279 ----
MacPerl: Power and Ease
by Vicki Brown and Chris Nandor, foreword by Matthias Neeracher
! =item Task-Oriented
*The Perl Cookbook
by Tom Christiansen and Nathan Torkington
***************
*** 296,302 ****
expressions, and networking, and sponsors the Obfuscated Perl
Contest. It is published quarterly under the gentle hand of its
editor, Jon Orwant. See http://www.tpj.com/ or send mail to
! subscriptions@tpj.com.
Beyond this, magazines that frequently carry high-quality articles
on Perl are I<Web Techniques> (see http://www.webtechniques.com/),
--- 307,313 ----
expressions, and networking, and sponsors the Obfuscated Perl
Contest. It is published quarterly under the gentle hand of its
editor, Jon Orwant. See http://www.tpj.com/ or send mail to
! subscriptions@tpj.com .
Beyond this, magazines that frequently carry high-quality articles
on Perl are I<Web Techniques> (see http://www.webtechniques.com/),
***************
*** 309,318 ****
To get the best (and possibly cheapest) performance, pick a site from
the list below and use it to grab the complete list of mirror sites.
! From there you can find the quickest site for you. Remember, the
following list is I<not> the complete list of CPAN mirrors.
! http://www.perl.com/CPAN (redirects to another mirror)
http://www.perl.org/CPAN
ftp://ftp.funet.fi/pub/languages/perl/CPAN/
http://www.cs.ruu.nl/pub/PERL/CPAN/
--- 320,330 ----
To get the best (and possibly cheapest) performance, pick a site from
the list below and use it to grab the complete list of mirror sites.
! >From there you can find the quickest site for you. Remember, the
following list is I<not> the complete list of CPAN mirrors.
! http://www.perl.com/CPAN-local
! http://www.perl.com/CPAN (redirects to an ftp mirror)
http://www.perl.org/CPAN
ftp://ftp.funet.fi/pub/languages/perl/CPAN/
http://www.cs.ruu.nl/pub/PERL/CPAN/
***************
*** 322,390 ****
Most of the major modules (tk, CGI, libwww-perl) have their own
mailing lists. Consult the documentation that came with the module for
! subscription information. The following are a list of mailing lists
! related to perl itself.
!
! If you subscribe to a mailing list, it behooves you to know how to
! unsubscribe from it. Strident pleas to the list itself to get you off
! will not be favorably received.
!
! =over 4
!
! =item MacPerl
!
! There is a mailing list for discussing Macintosh Perl. Contact
! "mac-perl-request@iis.ee.ethz.ch".
!
! Also see Matthias Neeracher's (the creator and maintainer of MacPerl)
! webpage at http://www.iis.ee.ethz.ch/~neeri/macintosh/perl.html for
! many links to interesting MacPerl sites, and the applications/MPW
! tools, precompiled.
!
! =item Perl5-Porters
!
! The core development team have a mailing list for discussing fixes and
! changes to the language. Send mail to
! "perl5-porters-request@perl.org" with help in the body of the message
! for information on subscribing.
! =item NTPerl
! This list is used to discuss issues involving Win32 Perl 5 (Windows NT
! and Win95). Subscribe by mailing ListManager@ActiveWare.com with the
! message body:
!
! subscribe Perl-Win32-Users
!
! The list software, also written in perl, will automatically determine
! your address, and subscribe you automatically. To unsubscribe, mail
! the following in the message body to the same address like so:
!
! unsubscribe Perl-Win32-Users
!
! You can also check http://www.activeware.com/ and select "Mailing Lists"
! to join or leave this list.
!
! =item Perl-Packrats
!
! Discussion related to archiving of perl materials, particularly the
! Comprehensive Perl Archive Network (CPAN). Subscribe by emailing
! majordomo@cis.ufl.edu:
!
! subscribe perl-packrats
!
! The list software, also written in perl, will automatically determine
! your address, and subscribe you automatically. To unsubscribe, simple
! prepend the same command with an "un", and mail to the same address
! like so:
!
! unsubscribe perl-packrats
! =back
! =head2 Archives of comp.lang.perl.misc
! Have you tried Deja News or Alta Vista?
ftp.cis.ufl.edu:/pub/perl/comp.lang.perl.*/monthly has an almost
complete collection dating back to 12/89 (missing 08/91 through
--- 334,352 ----
Most of the major modules (tk, CGI, libwww-perl) have their own
mailing lists. Consult the documentation that came with the module for
! subscription information. The Perl Institute attempts to maintain a
! list of mailing lists at:
! http://www.perl.org/maillist.html
! =head2 Archives of comp.lang.perl.misc
! Have you tried Deja News or Alta Vista? Those are the
! best archives. Just look up "*perl*" as a newsgroup.
! http://www.dejanews.com/dnquery.xp?QRY=&DBS=2&ST=PS&defaultOp=AND&LNG=ALL&format=terse&showsort=date&maxhits=25&subjects=&groups=*perl*&authors=&fromdate=&todate=
! You'll probably want to trim that down a bit, though.
ftp.cis.ufl.edu:/pub/perl/comp.lang.perl.*/monthly has an almost
complete collection dating back to 12/89 (missing 08/91 through
***************
*** 402,422 ****
=head2 Where can I buy a commercial version of Perl?
! In a sense, Perl already I<is> commercial software: It has a licence
! that you can grab and carefully read to your manager. It is
! distributed in releases and comes in well-defined packages. There is a
! very large user community and an extensive literature. The
! comp.lang.perl.* newsgroups and several of the mailing lists provide
! free answers to your questions in near real-time. Perl has
! traditionally been supported by Larry, dozens of software designers
! and developers, and thousands of programmers, all working for free
! to create a useful thing to make life better for everyone.
However, these answers may not suffice for managers who require a
! purchase order from a company whom they can sue should anything go
! wrong. Or maybe they need very serious hand-holding and contractual
! obligations. Shrink-wrapped CDs with perl on them are available from
! several sources if that will help.
Or you can purchase a real support contract. Although Cygnus historically
provided this service, they no longer sell support contracts for Perl.
--- 364,387 ----
=head2 Where can I buy a commercial version of Perl?
! In a real sense, Perl already I<is> commercial software: It has a licence
! that you can grab and carefully read to your manager. It is distributed
! in releases and comes in well-defined packages. There is a very large
! user community and an extensive literature. The comp.lang.perl.*
! newsgroups and several of the mailing lists provide free answers to your
! questions in near real-time. Perl has traditionally been supported by
! Larry, scores of software designers and developers, and myriads of
! programmers, all working for free to create a useful thing to make life
! better for everyone.
However, these answers may not suffice for managers who require a
! purchase order from a company whom they can sue should anything go awry.
! Or maybe they need very serious hand-holding and contractual obligations.
! Shrink-wrapped CDs with perl on them are available from several sources if
! that will help. For example, many perl books carry a perl distribution
! on them, as do the O'Reily Perl Resource Kits (in both the Unix flavor
! and in the proprietary Microsoft flavor); the free Unix distributions
! also all come with Perl.
Or you can purchase a real support contract. Although Cygnus historically
provided this service, they no longer sell support contracts for Perl.
***************
*** 438,457 ****
of Oracle Web Server 3). 20% of the profit from our Perl support work
will be donated to The Perl Institute."
! For more information, contact the The Perl Clinic:
Tel: +44 1483 424424
Fax: +44 1483 419419
Web: http://www.perl.co.uk/
Email: perl-support-info@perl.co.uk or Tim.Bunce@ig.co.uk
! See also www.perl.com for updates on training and support.
=head2 Where do I send bug reports?
If you are reporting a bug in the perl interpreter or the modules
shipped with perl, use the I<perlbug> program in the perl distribution or
! mail your report to perlbug@perl.com.
If you are posting a bug with a non-standard port (see the answer to
"What platforms is Perl available for?"), a binary distribution, or a
--- 403,422 ----
of Oracle Web Server 3). 20% of the profit from our Perl support work
will be donated to The Perl Institute."
! For more information, contact The Perl Clinic:
Tel: +44 1483 424424
Fax: +44 1483 419419
Web: http://www.perl.co.uk/
Email: perl-support-info@perl.co.uk or Tim.Bunce@ig.co.uk
! See also www.perl.com for updates on tutorials, training, and support.
=head2 Where do I send bug reports?
If you are reporting a bug in the perl interpreter or the modules
shipped with perl, use the I<perlbug> program in the perl distribution or
! mail your report to perlbug@perl.com .
If you are posting a bug with a non-standard port (see the answer to
"What platforms is Perl available for?"), a binary distribution, or a
***************
*** 461,494 ****
Read the perlbug(1) man page (perl5.004 or later) for more information.
! =head2 What is perl.com? perl.org? The Perl Institute?
! The perl.com domain is managed by Tom Christiansen, who created it as a
public service long before perl.org came about. Despite the name, it's a
pretty non-commercial site meant to be a clearinghouse for information
about all things Perlian, accepting no paid advertisements, bouncy
happy gifs, or silly java applets on its pages. The Perl Home Page at
http://www.perl.com/ is currently hosted on a T3 line courtesy of Songline
Systems, a software-oriented subsidiary of O'Reilly and Associates.
! perl.org is the official vehicle for The Perl Institute. The motto of
! TPI is "helping people help Perl help people" (or something like
! that). It's a non-profit organization supporting development,
! documentation, and dissemination of perl.
!
! =head2 How do I learn about object-oriented Perl programming?
!
! L<perltoot> (distributed with 5.004 or later) is a good place to start.
! Also, L<perlobj>, L<perlref>, and L<perlmod> are useful references,
! while L<perlbot> has some excellent tips and tricks.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this works is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
--- 426,453 ----
Read the perlbug(1) man page (perl5.004 or later) for more information.
! =head2 What is perl.com?
! The perl.com domain is owned by Tom Christiansen, who created it as a
public service long before perl.org came about. Despite the name, it's a
pretty non-commercial site meant to be a clearinghouse for information
about all things Perlian, accepting no paid advertisements, bouncy
happy gifs, or silly java applets on its pages. The Perl Home Page at
http://www.perl.com/ is currently hosted on a T3 line courtesy of Songline
Systems, a software-oriented subsidiary of O'Reilly and Associates.
+ Other starting points include
! http://language.perl.com/
! http://conference.perl.com/
! http://reference.perl.com/
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this work is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
***************
*** 497,499 ****
--- 456,459 ----
derivatives thereof in your own programs for fun or for profit as you
see fit. A simple comment in the code giving credit to the FAQ would
be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq3.pod' 'perl5.005_03/pod/perlfaq3.pod'
Index: ./pod/perlfaq3.pod
*** ./pod/perlfaq3.pod Wed Aug 5 17:02:28 1998
--- ./pod/perlfaq3.pod Sat Mar 27 13:52:51 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq3 - Programming Tools ($Revision: 1.29 $, $Date: 1998/08/05 11:57:04 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq3 - Programming Tools ($Revision: 1.33 $, $Date: 1998/12/29 20:12:12 $)
=head1 DESCRIPTION
***************
*** 102,107 ****
--- 102,111 ----
for: 4 secs ( 3.97 usr 0.01 sys = 3.98 cpu)
map: 6 secs ( 4.97 usr 0.00 sys = 4.97 cpu)
+ Be aware that a good benchmark is very hard to write. It only tests the
+ data you give it, and really proves little about differing complexities
+ of contrasting algorithms.
+
=head2 How do I cross-reference my Perl programs?
The B::Xref module, shipped with the new, alpha-release Perl compiler
***************
*** 122,144 ****
write it will help prevent bugs. Your editor can and should help you
with this. The perl-mode for emacs can provide a remarkable amount of
help with most (but not all) code, and even less programmable editors
! can provide significant assistance.
! If you are used to using I<vgrind> program for printing out nice code
to a laser printer, you can take a stab at this using
http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the
results are not particularly satisfying for sophisticated code.
! =head2 Is there a ctags for Perl?
! There's a simple one at
http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do
! the trick.
=head2 Where can I get Perl macros for vi?
For a complete version of Tom Christiansen's vi configuration file,
! see http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/toms.exrc,
the standard benchmark file for vi emulators. This runs best with nvi,
the current version of vi out of Berkeley, which incidentally can be built
with an embedded Perl interpreter -- see http://www.perl.com/CPAN/src/misc.
--- 126,182 ----
write it will help prevent bugs. Your editor can and should help you
with this. The perl-mode for emacs can provide a remarkable amount of
help with most (but not all) code, and even less programmable editors
! can provide significant assistance. Tom swears by the following
! settings in vi and its clones:
!
! set ai sw=4
! map ^O {^M}^[O^T
!
! Now put that in your F<.exrc> file (replacing the caret characters
! with control characters) and away you go. In insert mode, ^T is
! for indenting, ^D is for undenting, and ^O is for blockdenting --
! as it were. If you haven't used the last one, you're missing
! a lot. A more complete example, with comments, can be found at
! http://www.perl.com/CPAN-local/authors/id/TOMC/scripts/toms.exrc.gz
! If you are used to using the I<vgrind> program for printing out nice code
to a laser printer, you can take a stab at this using
http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the
results are not particularly satisfying for sophisticated code.
! The a2ps at http://www.infres.enst.fr/~demaille/a2ps/ does lots of things
! related to generating nicely printed output of documents.
! =head2 Is there a etags/ctags for perl?
!
! With respect to the source code for the Perl interpreter, yes.
! There has been support for etags in the source for a long time.
! Ctags was introduced in v5.005_54 (and probably 5.005_03).
! After building perl, type 'make etags' or 'make ctags' and both
! sets of tag files will be built.
!
! Now, if you're looking to build a tag file for perl code, then there's
! a simple one at
http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do
! the trick. And if not, it's easy to hack into what you want.
!
! =head2 Is there an IDE or Windows Perl Editor?
!
! If you're on Unix, you already have an IDE -- Unix itself.
! You just have to learn the toolbox. If you're not, then you
! probably don't have a toolbox, so may need something else.
!
! PerlBuilder (XXX URL to follow) is an integrated development
! environment for Windows that supports Perl development. Perl programs
! are just plain text, though, so you could download emacs for Windows
! (XXX) or vim for win32 (http://www.cs.vu.nl/~tmgil/vi.html). If
! you're transferring Windows files to Unix, be sure to transfer in
! ASCII mode so the ends of lines are appropriately converted.
=head2 Where can I get Perl macros for vi?
For a complete version of Tom Christiansen's vi configuration file,
! see http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/toms.exrc.gz,
the standard benchmark file for vi emulators. This runs best with nvi,
the current version of vi out of Berkeley, which incidentally can be built
with an embedded Perl interpreter -- see http://www.perl.com/CPAN/src/misc.
***************
*** 155,161 ****
Note that the perl-mode of emacs will have fits with C<"main'foo">
(single quote), and mess up the indentation and hilighting. You
! should be using C<"main::foo"> in new Perl code anyway, so this
shouldn't be an issue.
=head2 How can I use curses with Perl?
--- 193,199 ----
Note that the perl-mode of emacs will have fits with C<"main'foo">
(single quote), and mess up the indentation and hilighting. You
! are probably using C<"main::foo"> in new Perl code anyway, so this
shouldn't be an issue.
=head2 How can I use curses with Perl?
***************
*** 236,242 ****
When it comes to time-space tradeoffs, Perl nearly always prefers to
throw memory at a problem. Scalars in Perl use more memory than
! strings in C, arrays take more that, and hashes use even more. While
there's still a lot to be done, recent releases have been addressing
these issues. For example, as of 5.004, duplicate hash keys are
shared amongst all hashes using them, so require no reallocation.
--- 274,280 ----
When it comes to time-space tradeoffs, Perl nearly always prefers to
throw memory at a problem. Scalars in Perl use more memory than
! strings in C, arrays take more than that, and hashes use even more. While
there's still a lot to be done, recent releases have been addressing
these issues. For example, as of 5.004, duplicate hash keys are
shared amongst all hashes using them, so require no reallocation.
***************
*** 278,287 ****
You can't. On most operating systems, memory allocated to a program
can never be returned to the system. That's why long-running programs
! sometimes re-exec themselves. Some operating systems (notably, FreeBSD)
! allegedly reclaim large chunks of memory that is no longer used, but
! it doesn't appear to happen with Perl (yet). The Mac appears to be the
! only platform that will reliably (albeit, slowly) return memory to the OS.
However, judicious use of my() on your variables will help make sure
that they go out of scope so that Perl can free up their storage for
--- 316,330 ----
You can't. On most operating systems, memory allocated to a program
can never be returned to the system. That's why long-running programs
! sometimes re-exec themselves. Some operating systems (notably,
! FreeBSD and Linux) allegedly reclaim large chunks of memory that is no
! longer used, but it doesn't appear to happen with Perl (yet). The Mac
! appears to be the only platform that will reliably (albeit, slowly)
! return memory to the OS.
!
! We've had reports that on Linux (Redhat 5.1) on Intel, C<undef
! $scalar> will return memory to the system, while on Solaris 2.6 it
! won't. In general, try it yourself and see.
However, judicious use of my() on your variables will help make sure
that they go out of scope so that Perl can free up their storage for
***************
*** 314,321 ****
anything a module written in C can. For more on mod_perl, see
http://perl.apache.org/
! With the FCGI module (from CPAN), a Perl executable compiled with sfio
! (see the F<INSTALL> file in the distribution) and the mod_fastcgi
module (available from http://www.fastcgi.com/) each of your perl
scripts becomes a permanent CGI daemon process.
--- 357,363 ----
anything a module written in C can. For more on mod_perl, see
http://perl.apache.org/
! With the FCGI module (from CPAN) and the mod_fastcgi
module (available from http://www.fastcgi.com/) each of your perl
scripts becomes a permanent CGI daemon process.
***************
*** 325,332 ****
See http://www.perl.com/CPAN/modules/by-category/15_World_Wide_Web_HTML_HTTP_CGI/ .
! A non-free, commerical product, ``The Velocity Engine for Perl'',
! (http://www.binevolve.com/ or http://www.binevolve.com/bine/vep) might
also be worth looking at. It will allow you to increase the performance
of your perl scripts, upto 25 times faster than normal CGI perl by
running in persistent perl mode, or 4 to 5 times faster without any
--- 367,374 ----
See http://www.perl.com/CPAN/modules/by-category/15_World_Wide_Web_HTML_HTTP_CGI/ .
! A non-free, commercial product, ``The Velocity Engine for Perl'',
! (http://www.binevolve.com/ or
also be worth looking at. It will allow you to increase the performance
of your perl scripts, upto 25 times faster than normal CGI perl by
running in persistent perl mode, or 4 to 5 times faster without any
***************
*** 353,364 ****
instead of fixing them, is little security indeed.
You can try using encryption via source filters (Filter::* from CPAN),
! but crackers might be able to decrypt it. You can try using the byte
! code compiler and interpreter described below, but crackers might be
! able to de-compile it. You can try using the native-code compiler
! described below, but crackers might be able to disassemble it. These
! pose varying degrees of difficulty to people wanting to get at your
! code, but none can definitively conceal it (this is true of every
language, not just Perl).
If you're concerned about people profiting from your code, then the
--- 395,406 ----
instead of fixing them, is little security indeed.
You can try using encryption via source filters (Filter::* from CPAN),
! but any decent programmer will be able to decrypt it. You can try using
! the byte code compiler and interpreter described below, but the curious
! might still be able to de-compile it. You can try using the native-code
! compiler described below, but crackers might be able to disassemble it.
! These pose varying degrees of difficulty to people wanting to get at
! your code, but none can definitively conceal it (this is true of every
language, not just Perl).
If you're concerned about people profiting from your code, then the
***************
*** 407,412 ****
--- 449,462 ----
you use a shared I<libperl.so>), you'll probably want a complete
Perl install anyway.
+ =head2 How can I compile Perl into Java?
+
+ You can't. Not yet, anyway. You can integrate Java and Perl with the
+ Perl Resource Kit from O'Reilly and Associates. See
+ http://www.oreilly.com/catalog/prkunix/ for more information.
+ The Java interface will be supported in the core 5.006 release
+ of Perl.
+
=head2 How can I get C<#!perl> to work on [MS-DOS,NT,...]?
For OS/2 just use
***************
*** 420,431 ****
The Win95/NT installation, when using the ActiveState port of Perl,
will modify the Registry to associate the C<.pl> extension with the
! perl interpreter. If you install another port (Gurusaramy Sarathy's
! is the recommended Win95/NT port), or (eventually) build your own
! Win95/NT Perl using WinGCC, then you'll have to modify the Registry
! yourself.
! Macintosh perl scripts will have the the appropriate Creator and
Type, so that double-clicking them will invoke the perl application.
I<IMPORTANT!>: Whatever you do, PLEASE don't get frustrated, and just
--- 470,484 ----
The Win95/NT installation, when using the ActiveState port of Perl,
will modify the Registry to associate the C<.pl> extension with the
! perl interpreter. If you install another port (Gurusamy Sarathy's is
! the recommended Win95/NT port), or (eventually) build your own
! Win95/NT Perl using a Windows port of gcc (e.g., with cygwin32 or
! mingw32), then you'll have to modify the Registry yourself. In
! addition to associating C<.pl> with the interpreter, NT people can
! use: C<SET PATHEXT=%PATHEXT%;.PL> to let them run the program
! C<install-linux.pl> merely by typing C<install-linux>.
! Macintosh perl scripts will have the appropriate Creator and
Type, so that double-clicking them will invoke the perl application.
I<IMPORTANT!>: Whatever you do, PLEASE don't get frustrated, and just
***************
*** 494,499 ****
--- 547,555 ----
quoting variants, except that it makes free use of the Mac's non-ASCII
characters as control characters.
+ Using qq(), q(), and qx(), instead of "double quotes", 'single
+ quotes', and `backticks`, may make one-liners easier to write.
+
There is no general solution to all of this. It is a mess, pure and
simple. Sucks to be away from Unix, huh? :-)
***************
*** 514,520 ****
http://www.boutell.com/faq/
CGI FAQ
! http://www.webthing.com/page.cgi/cgifaq
HTTP Spec
http://www.w3.org/pub/WWW/Protocols/HTTP/
--- 570,576 ----
http://www.boutell.com/faq/
CGI FAQ
! http://www.webthing.com/tutorials/cgifaq.html
HTTP Spec
http://www.w3.org/pub/WWW/Protocols/HTTP/
***************
*** 529,534 ****
--- 585,591 ----
CGI Security FAQ
http://www.go2net.com/people/paulp/cgi-security/safe-cgi.txt
+ Also take a look at L<perlfaq9>
=head2 Where can I learn about object-oriented Perl programming?
***************
*** 580,590 ****
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this works is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
--- 637,647 ----
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this work is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
***************
*** 593,595 ****
--- 650,653 ----
derivatives thereof in your own programs for fun or for profit as you
see fit. A simple comment in the code giving credit to the FAQ would
be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq4.pod' 'perl5.005_03/pod/perlfaq4.pod'
Index: ./pod/perlfaq4.pod
*** ./pod/perlfaq4.pod Wed Aug 5 17:02:28 1998
--- ./pod/perlfaq4.pod Sat Mar 27 13:54:21 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq4 - Data Manipulation ($Revision: 1.26 $, $Date: 1998/08/05 12:04:00 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq4 - Data Manipulation ($Revision: 1.40 $, $Date: 1999/01/08 04:26:39 $)
=head1 DESCRIPTION
***************
*** 41,47 ****
To get rid of the superfluous digits, just use a format (eg,
C<printf("%.2f", 19.95)>) to get the required precision.
! See L<perlop/"Floating-point Arithmetic">.
=head2 Why isn't my octal data interpreted correctly?
--- 41,47 ----
To get rid of the superfluous digits, just use a format (eg,
C<printf("%.2f", 19.95)>) to get the required precision.
! See L<perlop/"Floating-point Arithmetic">.
=head2 Why isn't my octal data interpreted correctly?
***************
*** 59,65 ****
chmod(644, $file); # WRONG -- perl -w catches this
chmod(0644, $file); # right
! =head2 Does perl have a round function? What about ceil() and floor()? Trig functions?
Remember that int() merely truncates toward 0. For rounding to a
certain number of digits, sprintf() or printf() is usually the easiest
--- 59,65 ----
chmod(644, $file); # WRONG -- perl -w catches this
chmod(0644, $file); # right
! =head2 Does Perl have a round() function? What about ceil() and floor()? Trig functions?
Remember that int() merely truncates toward 0. For rounding to a
certain number of digits, sprintf() or printf() is usually the easiest
***************
*** 88,93 ****
--- 88,106 ----
being used by Perl, but to instead implement the rounding function you
need yourself.
+ To see why, notice how you'll still have an issue on half-way-point
+ alternation:
+
+ for ($i = 0; $i < 1.01; $i += 0.05) { printf "%.1f ",$i}
+
+ 0.0 0.1 0.1 0.2 0.2 0.2 0.3 0.3 0.4 0.4 0.5 0.5 0.6 0.7 0.7
+ 0.8 0.8 0.9 0.9 1.0 1.0
+
+ Don't blame Perl. It's the same as in C. IEEE says we have to do this.
+ Perl numbers whose absolute values are integers under 2**31 (on 32 bit
+ machines) will work pretty much like mathematical integers. Other numbers
+ are not guaranteed.
+
=head2 How do I convert bits into ints?
To turn a string of 1s and 0s like C<10110110> into a scalar containing
***************
*** 100,105 ****
--- 113,145 ----
$binary_string = join('', unpack('B*', "\x29"));
+ =head2 Why doesn't & work the way I want it to?
+
+ The behavior of binary arithmetic operators depends on whether they're
+ used on numbers or strings. The operators treat a string as a series
+ of bits and work with that (the string C<"3"> is the bit pattern
+ C<00110011>). The operators work with the binary form of a number
+ (the number C<3> is treated as the bit pattern C<00000011>).
+
+ So, saying C<11 & 3> performs the "and" operation on numbers (yielding
+ C<1>). Saying C<"11" & "3"> performs the "and" operation on strings
+ (yielding C<"1">).
+
+ Most problems with C<&> and C<|> arise because the programmer thinks
+ they have a number but really it's a string. The rest arise because
+ the programmer says:
+
+ if ("\020\020" & "\101\101") {
+ # ...
+ }
+
+ but a string consisting of two null bytes (the result of C<"\020\020"
+ & "\101\101">) is not a false value in Perl. You need:
+
+ if ( ("\020\020" & "\101\101") !~ /[^\000]/) {
+ # ...
+ }
+
=head2 How do I multiply matrices?
Use the Math::Matrix or Math::MatrixReal modules (available from CPAN)
***************
*** 120,131 ****
results:
foreach $iterator (@array) {
! &my_func($iterator);
}
To call a function on each integer in a (small) range, you B<can> use:
! @results = map { &my_func($_) } (5 .. 25);
but you should be aware that the C<..> operator creates an array of
all integers in the range. This can take a lot of memory for large
--- 160,171 ----
results:
foreach $iterator (@array) {
! some_func($iterator);
}
To call a function on each integer in a (small) range, you B<can> use:
! @results = map { some_func($_) } (5 .. 25);
but you should be aware that the C<..> operator creates an array of
all integers in the range. This can take a lot of memory for large
***************
*** 133,139 ****
@results = ();
for ($i=5; $i < 500_005; $i++) {
! push(@results, &my_func($i));
}
=head2 How can I output Roman numerals?
--- 173,179 ----
@results = ();
for ($i=5; $i < 500_005; $i++) {
! push(@results, some_func($i));
}
=head2 How can I output Roman numerals?
***************
*** 142,161 ****
=head2 Why aren't my random numbers random?
! The short explanation is that you're getting pseudorandom numbers, not
! random ones, because computers are good at being predictable and bad
! at being random (despite appearances caused by bugs in your programs
! :-). A longer explanation is available on
http://www.perl.com/CPAN/doc/FMTEYEWTK/random, courtesy of Tom
! Phoenix. John von Neumann said, ``Anyone who attempts to generate
! random numbers by deterministic means is, of course, living in a state
! of sin.''
!
! You should also check out the Math::TrulyRandom module from CPAN. It
! uses the imperfections in your system's timer to generate random
! numbers, but this takes quite a while. If you want a better
pseudorandom generator than comes with your operating system, look at
! ``Numerical Recipes in C'' at http://nr.harvard.edu/nr/bookc.html .
=head1 Data: Dates
--- 182,206 ----
=head2 Why aren't my random numbers random?
! If you're using a version of Perl before 5.004, you must call C<srand>
! once at the start of your program to seed the random number generator.
! 5.004 and later automatically call C<srand> at the beginning. Don't
! call C<srand> more than once--you make your numbers less random, rather
! than more.
!
! Computers are good at being predictable and bad at being random
! (despite appearances caused by bugs in your programs :-).
http://www.perl.com/CPAN/doc/FMTEYEWTK/random, courtesy of Tom
! Phoenix, talks more about this.. John von Neumann said, ``Anyone who
! attempts to generate random numbers by deterministic means is, of
! course, living in a state of sin.''
!
! If you want numbers that are more random than C<rand> with C<srand>
! provides, you should also check out the Math::TrulyRandom module from
! CPAN. It uses the imperfections in your system's timer to generate
! random numbers, but this takes quite a while. If you want a better
pseudorandom generator than comes with your operating system, look at
! ``Numerical Recipes in C'' at http://www.nr.com/ .
=head1 Data: Dates
***************
*** 178,187 ****
Of course, this believes that weeks start at zero. The Date::Calc
module from CPAN has a lot of date calculation functions, including
day of the year, week of the year, and so on. Note that not
! all business consider ``week 1'' to be the same; for example,
! American business often consider the first week with a Monday
! in it to be Work Week #1, despite ISO 8601, which consider
! WW1 to be the frist week with a Thursday in it.
=head2 How can I compare two dates and find the difference?
--- 223,232 ----
Of course, this believes that weeks start at zero. The Date::Calc
module from CPAN has a lot of date calculation functions, including
day of the year, week of the year, and so on. Note that not
! all businesses consider ``week 1'' to be the same; for example,
! American businesses often consider the first week with a Monday
! in it to be Work Week #1, despite ISO 8601, which considers
! WW1 to be the first week with a Thursday in it.
=head2 How can I compare two dates and find the difference?
***************
*** 201,223 ****
Neither Date::Manip nor Date::Calc deal with Julian days. Instead,
there is an example of Julian date calculation that should help you in
! http://www.perl.com/CPAN/authors/David_Muir_Sharnoff/modules/Time/JulianDay.pm.gz
! .
=head2 Does Perl have a year 2000 problem? Is Perl Y2K compliant?
! Short answer: No, Perl does not have a Year 2000 problem. Yes,
! Perl is Y2K compliant. The programmers you're hired to use it,
! however, probably are not.
!
! Long answer: Perl is just as Y2K compliant as your pencil--no more,
! and no less. The date and time functions supplied with perl (gmtime
! and localtime) supply adequate information to determine the year well
! beyond 2000 (2038 is when trouble strikes for 32-bit machines). The
! year returned by these functions when used in an array context is the
! year minus 1900. For years between 1910 and 1999 this I<happens> to
! be a 2-digit decimal number. To avoid the year 2000 problem simply do
! not treat the year as a 2-digit number. It isn't.
When gmtime() and localtime() are used in scalar context they return
a timestamp string that contains a fully-expanded year. For example,
--- 246,283 ----
Neither Date::Manip nor Date::Calc deal with Julian days. Instead,
there is an example of Julian date calculation that should help you in
! Time::JulianDay (part of the Time-modules bundle) which can be found at
! http://www.perl.com/CPAN/modules/by-module/Time/.
!
!
! =head2 How do I find yesterday's date?
!
! The C<time()> function returns the current time in seconds since the
! epoch. Take one day off that:
!
! $yesterday = time() - ( 24 * 60 * 60 );
!
! Then you can pass this to C<localtime()> and get the individual year,
! month, day, hour, minute, seconds values.
=head2 Does Perl have a year 2000 problem? Is Perl Y2K compliant?
! Short answer: No, Perl does not have a Year 2000 problem. Yes, Perl is
! Y2K compliant (whatever that means). The programmers you've hired to
! use it, however, probably are not.
!
! Long answer: The question belies a true understanding of the issue.
! Perl is just as Y2K compliant as your pencil--no more, and no less.
! Can you use your pencil to write a non-Y2K-compliant memo? Of course
! you can. Is that the pencil's fault? Of course it isn't.
!
! The date and time functions supplied with perl (gmtime and localtime)
! supply adequate information to determine the year well beyond 2000
! (2038 is when trouble strikes for 32-bit machines). The year returned
! by these functions when used in an array context is the year minus 1900.
! For years between 1910 and 1999 this I<happens> to be a 2-digit decimal
! number. To avoid the year 2000 problem simply do not treat the year as
! a 2-digit number. It isn't.
When gmtime() and localtime() are used in scalar context they return
a timestamp string that contains a fully-expanded year. For example,
***************
*** 286,293 ****
If you are serious about writing a parser, there are a number of
modules or oddities that will make your life a lot easier. There is
the CPAN module Parse::RecDescent, the standard module Text::Balanced,
! the byacc program, and Mark-Jason Dominus's excellent I<py> tool at
! http://www.plover.com/~mjd/perl/py/ .
One simple destructive, inside-out approach that you might try is to
pull out the smallest nesting parts one at a time:
--- 346,354 ----
If you are serious about writing a parser, there are a number of
modules or oddities that will make your life a lot easier. There is
the CPAN module Parse::RecDescent, the standard module Text::Balanced,
! the byacc program, the CPAN module Parse::Yapp, and Mark-Jason
! Dominus's excellent I<py> tool at http://www.plover.com/~mjd/perl/py/
! .
One simple destructive, inside-out approach that you might try is to
pull out the smallest nesting parts one at a time:
***************
*** 296,301 ****
--- 357,377 ----
# do something with $1
}
+ A more complicated and sneaky approach is to make Perl's regular
+ expression engine do it for you. This is courtesy Dean Inada, and
+ rather has the nature of an Obfuscated Perl Contest entry, but it
+ really does work:
+
+ # $_ contains the string to parse
+ # BEGIN and END are the opening and closing markers for the
+ # nested text.
+
+ @( = ('(','');
+ @) = (')','');
+ ($re=$_)=~s/((BEGIN)|(END)|.)/$)[!$3]\Q$1\E$([!$2]/gs;
+ @$ = (eval{/$re/},$@!~/unmatched/);
+ print join("\n",@$[0..$#$]) if( $$[-1] );
+
=head2 How do I reverse a string?
Use reverse() in scalar context, as documented in
***************
*** 378,384 ****
count of a certain single character (X) within a string, you can use the
C<tr///> function like so:
! $string = "ThisXlineXhasXsomeXx'sXinXit":
$count = ($string =~ tr/X//);
print "There are $count X charcters in the string";
--- 454,460 ----
count of a certain single character (X) within a string, you can use the
C<tr///> function like so:
! $string = "ThisXlineXhasXsomeXx'sXinXit";
$count = ($string =~ tr/X//);
print "There are $count X charcters in the string";
***************
*** 422,427 ****
--- 498,508 ----
characters by placing a C<use locale> pragma in your program.
See L<perllocale> for endless details on locales.
+ This is sometimes referred to as putting something into "title
+ case", but that's not quite accurate. Consdier the proper
+ capitalization of the movie I<Dr. Strangelove or: How I Learned to
+ Stop Worrying and Love the Bomb>, for example.
+
=head2 How can I split a [character] delimited string except when inside
[character]? (Comma-separated files)
***************
*** 457,469 ****
use Text::ParseWords;
@new = quotewords(",", 0, $text);
=head2 How do I strip blank space from the beginning/end of a string?
Although the simplest approach would seem to be:
$string =~ s/^\s*(.*?)\s*$/$1/;
! This is unneccesarily slow, destructive, and fails with embedded newlines.
It is much better faster to do this in two steps:
$string =~ s/^\s+//;
--- 538,552 ----
use Text::ParseWords;
@new = quotewords(",", 0, $text);
+ There's also a Text::CSV module on CPAN.
+
=head2 How do I strip blank space from the beginning/end of a string?
Although the simplest approach would seem to be:
$string =~ s/^\s*(.*?)\s*$/$1/;
! This is unnecessarily slow, destructive, and fails with embedded newlines.
It is much better faster to do this in two steps:
$string =~ s/^\s+//;
***************
*** 488,493 ****
--- 571,614 ----
s/\s+$//;
}
+ =head2 How do I pad a string with blanks or pad a number with zeroes?
+
+ (This answer contributed by Uri Guttman)
+
+ In the following examples, C<$pad_len> is the length to which you wish
+ to pad the string, C<$text> or C<$num> contains the string to be
+ padded, and C<$pad_char> contains the padding character. You can use a
+ single character string constant instead of the C<$pad_char> variable
+ if you know what it is in advance.
+
+ The simplest method use the C<sprintf> function. It can pad on the
+ left or right with blanks and on the left with zeroes.
+
+ # Left padding with blank:
+ $padded = sprintf( "%${pad_len}s", $text ) ;
+
+ # Right padding with blank:
+ $padded = sprintf( "%${pad_len}s", $text ) ;
+
+ # Left padding with 0:
+ $padded = sprintf( "%0${pad_len}d", $num ) ;
+
+ If you need to pad with a character other than blank or zero you can use
+ one of the following methods.
+
+ These methods generate a pad string with the C<x> operator and
+ concatenate that with the original text.
+
+ Left and right padding with any character:
+
+ $padded = $pad_char x ( $pad_len - length( $text ) ) . $text ;
+ $padded = $text . $pad_char x ( $pad_len - length( $text ) ) ;
+
+ Or you can left or right pad $text directly:
+
+ $text .= $pad_char x ( $pad_len - length( $text ) ) ;
+ substr( $text, 0, 0 ) = $pad_char x ( $pad_len - length( $text ) ) ;
+
=head2 How do I extract selected columns from a string?
Use substr() or unpack(), both documented in L<perlfunc>.
***************
*** 523,535 ****
If those were both global variables, then this would
suffice:
! $text =~ s/\$(\w+)/${$1}/g;
But since they are probably lexicals, or at least, they could
be, you'd have to do this:
$text =~ s/(\$\w+)/$1/eeg;
! die if $@; # needed on /ee, not /e
It's probably better in the general case to treat those
variables as entries in some special hash. For example:
--- 644,656 ----
If those were both global variables, then this would
suffice:
! $text =~ s/\$(\w+)/${$1}/g; # no /e needed
But since they are probably lexicals, or at least, they could
be, you'd have to do this:
$text =~ s/(\$\w+)/$1/eeg;
! die if $@; # needed /ee, not /e
It's probably better in the general case to treat those
variables as entries in some special hash. For example:
***************
*** 547,553 ****
The problem is that those double-quotes force stringification,
coercing numbers and references into strings, even when you
! don't want them to be.
If you get used to writing odd things like these:
--- 668,676 ----
The problem is that those double-quotes force stringification,
coercing numbers and references into strings, even when you
! don't want them to be. Think of it this way: double-quote
! expansion is used to produce new strings. If you already
! have a string, why do you need more?
If you get used to writing odd things like these:
***************
*** 583,589 ****
print "@lines"; # WRONG - extra blanks
print @lines; # right
! =head2 Why don't my <<HERE documents work?
Check for these three things:
--- 706,712 ----
print "@lines"; # WRONG - extra blanks
print @lines; # right
! =head2 Why don't my E<lt>E<lt>HERE documents work?
Check for these three things:
***************
*** 665,670 ****
--- 788,814 ----
=head1 Data: Arrays
+ =head2 What is the difference between a list and an array?
+
+ An array has a changeable length. A list does not. An array is something
+ you can push or pop, while a list is a set of values. Some people make
+ the distinction that a list is a value while an array is a variable.
+ Subroutines are passed and return lists, you put things into list
+ context, you initialize arrays with lists, and you foreach() across
+ a list. C<@> variables are arrays, anonymous arrays are arrays, arrays
+ in scalar context behave like the number of elements in them, subroutines
+ access their arguments through the array C<@_>, push/pop/shift only work
+ on arrays.
+
+ As a side note, there's no such thing as a list in scalar context.
+ When you say
+
+ $scalar = (2, 5, 7, 9);
+
+ you're using the comma operator in scalar context, so it evaluates the
+ left hand side, then evaluates and returns the left hand side. This
+ causes the last value to be returned: 9.
+
=head2 What is the difference between $array[1] and @array[1]?
The former is a scalar value, the latter an array slice, which makes
***************
*** 724,729 ****
--- 868,875 ----
=back
+ But perhaps you should have been using a hash all along, eh?
+
=head2 How can I tell whether a list or array contains a certain element?
Hearing the word "in" is an I<in>dication that you probably should have
***************
*** 770,776 ****
These are slow (checks every element even if the first matches),
inefficient (same reason), and potentially buggy (what if there are
! regexp characters in $whatever?).
=head2 How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
--- 916,932 ----
These are slow (checks every element even if the first matches),
inefficient (same reason), and potentially buggy (what if there are
! regexp characters in $whatever?). If you're only testing once, then
! use:
!
! $is_there = 0;
! foreach $elt (@array) {
! if ($elt eq $elt_to_find) {
! $is_there = 1;
! last;
! }
! }
! if ($is_there) { ... }
=head2 How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
***************
*** 785,795 ****
push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
}
=head2 How do I find the first array element for which a condition is true?
You can use this if you care about the index:
! for ($i=0; $i < @array; $i++) {
if ($array[$i] eq "Waldo") {
$found_index = $i;
last;
--- 941,1000 ----
push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
}
+ =head2 How do I test whether two arrays or hashes are equal?
+
+ The following code works for single-level arrays. It uses a stringwise
+ comparison, and does not distinguish defined versus undefined empty
+ strings. Modify if you have other needs.
+
+ $are_equal = compare_arrays(\@frogs, \@toads);
+
+ sub compare_arrays {
+ my ($first, $second) = @_;
+ local $^W = 0; # silence spurious -w undef complaints
+ return 0 unless @$first == @$second;
+ for (my $i = 0; $i < @$first; $i++) {
+ return 0 if $first->[$i] ne $second->[$i];
+ }
+ return 1;
+ }
+
+ For multilevel structures, you may wish to use an approach more
+ like this one. It uses the CPAN module FreezeThaw:
+
+ use FreezeThaw qw(cmpStr);
+ @a = @b = ( "this", "that", [ "more", "stuff" ] );
+
+ printf "a and b contain %s arrays\n",
+ cmpStr(\@a, \@b) == 0
+ ? "the same"
+ : "different";
+
+ This approach also works for comparing hashes. Here
+ we'll demonstrate two different answers:
+
+ use FreezeThaw qw(cmpStr cmpStrHard);
+
+ %a = %b = ( "this" => "that", "extra" => [ "more", "stuff" ] );
+ $a{EXTRA} = \%b;
+ $b{EXTRA} = \%a;
+
+ printf "a and b contain %s hashes\n",
+ cmpStr(\%a, \%b) == 0 ? "the same" : "different";
+
+ printf "a and b contain %s hashes\n",
+ cmpStrHard(\%a, \%b) == 0 ? "the same" : "different";
+
+
+ The first reports that both those the hashes contain the same data,
+ while the second reports that they do not. Which you prefer is left as
+ an exercise to the reader.
+
=head2 How do I find the first array element for which a condition is true?
You can use this if you care about the index:
! for ($i= 0; $i < @array; $i++) {
if ($array[$i] eq "Waldo") {
$found_index = $i;
last;
***************
*** 810,816 ****
If you really, really wanted, you could use structures as described in
L<perldsc> or L<perltoot> and do just what the algorithm book tells you
! to do.
=head2 How do I handle circular lists?
--- 1015,1056 ----
If you really, really wanted, you could use structures as described in
L<perldsc> or L<perltoot> and do just what the algorithm book tells you
! to do. For example, imagine a list node like this:
!
! $node = {
! VALUE => 42,
! LINK => undef,
! };
!
! You could walk the list this way:
!
! print "List: ";
! for ($node = $head; $node; $node = $node->{LINK}) {
! print $node->{VALUE}, " ";
! }
! print "\n";
!
! You could grow the list this way:
!
! my ($head, $tail);
! $tail = append($head, 1); # grow a new head
! for $value ( 2 .. 10 ) {
! $tail = append($tail, $value);
! }
!
! sub append {
! my($list, $value) = @_;
! my $node = { VALUE => $value };
! if ($list) {
! $node->{LINK} = $list->{LINK};
! $list->{LINK} = $node;
! } else {
! $_[0] = $node; # replace caller's version
! }
! return $node;
! }
!
! But again, Perl's built-in are virtually always good enough.
=head2 How do I handle circular lists?
***************
*** 1006,1014 ****
This method gets faster the more sparse the bit vector is.
(Courtesy of Tim Bunce and Winfried Koenig.)
=head2 Why does defined() return true on empty arrays and hashes?
! See L<perlfunc/defined> in the 5.004 release or later of Perl.
=head1 Data: Hashes (Associative Arrays)
--- 1246,1299 ----
This method gets faster the more sparse the bit vector is.
(Courtesy of Tim Bunce and Winfried Koenig.)
+ Here's a demo on how to use vec():
+
+ # vec demo
+ $vector = "\xff\x0f\xef\xfe";
+ print "Ilya's string \\xff\\x0f\\xef\\xfe represents the number ",
+ unpack("N", $vector), "\n";
+ $is_set = vec($vector, 23, 1);
+ print "Its 23rd bit is ", $is_set ? "set" : "clear", ".\n";
+ pvec($vector);
+
+ set_vec(1,1,1);
+ set_vec(3,1,1);
+ set_vec(23,1,1);
+
+ set_vec(3,1,3);
+ set_vec(3,2,3);
+ set_vec(3,4,3);
+ set_vec(3,4,7);
+ set_vec(3,8,3);
+ set_vec(3,8,7);
+
+ set_vec(0,32,17);
+ set_vec(1,32,17);
+
+ sub set_vec {
+ my ($offset, $width, $value) = @_;
+ my $vector = '';
+ vec($vector, $offset, $width) = $value;
+ print "offset=$offset width=$width value=$value\n";
+ pvec($vector);
+ }
+
+ sub pvec {
+ my $vector = shift;
+ my $bits = unpack("b*", $vector);
+ my $i = 0;
+ my $BASE = 8;
+
+ print "vector length in bytes: ", length($vector), "\n";
+ @bytes = unpack("A8" x length($vector), $bits);
+ print "bits are: @bytes\n\n";
+ }
+
=head2 Why does defined() return true on empty arrays and hashes?
! The short story is that you should probably only use defined on scalars or
! functions, not on aggregates (arrays and hashes). See L<perlfunc/defined>
! in the 5.004 release or later of Perl for more detail.
=head1 Data: Hashes (Associative Arrays)
***************
*** 1243,1251 ****
=head2 How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays?
! Use references (documented in L<perlref>). Examples of complex data
! structures are given in L<perldsc> and L<perllol>. Examples of
! structures and object-oriented classes are in L<perltoot>.
=head2 How can I use a reference as a hash key?
--- 1528,1548 ----
=head2 How can I make the Perl equivalent of a C structure/C++ class/hash or array of hashes or arrays?
! Usually a hash ref, perhaps like this:
!
! $record = {
! NAME => "Jason",
! EMPNO => 132,
! TITLE => "deputy peon",
! AGE => 23,
! SALARY => 37_000,
! PALS => [ "Norbert", "Rhys", "Phineas"],
! };
!
! References are documented in L<perlref> and the upcoming L<perlreftut>.
! Examples of complex data structures are given in L<perldsc> and
! L<perllol>. Examples of structures and object-oriented classes are
! in L<perltoot>.
=head2 How can I use a reference as a hash key?
***************
*** 1263,1270 ****
print "Your kernel is GNU-zip enabled!\n";
}
! On some systems, however, you have to play tedious games with "text"
! versus "binary" files. See L<perlfunc/"binmode">.
If you're concerned about 8-bit ASCII data, then see L<perllocale>.
--- 1560,1568 ----
print "Your kernel is GNU-zip enabled!\n";
}
! On some legacy systems, however, you have to play tedious games with
! "text" versus "binary" files. See L<perlfunc/"binmode">, or the upcoming
! L<perlopentut> manpage.
If you're concerned about 8-bit ASCII data, then see L<perllocale>.
***************
*** 1276,1289 ****
Assuming that you don't care about IEEE notations like "NaN" or
"Infinity", you probably just want to use a regular expression.
! warn "has nondigits" if /\D/;
! warn "not a natural number" unless /^\d+$/; # rejects -3
! warn "not an integer" unless /^-?\d+$/; # rejects +3
! warn "not an integer" unless /^[+-]?\d+$/;
! warn "not a decimal number" unless /^-?\d+\.?\d*$/; # rejects .2
! warn "not a decimal number" unless /^-?(?:\d+(?:\.\d*)?|\.\d+)$/;
! warn "not a C float"
! unless /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
If you're on a POSIX system, Perl's supports the C<POSIX::strtod>
function. Its semantics are somewhat cumbersome, so here's a C<getnum>
--- 1574,1587 ----
Assuming that you don't care about IEEE notations like "NaN" or
"Infinity", you probably just want to use a regular expression.
! if (/\D/) { print "has nondigits\n" }
! if (/^\d+$/) { print "is a whole number\n" }
! if (/^-?\d+$/) { print "is an integer\n" }
! if (/^[+-]?\d+$/) { print "is a +/- integer\n" }
! if (/^-?\d+\.?\d*$/) { print "is a real number\n" }
! if (/^-?(?:\d+(?:\.\d*)?|\.\d+)$/) { print "is a decimal number" }
! if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)
! { print "a C float" }
If you're on a POSIX system, Perl's supports the C<POSIX::strtod>
function. Its semantics are somewhat cumbersome, so here's a C<getnum>
***************
*** 1308,1335 ****
sub is_numeric { defined &getnum }
! Or you could check out
! http://www.perl.com/CPAN/modules/by-module/String/String-Scanf-1.1.tar.gz
! instead. The POSIX module (part of the standard Perl distribution)
! provides the C<strtol> and C<strtod> for converting strings to double
and longs, respectively.
=head2 How do I keep persistent data across program calls?
For some specific applications, you can use one of the DBM modules.
! See L<AnyDBM_File>. More generically, you should consult the
! FreezeThaw, Storable, or Class::Eroot modules from CPAN.
=head2 How do I print out or copy a recursive data structure?
! The Data::Dumper module on CPAN is nice for printing out
! data structures, and FreezeThaw for copying them. For example:
! use FreezeThaw qw(freeze thaw);
! $new = thaw freeze $old;
!
! Where $old can be (a reference to) any kind of data structure you'd like.
! It will be deeply copied.
=head2 How do I define methods for every class/object?
--- 1606,1646 ----
sub is_numeric { defined &getnum }
! Or you could check out String::Scanf which can be found at
! http://www.perl.com/CPAN/modules/by-module/String/.
! The POSIX module (part of the standard Perl distribution) provides
! the C<strtol> and C<strtod> for converting strings to double
and longs, respectively.
=head2 How do I keep persistent data across program calls?
For some specific applications, you can use one of the DBM modules.
! See L<AnyDBM_File>. More generically, you should consult the FreezeThaw,
! Storable, or Class::Eroot modules from CPAN. Here's one example using
! Storable's C<store> and C<retrieve> functions:
!
! use Storable;
! store(\%hash, "filename");
!
! # later on...
! $href = retrieve("filename"); # by ref
! %hash = %{ retrieve("filename") }; # direct to hash
=head2 How do I print out or copy a recursive data structure?
! The Data::Dumper module on CPAN (or the 5.005 release of Perl) is great
! for printing out data structures. The Storable module, found on CPAN,
! provides a function called C<dclone> that recursively copies its argument.
!
! use Storable qw(dclone);
! $r2 = dclone($r1);
!
! Where $r1 can be a reference to any kind of data structure you'd like.
! It will be deeply copied. Because C<dclone> takes and returns references,
! you'd have to add extra punctuation if you had a hash of arrays that
! you wanted to copy.
! %newhash = %{ dclone(\%oldhash) };
=head2 How do I define methods for every class/object?
***************
*** 1339,1352 ****
Get the Business::CreditCard module from CPAN.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic License.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
--- 1650,1669 ----
Get the Business::CreditCard module from CPAN.
+ =head2 How do I pack arrays of doubles or floats for XS code?
+
+ The kgbpack.c code in the PGPLOT module on CPAN does just this.
+ If you're doing a lot of float or double processing, consider using
+ the PDL module from CPAN instead--it makes number-crunching easy.
+
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic Licence.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
***************
*** 1356,1358 ****
--- 1673,1676 ----
encouraged to use this code in your own programs for fun
or for profit as you see fit. A simple comment in the code giving
credit would be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq5.pod' 'perl5.005_03/pod/perlfaq5.pod'
Index: ./pod/perlfaq5.pod
*** ./pod/perlfaq5.pod Thu Jul 23 23:01:31 1998
--- ./pod/perlfaq5.pod Sat Mar 27 13:55:09 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq5 - Files and Formats ($Revision: 1.24 $, $Date: 1998/07/05 15:07:20 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq5 - Files and Formats ($Revision: 1.34 $, $Date: 1999/01/08 05:46:13 $)
=head1 DESCRIPTION
***************
*** 78,89 ****
=head2 How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file?
Although humans have an easy time thinking of a text file as being a
! sequence of lines that operates much like a stack of playing cards --
! or punch cards -- computers usually see the text file as a sequence of
! bytes. In general, there's no direct way for Perl to seek to a
! particular line of a file, insert text into a file, or remove text
! from a file.
(There are exceptions in special circumstances. You can add or remove at
the very end of the file. Another is replacing a sequence of bytes with
--- 78,92 ----
=head2 How do I change one line in a file/delete a line in a file/insert a line in the middle of a file/append to the beginning of a file?
+ Those are operations of a text editor. Perl is not a text editor.
+ Perl is a programming language. You have to decompose the problem into
+ low-level calls to read, write, open, close, and seek.
+
Although humans have an easy time thinking of a text file as being a
! sequence of lines that operates much like a stack of playing cards -- or
! punch cards -- computers usually see the text file as a sequence of bytes.
! In general, there's no direct way for Perl to seek to a particular line
! of a file, insert text into a file, or remove text from a file.
(There are exceptions in special circumstances. You can add or remove at
the very end of the file. Another is replacing a sequence of bytes with
***************
*** 97,103 ****
$old = $file;
$new = "$file.tmp.$$";
! $bak = "$file.bak";
open(OLD, "< $old") or die "can't open $old: $!";
open(NEW, "> $new") or die "can't open $new: $!";
--- 100,106 ----
$old = $file;
$new = "$file.tmp.$$";
! $bak = "$file.orig";
open(OLD, "< $old") or die "can't open $old: $!";
open(NEW, "> $new") or die "can't open $new: $!";
***************
*** 124,130 ****
perl -pi -e 's/(^\s+test\s+)\d+/ $1 . ++$count /e' t/op/taint.t
# form a script
! local($^I, @ARGV) = ('.bak', glob("*.c"));
while (<>) {
if ($. == 1) {
print "This line should appear at the top of each file\n";
--- 127,133 ----
perl -pi -e 's/(^\s+test\s+)\d+/ $1 . ++$count /e' t/op/taint.t
# form a script
! local($^I, @ARGV) = ('.orig', glob("*.c"));
while (<>) {
if ($. == 1) {
print "This line should appear at the top of each file\n";
***************
*** 174,182 ****
filehandle opened for reading and writing. Use this if you don't
need to know the file's name.
! use IO::File;
$fh = IO::File->new_tmpfile()
! or die "Unable to make new temporary file: $!";
Or you can use the C<tmpnam> function from the POSIX module to get a
filename that you then open yourself. Use this if you do need to know
--- 177,185 ----
filehandle opened for reading and writing. Use this if you don't
need to know the file's name.
! use IO::File;
$fh = IO::File->new_tmpfile()
! or die "Unable to make new temporary file: $!";
Or you can use the C<tmpnam> function from the POSIX module to get a
filename that you then open yourself. Use this if you do need to know
***************
*** 222,228 ****
=head2 How can I manipulate fixed-record-length files?
The most efficient way is using pack() and unpack(). This is faster than
! using substr() when take many, many strings. It is slower for just a few.
Here is a sample chunk of code to break up and put back together again
some fixed-format input lines, in this case from the output of a normal,
--- 225,231 ----
=head2 How can I manipulate fixed-record-length files?
The most efficient way is using pack() and unpack(). This is faster than
! using substr() when taking many, many strings. It is slower for just a few.
Here is a sample chunk of code to break up and put back together again
some fixed-format input lines, in this case from the output of a normal,
***************
*** 289,298 ****
}
For passing filehandles to functions, the easiest way is to
! prefer them with a star, as in func(*STDIN). See L<perlfaq7/"Passing
Filehandles"> for details.
! If you want to create many, anonymous handles, you should check out the
Symbol, FileHandle, or IO::Handle (etc.) modules. Here's the equivalent
code with Symbol::gensym, which is reasonably light-weight:
--- 292,301 ----
}
For passing filehandles to functions, the easiest way is to
! preface them with a star, as in func(*STDIN). See L<perlfaq7/"Passing
Filehandles"> for details.
! If you want to create many anonymous handles, you should check out the
Symbol, FileHandle, or IO::Handle (etc.) modules. Here's the equivalent
code with Symbol::gensym, which is reasonably light-weight:
***************
*** 303,310 ****
$file{$filename} = [ $i++, $fh ];
}
! Or here using the semi-object-oriented FileHandle, which certainly isn't
! light-weight:
use FileHandle;
--- 306,313 ----
$file{$filename} = [ $i++, $fh ];
}
! Or here using the semi-object-oriented FileHandle module, which certainly
! isn't light-weight:
use FileHandle;
***************
*** 343,349 ****
Then use any of those as you would a normal filehandle. Anywhere that
Perl is expecting a filehandle, an indirect filehandle may be used
instead. An indirect filehandle is just a scalar variable that contains
! a filehandle. Functions like C<print>, C<open>, C<seek>, or the functions or
the C<E<lt>FHE<gt>> diamond operator will accept either a read filehandle
or a scalar variable containing one:
--- 346,352 ----
Then use any of those as you would a normal filehandle. Anywhere that
Perl is expecting a filehandle, an indirect filehandle may be used
instead. An indirect filehandle is just a scalar variable that contains
! a filehandle. Functions like C<print>, C<open>, C<seek>, or
the C<E<lt>FHE<gt>> diamond operator will accept either a read filehandle
or a scalar variable containing one:
***************
*** 352,358 ****
$got = <$ifh>
print $efh "What was that: $got";
! Of you're passing a filehandle to a function, you can write
the function in two ways:
sub accept_fh {
--- 355,361 ----
$got = <$ifh>
print $efh "What was that: $got";
! If you're passing a filehandle to a function, you can write
the function in two ways:
sub accept_fh {
***************
*** 422,428 ****
=head2 How can I write() into a string?
! See L<perlform> for an swrite() function.
=head2 How can I output my numbers with commas added?
--- 425,431 ----
=head2 How can I write() into a string?
! See L<perlform/"Accessing Formatting Internals"> for an swrite() function.
=head2 How can I output my numbers with commas added?
***************
*** 430,436 ****
sub commify {
local $_ = shift;
! 1 while s/^(-?\d+)(\d{3})/$1,$2/;
return $_;
}
--- 433,439 ----
sub commify {
local $_ = shift;
! 1 while s/^([-+]?\d+)(\d{3})/$1,$2/;
return $_;
}
***************
*** 441,447 ****
You can't just:
! s/^(-?\d+)(\d{3})/$1,$2/g;
because you have to put the comma in and then recalculate your
position.
--- 444,450 ----
You can't just:
! s/^([-+]?\d+)(\d{3})/$1,$2/g;
because you have to put the comma in and then recalculate your
position.
***************
*** 455,461 ****
my $input = shift;
$input = reverse $input;
$input =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g;
! return reverse $input;
}
=head2 How can I translate tildes (~) in a filename?
--- 458,464 ----
my $input = shift;
$input = reverse $input;
$input =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g;
! return scalar reverse $input;
}
=head2 How can I translate tildes (~) in a filename?
***************
*** 547,553 ****
successful create or unlink the same file! Therefore O_EXCL
isn't so exclusive as you might wish.
! =head2 Why do I sometimes get an "Argument list too long" when I use <*>?
The C<E<lt>E<gt>> operator performs a globbing operation (see above).
By default glob() forks csh(1) to do the actual glob expansion, but
--- 550,558 ----
successful create or unlink the same file! Therefore O_EXCL
isn't so exclusive as you might wish.
! See also the new L<perlopentut> if you have it (new for 5.006).
!
! =head2 Why do I sometimes get an "Argument list too long" when I use E<lt>*E<gt>?
The C<E<lt>E<gt>> operator performs a globbing operation (see above).
By default glob() forks csh(1) to do the actual glob expansion, but
***************
*** 555,563 ****
C<Argument list too long>. People who installed tcsh as csh won't
have this problem, but their users may be surprised by it.
! To get around this, either do the glob yourself with C<Dirhandle>s and
patterns, or use a module like Glob::KGlob, one that doesn't use the
! shell to do globbing.
=head2 Is there a leak/bug in glob()?
--- 560,568 ----
C<Argument list too long>. People who installed tcsh as csh won't
have this problem, but their users may be surprised by it.
! To get around this, either do the glob yourself with readdir() and
patterns, or use a module like Glob::KGlob, one that doesn't use the
! shell to do globbing. This is expected to be fixed soon.
=head2 Is there a leak/bug in glob()?
***************
*** 576,590 ****
sub safe_filename {
local $_ = shift;
! return m#^/#
! ? "$_\0"
! : "./$_\0";
}
! $fn = safe_filename("<<<something really wicked ");
! open(FH, "> $fn") or "couldn't open $fn: $!";
! You could also use the sysopen() function (see L<perlfunc/sysopen>).
=head2 How can I reliably rename a file?
--- 581,608 ----
sub safe_filename {
local $_ = shift;
! s#^([^./])#./$1#;
! $_ .= "\0";
! return $_;
}
! $badpath = "<<<something really wicked ";
! $fn = safe_filename($badpath");
! open(FH, "> $fn") or "couldn't open $badpath: $!";
!
! This assumes that you are using POSIX (portable operating systems
! interface) paths. If you are on a closed, non-portable, proprietary
! system, you may have to adjust the C<"./"> above.
!
! It would be a lot clearer to use sysopen(), though:
!
! use Fcntl;
! $badpath = "<<<something really wicked ";
! open (FH, $badpath, O_WRONLY | O_CREAT | O_TRUNC)
! or die "can't open $badpath: $!";
! For more information, see also the new L<perlopentut> if you have it
! (new for 5.006).
=head2 How can I reliably rename a file?
***************
*** 601,607 ****
real rename(), though, which preserves metainformation like
permissions, timestamps, inode info, etc.
! The newer version of File::Copy export a move() function.
=head2 How can I lock a file?
--- 619,625 ----
real rename(), though, which preserves metainformation like
permissions, timestamps, inode info, etc.
! The newer version of File::Copy exports a move() function.
=head2 How can I lock a file?
***************
*** 631,639 ****
file in the source distribution for information on building Perl to do
this.
=back
! =head2 What can't I just open(FH, ">file.lock")?
A common bit of code B<NOT TO USE> is this:
--- 649,660 ----
file in the source distribution for information on building Perl to do
this.
+ For more information on file locking, see also L<perlopentut/"File
+ Locking"> if you have it (new for 5.006).
+
=back
! =head2 Why can't I just open(FH, ">file.lock")?
A common bit of code B<NOT TO USE> is this:
***************
*** 649,655 ****
except that lamentably, file creation (and deletion) is not atomic
over NFS, so this won't work (at least, not every time) over the net.
! Various schemes involving involving link() have been suggested, but
these tend to involve busy-wait, which is also subdesirable.
=head2 I still don't get locking. I just want to increment the number in the file. How can I do this?
--- 670,676 ----
except that lamentably, file creation (and deletion) is not atomic
over NFS, so this won't work (at least, not every time) over the net.
! Various schemes involving link() have been suggested, but
these tend to involve busy-wait, which is also subdesirable.
=head2 I still don't get locking. I just want to increment the number in the file. How can I do this?
***************
*** 661,674 ****
Anyway, this is what you can do if you can't help yourself.
! use Fcntl;
sysopen(FH, "numfile", O_RDWR|O_CREAT) or die "can't open numfile: $!";
! flock(FH, 2) or die "can't flock numfile: $!";
$num = <FH> || 0;
seek(FH, 0, 0) or die "can't rewind numfile: $!";
truncate(FH, 0) or die "can't truncate numfile: $!";
(print FH $num+1, "\n") or die "can't write numfile: $!";
! # DO NOT UNLOCK THIS UNTIL YOU CLOSE
close FH or die "can't close numfile: $!";
Here's a much better web-page hit counter:
--- 682,696 ----
Anyway, this is what you can do if you can't help yourself.
! use Fcntl ':flock';
sysopen(FH, "numfile", O_RDWR|O_CREAT) or die "can't open numfile: $!";
! flock(FH, LOCK_EX) or die "can't flock numfile: $!";
$num = <FH> || 0;
seek(FH, 0, 0) or die "can't rewind numfile: $!";
truncate(FH, 0) or die "can't truncate numfile: $!";
(print FH $num+1, "\n") or die "can't write numfile: $!";
! # Perl as of 5.004 automatically flushes before unlocking
! flock(FH, LOCK_UN) or die "can't flock numfile: $!";
close FH or die "can't close numfile: $!";
Here's a much better web-page hit counter:
***************
*** 693,699 ****
seek(FH, $recno * $RECSIZE, 0);
read(FH, $record, $RECSIZE) == $RECSIZE || die "can't read record $recno: $!";
# munge the record
! seek(FH, $recno * $RECSIZE, 0);
print FH $record;
close FH;
--- 715,721 ----
seek(FH, $recno * $RECSIZE, 0);
read(FH, $record, $RECSIZE) == $RECSIZE || die "can't read record $recno: $!";
# munge the record
! seek(FH, -$RECSIZE, 1);
print FH $record;
close FH;
***************
*** 720,731 ****
If you prefer something more legible, use the File::stat module
(part of the standard distribution in version 5.004 and later):
use File::stat;
use Time::localtime;
$date_string = ctime(stat($file)->mtime);
print "file $file updated at $date_string\n";
! Error checking is left as an exercise for the reader.
=head2 How do I set a file's timestamp in perl?
--- 742,756 ----
If you prefer something more legible, use the File::stat module
(part of the standard distribution in version 5.004 and later):
+ # error checking left as an exercise for reader.
use File::stat;
use Time::localtime;
$date_string = ctime(stat($file)->mtime);
print "file $file updated at $date_string\n";
! The POSIX::strftime() approach has the benefit of being,
! in theory, independent of the current locale. See L<perllocale>
! for details.
=head2 How do I set a file's timestamp in perl?
***************
*** 741,747 ****
($atime, $mtime) = (stat($timestamp))[8,9];
utime $atime, $mtime, @ARGV;
! Error checking is left as an exercise for the reader.
Note that utime() currently doesn't work correctly with Win95/NT
ports. A bug has been reported. Check it carefully before using
--- 766,772 ----
($atime, $mtime) = (stat($timestamp))[8,9];
utime $atime, $mtime, @ARGV;
! Error checking is, as usual, left as an exercise for the reader.
Note that utime() currently doesn't work correctly with Win95/NT
ports. A bug has been reported. Check it carefully before using
***************
*** 774,784 ****
=head2 How can I read in a file by paragraphs?
! Use the C<$\> variable (see L<perlvar> for details). You can either
set it to C<""> to eliminate empty paragraphs (C<"abc\n\n\n\ndef">,
for instance, gets treated as two paragraphs and not three), or
C<"\n\n"> to accept empty paragraphs.
=head2 How can I read a single character from a file? From the keyboard?
You can use the builtin C<getc()> function for most filehandles, but
--- 799,812 ----
=head2 How can I read in a file by paragraphs?
! Use the C<$/> variable (see L<perlvar> for details). You can either
set it to C<""> to eliminate empty paragraphs (C<"abc\n\n\n\ndef">,
for instance, gets treated as two paragraphs and not three), or
C<"\n\n"> to accept empty paragraphs.
+ Note that a blank line must have no blanks in it. Thus C<"fred\n
+ \nstuff\n\n"> is one paragraph, but C<"fred\n\nstuff\n\n"> is two.
+
=head2 How can I read a single character from a file? From the keyboard?
You can use the builtin C<getc()> function for most filehandles, but
***************
*** 786,793 ****
the Term::ReadKey module from CPAN, or use the sample code in
L<perlfunc/getc>.
! If your system supports POSIX, you can use the following code, which
! you'll note turns off echo processing as well.
#!/usr/bin/perl -w
use strict;
--- 814,822 ----
the Term::ReadKey module from CPAN, or use the sample code in
L<perlfunc/getc>.
! If your system supports the portable operating system programming
! interface (POSIX), you can use the following code, which you'll note
! turns off echo processing as well.
#!/usr/bin/perl -w
use strict;
***************
*** 838,844 ****
END { cooked() }
! The Term::ReadKey module from CPAN may be easier to use:
use Term::ReadKey;
open(TTY, "</dev/tty");
--- 867,874 ----
END { cooked() }
! The Term::ReadKey module from CPAN may be easier to use. Recent version
! include also support for non-portable systems as well.
use Term::ReadKey;
open(TTY, "</dev/tty");
***************
*** 849,855 ****
printf "\nYou said %s, char number %03d\n",
$key, ord $key;
! For DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following:
To put the PC in "raw" mode, use ioctl with some magic numbers gleaned
from msdos.c (Perl source file) and Ralf Brown's interrupt list (comes
--- 879,885 ----
printf "\nYou said %s, char number %03d\n",
$key, ord $key;
! For legacy DOS systems, Dan Carson <dbc@tc.fluke.COM> reports the following:
To put the PC in "raw" mode, use ioctl with some magic numbers gleaned
from msdos.c (Perl source file) and Ralf Brown's interrupt list (comes
***************
*** 895,905 ****
This is all trial and error I did a long time ago, I hope I'm reading the
file that worked.
! =head2 How can I tell if there's a character waiting on a filehandle?
The very first thing you should do is look into getting the Term::ReadKey
! extension from CPAN. It now even has limited support for closed, proprietary
! (read: not open systems, not POSIX, not Unix, etc) systems.
You should also check out the Frequently Asked Questions list in
comp.unix.* for things like this: the answer is essentially the same.
--- 925,936 ----
This is all trial and error I did a long time ago, I hope I'm reading the
file that worked.
! =head2 How can I tell whether there's a character waiting on a filehandle?
The very first thing you should do is look into getting the Term::ReadKey
! extension from CPAN. As we mentioned earlier, it now even has limited
! support for non-portable (read: not open systems, closed, proprietary,
! not POSIX, not Unix, etc) systems.
You should also check out the Frequently Asked Questions list in
comp.unix.* for things like this: the answer is essentially the same.
***************
*** 912,923 ****
return $nfd = select($rin,undef,undef,0);
}
! If you want to find out how many characters are waiting,
! there's also the FIONREAD ioctl call to be looked at.
!
! The I<h2ph> tool that comes with Perl tries to convert C include
! files to Perl code, which can be C<require>d. FIONREAD ends
! up defined as a function in the I<sys/ioctl.ph> file:
require 'sys/ioctl.ph';
--- 943,953 ----
return $nfd = select($rin,undef,undef,0);
}
! If you want to find out how many characters are waiting, there's
! also the FIONREAD ioctl call to be looked at. The I<h2ph> tool that
! comes with Perl tries to convert C include files to Perl code, which
! can be C<require>d. FIONREAD ends up defined as a function in the
! I<sys/ioctl.ph> file:
require 'sys/ioctl.ph';
***************
*** 939,945 ****
printf("%#08x\n", FIONREAD);
}
^D
! % cc -o fionread fionread
% ./fionread
0x4004667f
--- 969,975 ----
printf("%#08x\n", FIONREAD);
}
^D
! % cc -o fionread fionread.c
% ./fionread
0x4004667f
***************
*** 980,985 ****
--- 1010,1017 ----
filehandle. The method: read until end of file, clearerr(), read some
more. Lather, rinse, repeat.
+ There's also a File::Tail module from CPAN.
+
=head2 How do I dup() a filehandle in Perl?
If you check L<perlfunc/open>, you'll see that several of the ways
***************
*** 1018,1036 ****
backslash is an escape character. The full list of these is in
L<perlop/Quote and Quote-like Operators>. Unsurprisingly, you don't
have a file called "c:(tab)emp(formfeed)oo" or
! "c:(tab)emp(formfeed)oo.exe" on your DOS filesystem.
Either single-quote your strings, or (preferably) use forward slashes.
Since all DOS and Windows versions since something like MS-DOS 2.0 or so
have treated C</> and C<\> the same in a path, you might as well use the
one that doesn't clash with Perl -- or the POSIX shell, ANSI C and C++,
! awk, Tcl, Java, or Python, just to mention a few.
=head2 Why doesn't glob("*.*") get all the files?
Because even on non-Unix ports, Perl's glob function follows standard
Unix globbing semantics. You'll need C<glob("*")> to get all (non-hidden)
! files. This makes glob() portable.
=head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl?
--- 1050,1071 ----
backslash is an escape character. The full list of these is in
L<perlop/Quote and Quote-like Operators>. Unsurprisingly, you don't
have a file called "c:(tab)emp(formfeed)oo" or
! "c:(tab)emp(formfeed)oo.exe" on your legacy DOS filesystem.
Either single-quote your strings, or (preferably) use forward slashes.
Since all DOS and Windows versions since something like MS-DOS 2.0 or so
have treated C</> and C<\> the same in a path, you might as well use the
one that doesn't clash with Perl -- or the POSIX shell, ANSI C and C++,
! awk, Tcl, Java, or Python, just to mention a few. POSIX paths
! are more portable, too.
=head2 Why doesn't glob("*.*") get all the files?
Because even on non-Unix ports, Perl's glob function follows standard
Unix globbing semantics. You'll need C<glob("*")> to get all (non-hidden)
! files. This makes glob() portable even to legacy systems. Your
! port may include proprietary globbing functions as well. Check its
! documentation for details.
=head2 Why does Perl let me delete read-only files? Why does C<-i> clobber protected files? Isn't this a bug in Perl?
***************
*** 1057,1069 ****
file in. A simple proof by induction is available upon
request if you doubt its correctness.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this works is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
--- 1092,1127 ----
file in. A simple proof by induction is available upon
request if you doubt its correctness.
+ =head2 Why do I get weird spaces when I print an array of lines?
+
+ Saying
+
+ print "@lines\n";
+
+ joins together the elements of C<@lines> with a space between them.
+ If C<@lines> were C<("little", "fluffy", "clouds")> then the above
+ statement would print:
+
+ little fluffy clouds
+
+ but if each element of C<@lines> was a line of text, ending a newline
+ character C<("little\n", "fluffy\n", "clouds\n")> then it would print:
+
+ little
+ fluffy
+ clouds
+
+ If your array contains lines, just print them:
+
+ print @lines;
+
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as an integrated part of the Standard Distribution
! of Perl or of its documentation (printed or otherwise), this work is
covered under Perl's Artistic Licence. For separate distributions of
all or part of this FAQ outside of that, see L<perlfaq>.
***************
*** 1072,1074 ****
--- 1130,1133 ----
derivatives thereof in your own programs for fun or for profit as you
see fit. A simple comment in the code giving credit to the FAQ would
be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq6.pod' 'perl5.005_03/pod/perlfaq6.pod'
Index: ./pod/perlfaq6.pod
*** ./pod/perlfaq6.pod Thu Jul 23 23:01:31 1998
--- ./pod/perlfaq6.pod Sat Mar 27 13:55:32 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq6 - Regexps ($Revision: 1.22 $, $Date: 1998/07/16 14:01:07 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq6 - Regexps ($Revision: 1.25 $, $Date: 1999/01/08 04:50:47 $)
=head1 DESCRIPTION
***************
*** 128,134 ****
If you wanted text and not lines, you would use
! perl -0777 -pe 'print "$1\n" while /START(.*?)END/gs' file1 file2 ...
But if you want nested occurrences of C<START> through C<END>, you'll
run up against the problem described in the question in this section
--- 128,134 ----
If you wanted text and not lines, you would use
! perl -0777 -ne 'print "$1\n" while /START(.*?)END/gs' file1 file2 ...
But if you want nested occurrences of C<START> through C<END>, you'll
run up against the problem described in the question in this section
***************
*** 387,434 ****
=head2 How do I efficiently match many regular expressions at once?
! The following is super-inefficient:
! while (<FH>) {
! foreach $pat (@patterns) {
! if ( /$pat/ ) {
! # do something
! }
! }
! }
!
! Instead, you either need to use one of the experimental Regexp extension
! modules from CPAN (which might well be overkill for your purposes),
! or else put together something like this, inspired from a routine
! in Jeffrey Friedl's book:
!
! sub _bm_build {
! my $condition = shift;
! my @regexp = @_; # this MUST not be local(); need my()
! my $expr = join $condition => map { "m/\$regexp[$_]/o" } (0..$#regexp);
! my $match_func = eval "sub { $expr }";
! die if $@; # propagate $@; this shouldn't happen!
! return $match_func;
! }
!
! sub bm_and { _bm_build('&&', @_) }
! sub bm_or { _bm_build('||', @_) }
!
! $f1 = bm_and qw{
! xterm
! (?i)window
! };
!
! $f2 = bm_or qw{
! \b[Ff]ree\b
! \bBSD\B
! (?i)sys(tem)?\s*[V5]\b
! };
! # feed me /etc/termcap, prolly
! while ( <> ) {
! print "1: $_" if &$f1;
! print "2: $_" if &$f2;
}
=head2 Why don't word-boundary searches with C<\b> work for me?
--- 387,417 ----
=head2 How do I efficiently match many regular expressions at once?
! The following is extremely inefficient:
! # slow but obvious way
! @popstates = qw(CO ON MI WI MN);
! while (defined($line = <>)) {
! for $state (@popstates) {
! if ($line =~ /\b$state\b/i) {
! print $line;
! last;
! }
! }
! }
! That's because Perl has to recompile all those patterns for each of
! the lines of the file. As of the 5.005 release, there's a much better
! approach, one which makes use of the new C<qr//> operator:
!
! # use spiffy new qr// operator, with /i flag even
! use 5.005;
! @popstates = qw(CO ON MI WI MN);
! @poppats = map { qr/\b$_\b/i } @popstates;
! while (defined($line = <>)) {
! for $patobj (@poppats) {
! print $line if $line =~ /$patobj/;
! }
}
=head2 Why don't word-boundary searches with C<\b> work for me?
***************
*** 460,481 ****
=head2 Why does using $&, $`, or $' slow my program down?
! Because once Perl sees that you need one of these variables anywhere
! in the program, it has to provide them on each and every pattern
! match. The same mechanism that handles these provides for the use of
! $1, $2, etc., so you pay the same price for each regexp that contains
! capturing parentheses. But if you never use $&, etc., in your script,
! then regexps I<without> capturing parentheses won't be penalized. So
! avoid $&, $', and $` if you can, but if you can't (and some algorithms
! really appreciate them), once you've used them once, use them at will,
! because you've already paid the price.
=head2 What good is C<\G> in a regular expression?
The notation C<\G> is used in a match or substitution in conjunction the
C</g> modifier (and ignored if there's no C</g>) to anchor the regular
expression to the point just past where the last match occurred, i.e. the
! pos() point.
For example, suppose you had a line of text quoted in standard mail
and Usenet notation, (that is, with leading C<E<gt>> characters), and
--- 443,466 ----
=head2 Why does using $&, $`, or $' slow my program down?
! Because once Perl sees that you need one of these variables anywhere in
! the program, it has to provide them on each and every pattern match.
! The same mechanism that handles these provides for the use of $1, $2,
! etc., so you pay the same price for each regexp that contains capturing
! parentheses. But if you never use $&, etc., in your script, then regexps
! I<without> capturing parentheses won't be penalized. So avoid $&, $',
! and $` if you can, but if you can't, once you've used them at all, use
! them at will because you've already paid the price. Remember that some
! algorithms really appreciate them. As of the 5.005 release. the $&
! variable is no longer "expensive" the way the other two are.
=head2 What good is C<\G> in a regular expression?
The notation C<\G> is used in a match or substitution in conjunction the
C</g> modifier (and ignored if there's no C</g>) to anchor the regular
expression to the point just past where the last match occurred, i.e. the
! pos() point. A failed match resets the position of C<\G> unless the
! C</c> modifier is in effect.
For example, suppose you had a line of text quoted in standard mail
and Usenet notation, (that is, with leading C<E<gt>> characters), and
***************
*** 596,620 ****
Or like this:
! die "sorry, Perl doesn't (yet) have Martian support )-:\n";
!
! In addition, a sample program which converts half-width to full-width
! katakana (in Shift-JIS or EUC encoding) is available from CPAN as
!
! =for Tom make it so
There are many double- (and multi-) byte encodings commonly used these
days. Some versions of these have 1-, 2-, 3-, and 4-byte characters,
all mixed.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic License.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
--- 581,626 ----
Or like this:
! die "sorry, Perl doesn't (yet) have Martian support )-:\n";
There are many double- (and multi-) byte encodings commonly used these
days. Some versions of these have 1-, 2-, 3-, and 4-byte characters,
all mixed.
+ =head2 How do I match a pattern that is supplied by the user?
+
+ Well, if it's really a pattern, then just use
+
+ chomp($pattern = <STDIN>);
+ if ($line =~ /$pattern/) { }
+
+ Or, since you have no guarantee that your user entered
+ a valid regular expression, trap the exception this way:
+
+ if (eval { $line =~ /$pattern/ }) { }
+
+ But if all you really want to search for a string, not a pattern,
+ then you should either use the index() function, which is made for
+ string searching, or if you can't be disabused of using a pattern
+ match on a non-pattern, then be sure to use C<\Q>...C<\E>, documented
+ in L<perlre>.
+
+ $pattern = <STDIN>;
+
+ open (FILE, $input) or die "Couldn't open input $input: $!; aborting";
+ while (<FILE>) {
+ print if /\Q$pattern\E/;
+ }
+ close FILE;
+
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic Licence.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
***************
*** 624,626 ****
--- 630,633 ----
encouraged to use this code in your own programs for fun
or for profit as you see fit. A simple comment in the code giving
credit would be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq7.pod' 'perl5.005_03/pod/perlfaq7.pod'
Index: ./pod/perlfaq7.pod
*** ./pod/perlfaq7.pod Thu Jul 23 23:01:32 1998
--- ./pod/perlfaq7.pod Sat Mar 27 13:55:49 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq7 - Perl Language Issues ($Revision: 1.21 $, $Date: 1998/06/22 15:20:07 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq7 - Perl Language Issues ($Revision: 1.24 $, $Date: 1999/01/08 05:32:11 $)
=head1 DESCRIPTION
***************
*** 180,186 ****
# if using RCS/CVS, this next line may be preferred,
# but beware two-digit versions.
! $VERSION = do{my@r=q$Revision: 1.21 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};
@ISA = qw(Exporter);
@EXPORT = qw(&func1 &func2 &func3);
--- 180,186 ----
# if using RCS/CVS, this next line may be preferred,
# but beware two-digit versions.
! $VERSION = do{my@r=q$Revision: 1.24 $=~/\d+/g;sprintf '%d.'.'%02d'x$#r,@r};
@ISA = qw(Exporter);
@EXPORT = qw(&func1 &func2 &func3);
***************
*** 229,234 ****
--- 229,238 ----
1; # modules must return true
+ The h2xs program will create stubs for all the important stuff for you:
+
+ % h2xs -XA -n My::Module
+
=head2 How do I create a class?
See L<perltoot> for an introduction to classes and objects, as well as
***************
*** 313,319 ****
Variable suicide is when you (temporarily or permanently) lose the
value of a variable. It is caused by scoping through my() and local()
! interacting with either closures or aliased foreach() interator
variables and subroutine arguments. It used to be easy to
inadvertently lose a variable's value this way, but now it's much
harder. Take this code:
--- 317,323 ----
Variable suicide is when you (temporarily or permanently) lose the
value of a variable. It is caused by scoping through my() and local()
! interacting with either closures or aliased foreach() iterator
variables and subroutine arguments. It used to be easy to
inadvertently lose a variable's value this way, but now it's much
harder. Take this code:
***************
*** 344,350 ****
func( \$some_scalar );
! func( \$some_array );
func( [ 1 .. 10 ] );
func( \%some_hash );
--- 348,354 ----
func( \$some_scalar );
! func( \@some_array );
func( [ 1 .. 10 ] );
func( \%some_hash );
***************
*** 392,398 ****
To pass regexps around, you'll need to either use one of the highly
experimental regular expression modules from CPAN (Nick Ing-Simmons's
Regexp or Ilya Zakharevich's Devel::Regexp), pass around strings
! and use an exception-trapping eval, or else be be very, very clever.
Here's an example of how to pass in a string to be regexp compared:
sub compare($$) {
--- 396,402 ----
To pass regexps around, you'll need to either use one of the highly
experimental regular expression modules from CPAN (Nick Ing-Simmons's
Regexp or Ilya Zakharevich's Devel::Regexp), pass around strings
! and use an exception-trapping eval, or else be very, very clever.
Here's an example of how to pass in a string to be regexp compared:
sub compare($$) {
***************
*** 484,490 ****
accessing the same private variable, but another file with the same
package couldn't get to it.
! See L<perlsub/"Peristent Private Variables"> for details.
=head2 What's the difference between dynamic and lexical (static) scoping? Between local() and my()?
--- 488,494 ----
accessing the same private variable, but another file with the same
package couldn't get to it.
! See L<perlsub/"Persistent Private Variables"> for details.
=head2 What's the difference between dynamic and lexical (static) scoping? Between local() and my()?
***************
*** 563,569 ****
are effectively shallowly bound. Consider this just one more reason
not to use them. See the answer to L<"What's a closure?">.
! =head2 Why doesn't "my($foo) = <FILE>;" work right?
C<my()> and C<local()> give list context to the right hand side
of C<=>. The E<lt>FHE<gt> read operation, like so many of Perl's
--- 567,573 ----
are effectively shallowly bound. Consider this just one more reason
not to use them. See the answer to L<"What's a closure?">.
! =head2 Why doesn't "my($foo) = E<lt>FILEE<gt>;" work right?
C<my()> and C<local()> give list context to the right hand side
of C<=>. The E<lt>FHE<gt> read operation, like so many of Perl's
***************
*** 797,810 ****
the parser is expecting a new statement, not just in the middle
of an expression or some other arbitrary yacc grammar production.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic License.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
--- 801,839 ----
the parser is expecting a new statement, not just in the middle
of an expression or some other arbitrary yacc grammar production.
+ =head2 How do I clear a package?
+
+ Use this code, provided by Mark-Jason Dominus:
+
+ sub scrub_package {
+ no strict 'refs';
+ my $pack = shift;
+ die "Shouldn't delete main package"
+ if $pack eq "" || $pack eq "main";
+ my $stash = *{$pack . '::'}{HASH};
+ my $name;
+ foreach $name (keys %$stash) {
+ my $fullname = $pack . '::' . $name;
+ # Get rid of everything with that name.
+ undef $$fullname;
+ undef @$fullname;
+ undef %$fullname;
+ undef &$fullname;
+ undef *$fullname;
+ }
+ }
+
+ Or, if you're using a recent release of Perl, you can
+ just use the Symbol::delete_package() function instead.
+
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic Licence.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
***************
*** 814,816 ****
--- 843,846 ----
encouraged to use this code in your own programs for fun
or for profit as you see fit. A simple comment in the code giving
credit would be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq8.pod' 'perl5.005_03/pod/perlfaq8.pod'
Index: ./pod/perlfaq8.pod
*** ./pod/perlfaq8.pod Wed Aug 5 17:02:28 1998
--- ./pod/perlfaq8.pod Sat Mar 27 13:56:15 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq8 - System Interaction ($Revision: 1.26 $, $Date: 1998/08/05 12:20:28 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq8 - System Interaction ($Revision: 1.36 $, $Date: 1999/01/08 05:36:34 $)
=head1 DESCRIPTION
***************
*** 325,331 ****
}
}
-
=head2 How do I decode encrypted password files?
You spend lots and lots of money on dedicated hardware, but this is
--- 325,330 ----
***************
*** 452,460 ****
In general, you may not be able to. The Time::HiRes module (available
from CPAN) provides this functionality for some systems.
! In general, you may not be able to. But if your system supports both the
! syscall() function in Perl as well as a system call like gettimeofday(2),
! then you may be able to do something like this:
require 'sys/syscall.ph';
--- 451,459 ----
In general, you may not be able to. The Time::HiRes module (available
from CPAN) provides this functionality for some systems.
! If your system supports both the syscall() function in Perl as well as
! a system call like gettimeofday(2), then you may be able to do
! something like this:
require 'sys/syscall.ph';
***************
*** 462,468 ****
$done = $start = pack($TIMEVAL_T, ());
! syscall( &SYS_gettimeofday, $start, 0)) != -1
or die "gettimeofday: $!";
##########################
--- 461,467 ----
$done = $start = pack($TIMEVAL_T, ());
! syscall( &SYS_gettimeofday, $start, 0) != -1
or die "gettimeofday: $!";
##########################
***************
*** 674,692 ****
=head2 Why doesn't open() return an error when a pipe open fails?
! It does, but probably not how you expect it to. On systems that
! follow the standard fork()/exec() paradigm (such as Unix), it works like
! this: open() causes a fork(). In the parent, open() returns with the
! process ID of the child. The child exec()s the command to be piped
! to/from. The parent can't know whether the exec() was successful or
! not - all it can return is whether the fork() succeeded or not. To
! find out if the command succeeded, you have to catch SIGCHLD and
! wait() to get the exit status. You should also catch SIGPIPE if
! you're writing to the child -- you may not have found out the exec()
failed by the time you write. This is documented in L<perlipc>.
On systems that follow the spawn() paradigm, open() I<might> do what
! you expect - unless perl uses a shell to start your command. In this
case the fork()/exec() description still applies.
=head2 What's wrong with using backticks in a void context?
--- 673,698 ----
=head2 Why doesn't open() return an error when a pipe open fails?
! Because the pipe open takes place in two steps: first Perl calls
! fork() to start a new process, then this new process calls exec() to
! run the program you really wanted to open. The first step reports
! success or failure to your process, so open() can only tell you
! whether the fork() succeeded or not.
!
! To find out if the exec() step succeeded, you have to catch SIGCHLD
! and wait() to get the exit status. You should also catch SIGPIPE if
! you're writing to the child--you may not have found out the exec()
failed by the time you write. This is documented in L<perlipc>.
+ In some cases, even this won't work. If the second argument to a
+ piped open() contains shell metacharacters, perl fork()s, then exec()s
+ a shell to decode the metacharacters and eventually run the desired
+ program. Now when you call wait(), you only learn whether or not the
+ I<shell> could be successfully started. Best to avoid shell
+ metacharacters.
+
On systems that follow the spawn() paradigm, open() I<might> do what
! you expect--unless perl uses a shell to start your command. In this
case the fork()/exec() description still applies.
=head2 What's wrong with using backticks in a void context?
***************
*** 869,875 ****
=item *
! Open /dev/tty and use the the TIOCNOTTY ioctl on it. See L<tty(4)>
for details. Or better yet, you can just use the POSIX::setsid()
function, so you don't have to worry about process groups.
--- 875,881 ----
=item *
! Open /dev/tty and use the TIOCNOTTY ioctl on it. See L<tty(4)>
for details. Or better yet, you can just use the POSIX::setsid()
function, so you don't have to worry about process groups.
***************
*** 890,895 ****
--- 896,904 ----
=back
+ The Proc::Daemon module, available from CPAN, provides a function to
+ perform these actions for you.
+
=head2 How do I make my program run with sh and csh?
See the F<eg/nih> script (part of the perl source distribution).
***************
*** 908,914 ****
use POSIX qw/getpgrp tcgetpgrp/;
open(TTY, "/dev/tty") or die $!;
! $tpgrp = tcgetpgrp(TTY);
$pgrp = getpgrp();
if ($tpgrp == $pgrp) {
print "foreground\n";
--- 917,923 ----
use POSIX qw/getpgrp tcgetpgrp/;
open(TTY, "/dev/tty") or die $!;
! $tpgrp = tcgetpgrp(fileno(*TTY));
$pgrp = getpgrp();
if ($tpgrp == $pgrp) {
print "foreground\n";
***************
*** 1034,1039 ****
--- 1043,1055 ----
use lib '/u/mydir/perl';
+ This is almost the same as:
+
+ BEGIN {
+ unshift(@INC, '/u/mydir/perl');
+ }
+
+ except that the lib module checks for machine-dependent subdirectories.
See Perl's L<lib> for more information.
=head2 How do I add the directory my program lives in to the module/library search path?
***************
*** 1048,1054 ****
the PERLLIB environment variable
the PERL5LIB environment variable
! the perl -Idir commpand line flag
the use lib pragma, as in
use lib "$ENV{HOME}/myown_perllib";
--- 1064,1070 ----
the PERLLIB environment variable
the PERL5LIB environment variable
! the perl -Idir command line flag
the use lib pragma, as in
use lib "$ENV{HOME}/myown_perllib";
***************
*** 1056,1069 ****
dependent architectures. The lib.pm pragmatic module was first
included with the 5.002 release of Perl.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic License.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
--- 1072,1091 ----
dependent architectures. The lib.pm pragmatic module was first
included with the 5.002 release of Perl.
+ =head2 What is socket.ph and where do I get it?
+
+ It's a perl4-style file defining values for system networking
+ constants. Sometimes it is built using h2ph when Perl is installed,
+ but other times it is not. Modern programs C<use Socket;> instead.
+
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic Licence.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
***************
*** 1073,1075 ****
--- 1095,1098 ----
encouraged to use this code in your own programs for fun
or for profit as you see fit. A simple comment in the code giving
credit would be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlfaq9.pod' 'perl5.005_03/pod/perlfaq9.pod'
Index: ./pod/perlfaq9.pod
*** ./pod/perlfaq9.pod Thu Jul 23 23:01:33 1998
--- ./pod/perlfaq9.pod Sat Mar 27 13:56:31 1999
***************
*** 1,6 ****
=head1 NAME
! perlfaq9 - Networking ($Revision: 1.20 $, $Date: 1998/06/22 18:31:09 $)
=head1 DESCRIPTION
--- 1,6 ----
=head1 NAME
! perlfaq9 - Networking ($Revision: 1.24 $, $Date: 1999/01/08 05:39:48 $)
=head1 DESCRIPTION
***************
*** 20,26 ****
The useful FAQs and related documents are:
CGI FAQ
! http://www.webthing.com/page.cgi/cgifaq
Web FAQ
http://www.boutell.com/faq/
--- 20,26 ----
The useful FAQs and related documents are:
CGI FAQ
! http://www.webthing.com/tutorials/cgifaq.html
Web FAQ
http://www.boutell.com/faq/
***************
*** 77,84 ****
=head2 How do I remove HTML from a string?
The most correct way (albeit not the fastest) is to use HTML::Parse
! from CPAN (part of the libwww-perl distribution, which is a must-have
! module for all web hackers).
Many folks attempt a simple-minded regular expression approach, like
C<s/E<lt>.*?E<gt>//g>, but that fails in many cases because the tags
--- 77,83 ----
=head2 How do I remove HTML from a string?
The most correct way (albeit not the fastest) is to use HTML::Parse
! from CPAN (part of the HTML-Tree package on CPAN).
Many folks attempt a simple-minded regular expression approach, like
C<s/E<lt>.*?E<gt>//g>, but that fails in many cases because the tags
***************
*** 172,177 ****
--- 171,177 ----
getprint "http://www.sn.no/libwww-perl/";
# or print ASCII from HTML from a URL
+ # also need HTML-Tree package from CPAN
use LWP::Simple;
use HTML::Parse;
use HTML::FormatText;
***************
*** 213,219 ****
$string =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
Encoding is a bit harder, because you can't just blindly change
! all the non-alphanumunder character (C<\W>) into their hex escapes.
It's important that characters with special meaning like C</> and C<?>
I<not> be translated. Probably the easiest way to get this right is
to avoid reinventing the wheel and just use the URI::Escape module,
--- 213,219 ----
$string =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
Encoding is a bit harder, because you can't just blindly change
! all the non-alphanumeric characters (C<\W>) into their hex escapes.
It's important that characters with special meaning like C</> and C<?>
I<not> be translated. Probably the easiest way to get this right is
to avoid reinventing the wheel and just use the URI::Escape module,
***************
*** 303,309 ****
tempted to reinvent the wheel. Instead, use the CGI.pm or CGI_Lite.pm
(available from CPAN), or if you're trapped in the module-free land
of perl1 .. perl4, you might look into cgi-lib.pl (available from
! http://www.bio.cam.ac.uk/web/form.html).
Make sure you know whether to use a GET or a POST in your form.
GETs should only be used for something that doesn't update the server.
--- 303,309 ----
tempted to reinvent the wheel. Instead, use the CGI.pm or CGI_Lite.pm
(available from CPAN), or if you're trapped in the module-free land
of perl1 .. perl4, you might look into cgi-lib.pl (available from
! http://cgi-lib.stanford.edu/cgi-lib/ ).
Make sure you know whether to use a GET or a POST in your form.
GETs should only be used for something that doesn't update the server.
***************
*** 411,417 ****
To: Final Destination <you\@otherhost>
Subject: A relevant subject line
! Body of the message goes here, in as many lines as you like.
EOF
close(SENDMAIL) or warn "sendmail didn't close nicely";
--- 411,418 ----
To: Final Destination <you\@otherhost>
Subject: A relevant subject line
! Body of the message goes here after the blank line
! in as many lines as you like.
EOF
close(SENDMAIL) or warn "sendmail didn't close nicely";
***************
*** 442,450 ****
=head2 How do I read mail?
! Use the Mail::Folder module from CPAN
! (part of the MailFolder package) or the Mail::Internet module from
! CPAN (also part of the MailTools package).
# sending mail
use Mail::Internet;
--- 443,450 ----
=head2 How do I read mail?
! Use the Mail::Folder module from CPAN (part of the MailFolder package) or
! the Mail::Internet module from CPAN (also part of the MailTools package).
# sending mail
use Mail::Internet;
***************
*** 504,510 ****
use Socket;
use Sys::Hostname;
my $host = hostname();
! my $addr = inet_ntoa(scalar(gethostbyname($name)) || 'localhost');
Probably the simplest way to learn your DNS domain name is to grok
it out of /etc/resolv.conf, at least under Unix. Of course, this
--- 504,510 ----
use Socket;
use Sys::Hostname;
my $host = hostname();
! my $addr = inet_ntoa(scalar gethostbyname($host || 'localhost'));
Probably the simplest way to learn your DNS domain name is to grok
it out of /etc/resolv.conf, at least under Unix. Of course, this
***************
*** 531,546 ****
A DCE::RPC module is being developed (but is not yet available), and
will be released as part of the DCE-Perl package (available from
! CPAN). No ONC::RPC module is known.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997, 1998 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic License.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
--- 531,547 ----
A DCE::RPC module is being developed (but is not yet available), and
will be released as part of the DCE-Perl package (available from
! CPAN). The rpcgen suite, available from CPAN/authors/id/JAKE/, is
! an RPC stub generator and includes an RPC::ONC module.
=head1 AUTHOR AND COPYRIGHT
! Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
All rights reserved.
When included as part of the Standard Version of Perl, or as part of
its complete documentation whether printed or otherwise, this work
! may be distributed only under the terms of Perl's Artistic Licence.
Any distribution of this file or derivatives thereof I<outside>
of that package require that special arrangements be made with
copyright holder.
***************
*** 550,552 ****
--- 551,554 ----
encouraged to use this code in your own programs for fun
or for profit as you see fit. A simple comment in the code giving
credit would be courteous but is not required.
+
diff -c 'perl5.005_02/pod/perlform.pod' 'perl5.005_03/pod/perlform.pod'
Index: ./pod/perlform.pod
*** ./pod/perlform.pod Thu Jul 23 23:01:33 1998
--- ./pod/perlform.pod Fri Nov 13 20:01:25 1998
***************
*** 335,337 ****
--- 335,346 ----
block structure of the program, and, for historical reasons, formats
exist outside that block structure. See L<perllocale> for further
discussion of locale handling.
+
+ Inside of an expression, the whitespace characters \n, \t and \f are
+ considered to be equivalent to a single space. Thus, you could think
+ of this filter being applied to each value in the format:
+
+ $value =~ tr/\n\t\f/ /;
+
+ The remaining whitespace character, \r, forces the printing of a new
+ line if allowed by the picture line.
diff -c 'perl5.005_02/pod/perlfunc.pod' 'perl5.005_03/pod/perlfunc.pod'
Index: ./pod/perlfunc.pod
*** ./pod/perlfunc.pod Tue Aug 4 22:27:17 1998
--- ./pod/perlfunc.pod Sun Mar 28 10:13:19 1999
***************
*** 12,22 ****
take more than one argument. Thus, a comma terminates the argument of
a unary operator, but merely separates the arguments of a list
operator. A unary operator generally provides a scalar context to its
! argument, while a list operator may provide either scalar and list
contexts for its arguments. If it does both, the scalar arguments will
be first, and the list argument will follow. (Note that there can ever
! be only one list argument.) For instance, splice() has three scalar
! arguments followed by a list.
In the syntax descriptions that follow, list operators that expect a
list (and provide list context for the elements of the list) are shown
--- 12,23 ----
take more than one argument. Thus, a comma terminates the argument of
a unary operator, but merely separates the arguments of a list
operator. A unary operator generally provides a scalar context to its
! argument, while a list operator may provide either scalar or list
contexts for its arguments. If it does both, the scalar arguments will
be first, and the list argument will follow. (Note that there can ever
! be only one such list argument.) For instance, splice() has three scalar
! arguments followed by a list, whereas gethostbyname() has four scalar
! arguments.
In the syntax descriptions that follow, list operators that expect a
list (and provide list context for the elements of the list) are shown
***************
*** 47,52 ****
--- 48,58 ----
print (...) interpreted as function at - line 1.
Useless use of integer addition in void context at - line 1.
+ A few functions take no arguments at all, and therefore work as neither
+ unary nor list operators. These include such functions as C<time>
+ and C<endpwent>. For example, C<time+86_400> always means
+ C<time() + 86_400>.
+
For functions that can be used in either a scalar or list context,
nonabortive failure is generally indicated in a scalar context by
returning the undefined value, and in a list context by returning the
***************
*** 56,62 ****
the behavior of an expression in list context to its behavior in scalar
context, or vice versa. It might do two totally different things.
Each operator and function decides which sort of value it would be most
! appropriate to return in a scalar context. Some operators return the
length of the list that would have been returned in list context. Some
operators return the first value in the list. Some operators return the
last value in the list. Some operators return a count of successful
--- 62,68 ----
the behavior of an expression in list context to its behavior in scalar
context, or vice versa. It might do two totally different things.
Each operator and function decides which sort of value it would be most
! appropriate to return in scalar context. Some operators return the
length of the list that would have been returned in list context. Some
operators return the first value in the list. Some operators return the
last value in the list. Some operators return a count of successful
***************
*** 129,136 ****
=item Functions for filehandles, files, or directories
C<-I<X>>, C<chdir>, C<chmod>, C<chown>, C<chroot>, C<fcntl>, C<glob>,
! C<ioctl>, C<link>, C<lstat>, C<mkdir>, C<open>, C<opendir>, C<readlink>,
! C<rename>, C<rmdir>, C<stat>, C<symlink>, C<umask>, C<unlink>, C<utime>
=item Keywords related to the control flow of your perl program
--- 135,143 ----
=item Functions for filehandles, files, or directories
C<-I<X>>, C<chdir>, C<chmod>, C<chown>, C<chroot>, C<fcntl>, C<glob>,
! C<ioctl>, C<link>, C<lstat>, C<mkdir>, C<open>, C<opendir>,
! C<readlink>, C<rename>, C<rmdir>, C<stat>, C<symlink>, C<umask>,
! C<unlink>, C<utime>
=item Keywords related to the control flow of your perl program
***************
*** 206,211 ****
--- 213,246 ----
=back
+ =head2 Portability
+
+ Perl was born in Unix and can therefore access all common Unix
+ system calls. In non-Unix environments, the functionality of some
+ Unix system calls may not be available, or details of the available
+ functionality may differ slightly. The Perl functions affected
+ by this are:
+
+ C<-X>, C<binmode>, C<chmod>, C<chown>, C<chroot>, C<crypt>,
+ C<dbmclose>, C<dbmopen>, C<dump>, C<endgrent>, C<endhostent>,
+ C<endnetent>, C<endprotoent>, C<endpwent>, C<endservent>, C<exec>,
+ C<fcntl>, C<flock>, C<fork>, C<getgrent>, C<getgrgid>, C<gethostent>,
+ C<getlogin>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
+ C<getppid>, C<getprgp>, C<getpriority>, C<getprotobynumber>,
+ C<getprotoent>, C<getpwent>, C<getpwnam>, C<getpwuid>,
+ C<getservbyport>, C<getservent>, C<getsockopt>, C<glob>, C<ioctl>,
+ C<kill>, C<link>, C<lstat>, C<msgctl>, C<msgget>, C<msgrcv>,
+ C<msgsnd>, C<open>, C<pipe>, C<readlink>, C<rename>, C<select>, C<semctl>,
+ C<semget>, C<semop>, C<setgrent>, C<sethostent>, C<setnetent>,
+ C<setpgrp>, C<setpriority>, C<setprotoent>, C<setpwent>,
+ C<setservent>, C<setsockopt>, C<shmctl>, C<shmget>, C<shmread>,
+ C<shmwrite>, C<socket>, C<socketpair>, C<stat>, C<symlink>, C<syscall>,
+ C<sysopen>, C<system>, C<times>, C<truncate>, C<umask>, C<unlink>,
+ C<utime>, C<wait>, C<waitpid>
+
+ For more information about the portability of these functions, see
+ L<perlport> and other available platform-specific documentation.
+
=head2 Alphabetical Listing of Perl Functions
=over 8
***************
*** 262,276 ****
-A Same for access time.
-C Same for inode change time.
- The interpretation of the file permission operators C<-r>, C<-R>, C<-w>,
- C<-W>, C<-x>, and C<-X> is based solely on the mode of the file and the
- uids and gids of the user. There may be other reasons you can't actually
- read, write, or execute the file, such as AFS access control lists. Also note that, for the superuser,
- C<-r>, C<-R>, C<-w>, and C<-W> always return C<1>, and C<-x> and C<-X> return
- C<1> if any execute bit is set in the mode. Scripts run by the superuser may
- thus need to do a C<stat()> to determine the actual mode of the
- file, or temporarily set the uid to something else.
-
Example:
while (<>) {
--- 297,302 ----
***************
*** 279,284 ****
--- 305,324 ----
#...
}
+ The interpretation of the file permission operators C<-r>, C<-R>,
+ C<-w>, C<-W>, C<-x>, and C<-X> is by default based solely on the mode
+ of the file and the uids and gids of the user. There may be other
+ reasons you can't actually read, write, or execute the file. Such
+ reasons may be for example network filesystem access controls, ACLs
+ (access control lists), read-only filesystems, and unrecognized
+ executable formats.
+
+ Also note that, for the superuser on the local filesystems, the C<-r>,
+ C<-R>, C<-w>, and C<-W> tests always return 1, and C<-x> and C<-X> return 1
+ if any execute bit is set in the mode. Scripts run by the superuser
+ may thus need to do a stat() to determine the actual mode of the file,
+ or temporarily set their effective uid to something else.
+
Note that C<-s/a/b/> does not do a negated substitution. Saying
C<-exp($foo)> still works as expected, however--only single letters
following a minus are interpreted as file tests.
***************
*** 324,330 ****
Accepts an incoming socket connect, just as the accept(2) system call
does. Returns the packed address if it succeeded, FALSE otherwise.
! See example in L<perlipc/"Sockets: Client/Server Communication">.
=item alarm SECONDS
--- 364,370 ----
Accepts an incoming socket connect, just as the accept(2) system call
does. Returns the packed address if it succeeded, FALSE otherwise.
! See the example in L<perlipc/"Sockets: Client/Server Communication">.
=item alarm SECONDS
***************
*** 341,348 ****
on the previous timer.
For delays of finer granularity than one second, you may use Perl's
! C<syscall()> interface to access setitimer(2) if your system supports it,
! or else see L</select()>. It is usually a mistake to intermix C<alarm()>
and C<sleep()> calls.
If you want to use C<alarm()> to time out a system call you need to use an
--- 381,392 ----
on the previous timer.
For delays of finer granularity than one second, you may use Perl's
! four-arugment version of select() leaving the first three arguments
! undefined, or you might be able to use the C<syscall()> interface to
! access setitimer(2) if your system supports it. The Time::HiRes module
! from CPAN may also prove useful.
!
! It is usually a mistake to intermix C<alarm()>
and C<sleep()> calls.
If you want to use C<alarm()> to time out a system call you need to use an
***************
*** 384,411 ****
=item binmode FILEHANDLE
Arranges for the file to be read or written in "binary" mode in operating
! systems that distinguish between binary and text files. Files that are
! not in binary mode have CR LF sequences translated to LF on input and LF
! translated to CR LF on output. Binmode has no effect under Unix; in MS-DOS
! and similarly archaic systems, it may be imperative--otherwise your
! MS-DOS-damaged C library may mangle your file. The key distinction between
! systems that need C<binmode()> and those that don't is their text file
! formats. Systems like Unix, MacOS, and Plan9 that delimit lines with a single
! character, and that encode that character in C as C<"\n">, do not need
! C<binmode()>. The rest need it. If FILEHANDLE is an expression, the value
! is taken as the name of the filehandle.
=item bless REF,CLASSNAME
=item bless REF
! This function tells the thingy referenced by REF that it is now
! an object in the CLASSNAME package--or the current package if no CLASSNAME
! is specified, which is often the case. It returns the reference for
! convenience, because a C<bless()> is often the last thing in a constructor.
! Always use the two-argument version if the function doing the blessing
! might be inherited by a derived class. See L<perltoot> and L<perlobj>
! for more about the blessing (and blessings) of objects.
=item caller EXPR
--- 428,469 ----
=item binmode FILEHANDLE
Arranges for the file to be read or written in "binary" mode in operating
! systems that distinguish between binary and text files. Files that
! are not in binary mode have CR LF sequences translated to LF on input
! and LF translated to CR LF on output. Binmode has no effect under
! many sytems, but in MS-DOS and similarly archaic systems, it may be
! imperative--otherwise your MS-DOS-damaged C library may mangle your file.
! The key distinction between systems that need C<binmode()> and those
! that don't is their text file formats. Systems like Unix, MacOS, and
! Plan9 that delimit lines with a single character, and that encode that
! character in C as C<"\n">, do not need C<binmode()>. The rest may need it.
! If FILEHANDLE is an expression, the value is taken as the name of the
! filehandle.
!
! If the system does care about it, using it when you shouldn't is just as
! perilous as failing to use it when you should. Fortunately for most of
! us, you can't go wrong using binmode() on systems that don't care about
! it, though.
=item bless REF,CLASSNAME
=item bless REF
! This function tells the thingy referenced by REF that it is now an object
! in the CLASSNAME package. If CLASSNAME is omitted, the current package
! is used. Because a C<bless()> is often the last thing in a constructor.
! it returns the reference for convenience. Always use the two-argument
! version if the function doing the blessing might be inherited by a
! derived class. See L<perltoot> and L<perlobj> for more about the blessing
! (and blessings) of objects.
!
! Consider always blessing objects in CLASSNAMEs that are mixed case.
! Namespaces with all lowercase names are considered reserved for
! Perl pragmata. Builtin types have all uppercase names, so to prevent
! confusion, you may wish to avoid such package names as well. Make sure
! that CLASSNAME is a true value.
!
! See L<perlmod/"Perl Modules">.
=item caller EXPR
***************
*** 446,454 ****
=item chdir EXPR
! Changes the working directory to EXPR, if possible. If EXPR is
! omitted, changes to home directory. Returns TRUE upon success, FALSE
! otherwise. See example under C<die()>.
=item chmod LIST
--- 504,512 ----
=item chdir EXPR
! Changes the working directory to EXPR, if possible. If EXPR is omitted,
! changes to the user's home directory. Returns TRUE upon success,
! FALSE otherwise. See the example under C<die()>.
=item chmod LIST
***************
*** 471,484 ****
=item chomp
! This is a slightly safer version of L</chop>. It removes any
! line ending that corresponds to the current value of C<$/> (also known as
$INPUT_RECORD_SEPARATOR in the C<English> module). It returns the total
number of characters removed from all its arguments. It's often used to
remove the newline from the end of an input record when you're worried
! that the final record may be missing its newline. When in paragraph mode
! (C<$/ = "">), it removes all trailing newlines from the string. If
! VARIABLE is omitted, it chomps C<$_>. Example:
while (<>) {
chomp; # avoid \n on last field
--- 529,542 ----
=item chomp
! This safer version of L</chop> removes any trailing string
! that corresponds to the current value of C<$/> (also known as
$INPUT_RECORD_SEPARATOR in the C<English> module). It returns the total
number of characters removed from all its arguments. It's often used to
remove the newline from the end of an input record when you're worried
! that the final record may be missing its newline. When in paragraph
! mode (C<$/ = "">), it removes all trailing newlines from the string.
! If VARIABLE is omitted, it chomps C<$_>. Example:
while (<>) {
chomp; # avoid \n on last field
***************
*** 587,596 ****
If the file handle came from a piped open C<close()> will additionally
return FALSE if one of the other system calls involved fails or if the
program exits with non-zero status. (If the only problem was that the
! program exited non-zero C<$!> will be set to C<0>.) Also, closing a pipe
! waits for the process executing on the pipe to complete, in case you
! want to look at the output of the pipe afterwards. Closing a pipe
! explicitly also puts the exit status value of the command into C<$?>.
Example:
--- 645,654 ----
If the file handle came from a piped open C<close()> will additionally
return FALSE if one of the other system calls involved fails or if the
program exits with non-zero status. (If the only problem was that the
! program exited non-zero C<$!> will be set to C<0>.) Closing a pipe
! also waits for the process executing on the pipe to complete, in case you
! want to look at the output of the pipe afterwards, and
! implicitly puts the exit status value of that command into C<$?>.
Example:
***************
*** 673,691 ****
function. As a result, this function isn't all that useful for
cryptography. (For that, see your nearby CPAN mirror.)
Here's an example that makes sure that whoever runs this program knows
their own password:
$pwd = (getpwuid($<))[1];
- $salt = substr($pwd, 0, 2);
system "stty -echo";
print "Password: ";
! chop($word = <STDIN>);
print "\n";
system "stty echo";
! if (crypt($word, $salt) ne $pwd) {
die "Sorry...\n";
} else {
print "ok\n";
--- 731,755 ----
function. As a result, this function isn't all that useful for
cryptography. (For that, see your nearby CPAN mirror.)
+ When verifying an existing encrypted string you should use the encrypted
+ text as the salt (like C<crypt($plain, $crypted) eq $crypted>). This
+ allows your code to work with the standard C<crypt()> and with more
+ exotic implementations. When choosing a new salt create a random two
+ character string whose characters come from the set C<[./0-9A-Za-z]>
+ (like C<join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]>).
+
Here's an example that makes sure that whoever runs this program knows
their own password:
$pwd = (getpwuid($<))[1];
system "stty -echo";
print "Password: ";
! chomp($word = <STDIN>);
print "\n";
system "stty echo";
! if (crypt($word, $pwd) ne $pwd) {
die "Sorry...\n";
} else {
print "ok\n";
***************
*** 696,708 ****
=item dbmclose HASH
! [This function has been superseded by the C<untie()> function.]
Breaks the binding between a DBM file and a hash.
=item dbmopen HASH,DBNAME,MODE
! [This function has been superseded by the C<tie()> function.]
This binds a dbm(3), ndbm(3), sdbm(3), gdbm(3), or Berkeley DB file to a
hash. HASH is the name of the hash. (Unlike normal C<open()>, the first
--- 760,772 ----
=item dbmclose HASH
! [This function has been largely superseded by the C<untie()> function.]
Breaks the binding between a DBM file and a hash.
=item dbmopen HASH,DBNAME,MODE
! [This function has been largely superseded by the C<tie()> function.]
This binds a dbm(3), ndbm(3), sdbm(3), gdbm(3), or Berkeley DB file to a
hash. HASH is the name of the hash. (Unlike normal C<open()>, the first
***************
*** 735,740 ****
--- 799,811 ----
cons of the various dbm approaches, as well as L<DB_File> for a particularly
rich implementation.
+ You can control which DBM library you use by loading that library
+ before you call dbmopen():
+
+ use DB_File;
+ dbmopen(%NS_Hist, "$ENV{HOME}/.netscape/history.db")
+ or die "Can't open netscape history file: $!";
+
=item defined EXPR
=item defined
***************
*** 779,785 ****
The pattern match succeeds, and C<$1> is defined, despite the fact that it
matched "nothing". But it didn't really match nothing--rather, it
! matched something that happened to be C<0> characters long. This is all
very above-board and honest. When a function returns an undefined value,
it's an admission that it couldn't give you an honest answer. So you
should use C<defined()> only when you're questioning the integrity of what
--- 850,856 ----
The pattern match succeeds, and C<$1> is defined, despite the fact that it
matched "nothing". But it didn't really match nothing--rather, it
! matched something that happened to be zero characters long. This is all
very above-board and honest. When a function returns an undefined value,
it's an admission that it couldn't give you an honest answer. So you
should use C<defined()> only when you're questioning the integrity of what
***************
*** 825,833 ****
delete @HASH{keys %HASH}
! (But both of these are slower than just assigning the empty list, or
! using C<undef()>.) Note that the EXPR can be arbitrarily complicated as
! long as the final operation is a hash element lookup or hash slice:
delete $ref->[$x][$y]{$key};
delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys};
--- 896,909 ----
delete @HASH{keys %HASH}
! But both of these are slower than just assigning the empty list
! or undefining it:
!
! %hash = (); # completely empty %hash
! undef %hash; # forget %hash every existed
!
! Note that the EXPR can be arbitrarily complicated as long as the final
! operation is a hash element lookup or hash slice:
delete $ref->[$x][$y]{$key};
delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys};
***************
*** 848,854 ****
If the value of EXPR does not end in a newline, the current script line
number and input line number (if any) are also printed, and a newline
! is supplied. Hint: sometimes appending C<", stopped"> to your message
will cause it to make better sense when the string C<"at foo line 123"> is
appended. Suppose you are running script "canasta".
--- 924,935 ----
If the value of EXPR does not end in a newline, the current script line
number and input line number (if any) are also printed, and a newline
! is supplied. Note that the "input line number" (also known as "chunk")
! is subject to whatever notion of "line" happens to be currently in
! effect, and is also available as the special variable C<$.>.
! See L<perlvar/"$/"> and L<perlvar/"$.">.
!
! Hint: sometimes appending C<", stopped"> to your message
will cause it to make better sense when the string C<"at foo line 123"> is
appended. Suppose you are running script "canasta".
***************
*** 860,866 ****
/etc/games is no good at canasta line 123.
/etc/games is no good, stopped at canasta line 123.
! See also C<exit()> and C<warn()>.
If LIST is empty and C<$@> already contains a value (typically from a
previous eval) that value is reused after appending C<"\t...propagated">.
--- 941,947 ----
/etc/games is no good at canasta line 123.
/etc/games is no good, stopped at canasta line 123.
! See also exit(), warn(), and the Carp module.
If LIST is empty and C<$@> already contains a value (typically from a
previous eval) that value is reused after appending C<"\t...propagated">.
***************
*** 871,889 ****
If C<$@> is empty then the string C<"Died"> is used.
You can arrange for a callback to be run just before the C<die()> does
its deed, by setting the C<$SIG{__DIE__}> hook. The associated handler
will be called with the error text and can change the error message, if
it sees fit, by calling C<die()> again. See L<perlvar/$SIG{expr}> for details on
setting C<%SIG> entries, and L<"eval BLOCK"> for some examples.
! Note that the C<$SIG{__DIE__}> hook is called even inside eval()ed
! blocks/strings. If one wants the hook to do nothing in such
situations, put
die @_ if $^S;
! as the first line of the handler (see L<perlvar/$^S>).
=item do BLOCK
--- 952,993 ----
If C<$@> is empty then the string C<"Died"> is used.
+ die() can also be called with a reference argument. If this happens to be
+ trapped within an eval(), $@ contains the reference. This behavior permits
+ a more elaborate exception handling implementation using objects that
+ maintain arbitary state about the nature of the exception. Such a scheme
+ is sometimes preferable to matching particular string values of $@ using
+ regular expressions. Here's an example:
+
+ eval { ... ; die Some::Module::Exception->new( FOO => "bar" ) };
+ if ($@) {
+ if (ref($@) && UNIVERSAL::isa($@,"Some::Module::Exception")) {
+ # handle Some::Module::Exception
+ }
+ else {
+ # handle all other possible exceptions
+ }
+ }
+
+ Since perl will stringify uncaught exception messages before displaying
+ them, you may want to overload stringification operations on such custom
+ exception objects. See L<overload> for details about that.
+
You can arrange for a callback to be run just before the C<die()> does
its deed, by setting the C<$SIG{__DIE__}> hook. The associated handler
will be called with the error text and can change the error message, if
it sees fit, by calling C<die()> again. See L<perlvar/$SIG{expr}> for details on
setting C<%SIG> entries, and L<"eval BLOCK"> for some examples.
! Note that the C<$SIG{__DIE__}> hook is currently called even inside
! eval()ed blocks/strings! If one wants the hook to do nothing in such
situations, put
die @_ if $^S;
! as the first line of the handler (see L<perlvar/$^S>). Because this
! promotes action at a distance, this counterintuitive behavior may be fixed
! in a future release.
=item do BLOCK
***************
*** 892,897 ****
--- 996,1005 ----
modifier, executes the BLOCK once before testing the loop condition.
(On other statements the loop modifiers test the conditional first.)
+ C<do BLOCK> does I<not> count as a loop, so the loop control statements
+ C<next>, C<last>, or C<redo> cannot be used to leave or restart the block.
+ See L<perlsyn> for alternative strategies.
+
=item do SUBROUTINE(LIST)
A deprecated form of subroutine call. See L<perlsub>.
***************
*** 908,924 ****
scalar eval `cat stat.pl`;
! except that it's more efficient and concise, keeps track of the
! current filename for error messages, and searches all the B<-I>
! libraries if the file isn't in the current directory (see also the @INC
! array in L<perlvar/Predefined Names>). It is also different in how
! code evaluated with C<do FILENAME> doesn't see lexicals in the enclosing
! scope like C<eval STRING> does. It's the same, however, in that it does
! reparse the file every time you call it, so you probably don't want to
! do this inside a loop.
If C<do> cannot read the file, it returns undef and sets C<$!> to the
! error. If C<do> can read the file but cannot compile it, it
returns undef and sets an error message in C<$@>. If the file is
successfully compiled, C<do> returns the value of the last expression
evaluated.
--- 1016,1031 ----
scalar eval `cat stat.pl`;
! except that it's more efficient and concise, keeps track of the current
! filename for error messages, searches the @INC libraries, and updates
! C<%INC> if the file is found. See L<perlvar/Predefined Names> for these
! variables. It also differs in that code evaluated with C<do FILENAME>
! cannot see lexicals in the enclosing scope; C<eval STRING> does. It's the
! same, however, in that it does reparse the file every time you call it,
! so you probably don't want to do this inside a loop.
If C<do> cannot read the file, it returns undef and sets C<$!> to the
! error. If C<do> can read the file but cannot compile it, it
returns undef and sets an error message in C<$@>. If the file is
successfully compiled, C<do> returns the value of the last expression
evaluated.
***************
*** 932,938 ****
# read in config files: system first, then user
for $file ("/share/prog/defaults.rc",
! "$ENV{HOME}/.someprogrc") {
unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined $return;
--- 1039,1046 ----
# read in config files: system first, then user
for $file ("/share/prog/defaults.rc",
! "$ENV{HOME}/.someprogrc")
! {
unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined $return;
***************
*** 942,947 ****
--- 1050,1057 ----
=item dump LABEL
+ =item dump
+
This causes an immediate core dump. Primarily this is so that you can
use the B<undump> program to turn your core dump into an executable binary
after having initialized all your variables at the beginning of the
***************
*** 986,994 ****
false; you may wish to avoid constructs like C<while ($k = each %foo) {}>
for this reason.)
! Entries are returned in an apparently random order. When the hash is
! entirely read, a null array is returned in list context (which when
! assigned produces a FALSE (C<0>) value), and C<undef> in
scalar context. The next call to C<each()> after that will start iterating
again. There is a single iterator for each hash, shared by all C<each()>,
C<keys()>, and C<values()> function calls in the program; it can be reset by
--- 1096,1108 ----
false; you may wish to avoid constructs like C<while ($k = each %foo) {}>
for this reason.)
! Entries are returned in an apparently random order. The actual random
! order is subject to change in future versions of perl, but it is guaranteed
! to be in the same order as either the C<keys()> or C<values()> function
! would produce on the same (unmodified) hash.
!
! When the hash is entirely read, a null array is returned in list context
! (which when assigned produces a FALSE (C<0>) value), and C<undef> in
scalar context. The next call to C<each()> after that will start iterating
again. There is a single iterator for each hash, shared by all C<each()>,
C<keys()>, and C<values()> function calls in the program; it can be reset by
***************
*** 1003,1009 ****
print "$key=$value\n";
}
! See also C<keys()> and C<values()>.
=item eof FILEHANDLE
--- 1117,1123 ----
print "$key=$value\n";
}
! See also C<keys()>, C<values()> and C<sort()>.
=item eof FILEHANDLE
***************
*** 1020,1030 ****
as terminals may lose the end-of-file condition if you do.
An C<eof> without an argument uses the last file read as argument.
! Using C<eof()> with empty parentheses is very different. It indicates the pseudo file formed of
! the files listed on the command line, i.e., C<eof()> is reasonable to
! use inside a C<while (E<lt>E<gt>)> loop to detect the end of only the
! last file. Use C<eof(ARGV)> or eof without the parentheses to test
! I<EACH> file in a while (E<lt>E<gt>) loop. Examples:
# reset line numbering on each input file
while (<>) {
--- 1134,1144 ----
as terminals may lose the end-of-file condition if you do.
An C<eof> without an argument uses the last file read as argument.
! Using C<eof()> with empty parentheses is very different. It indicates
! the pseudo file formed of the files listed on the command line, i.e.,
! C<eof()> is reasonable to use inside a C<while (E<lt>E<gt>)> loop to
! detect the end of only the last file. Use C<eof(ARGV)> or eof without the
! parentheses to test I<EACH> file in a while (E<lt>E<gt>) loop. Examples:
# reset line numbering on each input file
while (<>) {
***************
*** 1038,1044 ****
while (<>) {
if (eof()) { # check for end of current file
print "--------------\n";
! close(ARGV); # close or break; is needed if we
# are reading from the terminal
}
print;
--- 1152,1158 ----
while (<>) {
if (eof()) { # check for end of current file
print "--------------\n";
! close(ARGV); # close or last; is needed if we
# are reading from the terminal
}
print;
***************
*** 1107,1116 ****
# a run-time error
eval '$answer ='; # sets $@
! When using the C<eval{}> form as an exception trap in libraries, you may
! wish not to trigger any C<__DIE__> hooks that user code may have
! installed. You can use the C<local $SIG{__DIE__}> construct for this
! purpose, as shown in this example:
# a very private exception trap for divide-by-zero
eval { local $SIG{'__DIE__'}; $answer = $a / $b; };
--- 1221,1231 ----
# a run-time error
eval '$answer ='; # sets $@
! Due to the current arguably broken state of C<__DIE__> hooks, when using
! the C<eval{}> form as an exception trap in libraries, you may wish not
! to trigger any C<__DIE__> hooks that user code may have installed.
! You can use the C<local $SIG{__DIE__}> construct for this purpose,
! as shown in this example:
# a very private exception trap for divide-by-zero
eval { local $SIG{'__DIE__'}; $answer = $a / $b; };
***************
*** 1127,1132 ****
--- 1242,1250 ----
print $@ if $@; # prints "bar lives here"
}
+ Because this promotes action at a distance, this counterintuive behavior
+ may be fixed in a future release.
+
With an C<eval()>, you should be especially careful to remember what's
being looked at when:
***************
*** 1150,1155 ****
--- 1268,1276 ----
particular situation, you can just use symbolic references instead, as
in case 6.
+ C<eval BLOCK> does I<not> count as a loop, so the loop control statements
+ C<next>, C<last>, or C<redo> cannot be used to leave or restart the block.
+
=item exec LIST
=item exec PROGRAM LIST
***************
*** 1207,1215 ****
@args = ( "echo surprise" );
! system @args; # subject to shell escapes
# if @args == 1
! system { $args[0] } @args; # safe even with one-arg list
The first version, the one without the indirect object, ran the I<echo>
program, passing it C<"surprise"> an argument. The second version
--- 1328,1336 ----
@args = ( "echo surprise" );
! exec @args; # subject to shell escapes
# if @args == 1
! exec { $args[0] } @args; # safe even with one-arg list
The first version, the one without the indirect object, ran the I<echo>
program, passing it C<"surprise"> an argument. The second version
***************
*** 1224,1232 ****
Returns TRUE if the specified hash key exists in its hash array, even
if the corresponding value is undefined.
! print "Exists\n" if exists $array{$key};
! print "Defined\n" if defined $array{$key};
! print "True\n" if $array{$key};
A hash element can be TRUE only if it's defined, and defined if
it exists, but the reverse doesn't necessarily hold true.
--- 1345,1353 ----
Returns TRUE if the specified hash key exists in its hash array, even
if the corresponding value is undefined.
! print "Exists\n" if exists $array{$key};
! print "Defined\n" if defined $array{$key};
! print "True\n" if $array{$key};
A hash element can be TRUE only if it's defined, and defined if
it exists, but the reverse doesn't necessarily hold true.
***************
*** 1234,1273 ****
Note that the EXPR can be arbitrarily complicated as long as the final
operation is a hash key lookup:
! if (exists $ref->{"A"}{"B"}{$key}) { ... }
! Although the last element will not spring into existence just because its
! existence was tested, intervening ones will. Thus C<$ref-E<gt>{"A"}>
! C<$ref-E<gt>{"B"}> will spring into existence due to the existence
! test for a $key element. This autovivification may be fixed in a later
release.
=item exit EXPR
! Evaluates EXPR and exits immediately with that value. (Actually, it
! calls any defined C<END> routines first, but the C<END> routines may not
! abort the exit. Likewise any object destructors that need to be called
! are called before exit.) Example:
$ans = <STDIN>;
exit 0 if $ans =~ /^[Xx]/;
See also C<die()>. If EXPR is omitted, exits with C<0> status. The only
! universally portable values for EXPR are C<0> for success and C<1> for error;
! all other values are subject to unpredictable interpretation depending
! on the environment in which the Perl program is running.
! You shouldn't use C<exit()> to abort a subroutine if there's any chance that
someone might want to trap whatever error happened. Use C<die()> instead,
which can be trapped by an C<eval()>.
! All C<END{}> blocks are run at exit time. See L<perlsub> for details.
=item exp EXPR
=item exp
! Returns I<e> (the natural logarithm base) to the power of EXPR.
If EXPR is omitted, gives C<exp($_)>.
=item fcntl FILEHANDLE,FUNCTION,SCALAR
--- 1355,1407 ----
Note that the EXPR can be arbitrarily complicated as long as the final
operation is a hash key lookup:
! if (exists $ref->{A}->{B}->{$key}) { }
! if (exists $hash{A}{B}{$key}) { }
!
! Although the last element will not spring into existence just because
! its existence was tested, intervening ones will. Thus C<$ref-E<gt>{"A"}>
! and C<$ref-E<gt>{"A"}-E<gt>{"B"}> will spring into existence due to the
! existence test for a $key element. This happens anywhere the arrow
! operator is used, including even
!
! undef $ref;
! if (exists $ref->{"Some key"}) { }
! print $ref; # prints HASH(0x80d3d5c)
! This surprising autovivification in what does not at first--or even
! second--glance appear to be an lvalue context may be fixed in a future
release.
=item exit EXPR
! Evaluates EXPR and exits immediately with that value. Example:
$ans = <STDIN>;
exit 0 if $ans =~ /^[Xx]/;
See also C<die()>. If EXPR is omitted, exits with C<0> status. The only
! universally recognized values for EXPR are C<0> for success and C<1>
! for error; other values are subject to interpretation depending on the
! environment in which the Perl program is running. For example, exiting
! 69 (EX_UNAVAILABLE) from a I<sendmail> incoming-mail filter will cause
! the mailer to return the item undelivered, but that's not true everywhere.
! Don't use C<exit()> to abort a subroutine if there's any chance that
someone might want to trap whatever error happened. Use C<die()> instead,
which can be trapped by an C<eval()>.
! The exit() function does not always exit immediately. It calls any
! defined C<END> routines first, but these C<END> routines may not
! themselves abort the exit. Likewise any object destructors that need to
! be called are called before the real exit. If this is a problem, you
! can call C<POSIX:_exit($status)> to avoid END and destructor processing.
! See L<perlsub> for details.
=item exp EXPR
=item exp
! Returns I<e> (the natural logarithm base) to the power of EXPR.
If EXPR is omitted, gives C<exp($_)>.
=item fcntl FILEHANDLE,FUNCTION,SCALAR
***************
*** 1284,1305 ****
fcntl($filehandle, F_GETFL, $packed_return_buffer)
or die "can't fcntl F_GETFL: $!";
! You don't have to check for C<defined()> on the return from
! C<fnctl()>. Like C<ioctl()>, it maps a C<0> return from the system
! call into "C<0> but true" in Perl. This string is true in
! boolean context and C<0> in numeric context. It is also
! exempt from the normal B<-w> warnings on improper numeric
! conversions.
Note that C<fcntl()> will produce a fatal error if used on a machine that
! doesn't implement fcntl(2).
=item fileno FILEHANDLE
! Returns the file descriptor for a filehandle. This is useful for
! constructing bitmaps for C<select()> and low-level POSIX tty-handling
! operations. If FILEHANDLE is an expression, the value is taken as
! an indirect filehandle, generally its name.
You can use this to find out whether two handles refer to the
same underlying descriptor:
--- 1418,1440 ----
fcntl($filehandle, F_GETFL, $packed_return_buffer)
or die "can't fcntl F_GETFL: $!";
! You don't have to check for C<defined()> on the return from C<fnctl()>.
! Like C<ioctl()>, it maps a C<0> return from the system call into "C<0>
! but true" in Perl. This string is true in boolean context and C<0>
! in numeric context. It is also exempt from the normal B<-w> warnings
! on improper numeric conversions.
Note that C<fcntl()> will produce a fatal error if used on a machine that
! doesn't implement fcntl(2). See the Fcntl module or your fcntl(2)
! manpage to learn what functions are available on your system.
=item fileno FILEHANDLE
! Returns the file descriptor for a filehandle, or undefined if the
! filehandle is not open. This is mainly useful for constructing
! bitmaps for C<select()> and low-level POSIX tty-handling operations.
! If FILEHANDLE is an expression, the value is taken as an indirect
! filehandle, generally its name.
You can use this to find out whether two handles refer to the
same underlying descriptor:
***************
*** 1310,1327 ****
=item flock FILEHANDLE,OPERATION
! Calls flock(2), or an emulation of it, on FILEHANDLE. Returns TRUE for
! success, FALSE on failure. Produces a fatal error if used on a machine
! that doesn't implement flock(2), fcntl(2) locking, or lockf(3). C<flock()>
! is Perl's portable file locking interface, although it locks only entire
! files, not records.
!
! On many platforms (including most versions or clones of Unix), locks
! established by C<flock()> are B<merely advisory>. Such discretionary locks
! are more flexible, but offer fewer guarantees. This means that files
! locked with C<flock()> may be modified by programs that do not also use
! C<flock()>. Windows NT and OS/2 are among the platforms which
! enforce mandatory locking. See your local documentation for details.
OPERATION is one of LOCK_SH, LOCK_EX, or LOCK_UN, possibly combined with
LOCK_NB. These constants are traditionally valued 1, 2, 8 and 4, but
--- 1445,1467 ----
=item flock FILEHANDLE,OPERATION
! Calls flock(2), or an emulation of it, on FILEHANDLE. Returns TRUE
! for success, FALSE on failure. Produces a fatal error if used on a
! machine that doesn't implement flock(2), fcntl(2) locking, or lockf(3).
! C<flock()> is Perl's portable file locking interface, although it locks
! only entire files, not records.
!
! Two potentially non-obvious but traditional C<flock> semantics are
! that it waits indefinitely until the lock is granted, and that its locks
! B<merely advisory>. Such discretionary locks are more flexible, but offer
! fewer guarantees. This means that files locked with C<flock()> may be
! modified by programs that do not also use C<flock()>. See L<perlport>,
! your port's specific documentation, or your system-specific local manpages
! for details. It's best to assume traditional behavior if you're writing
! portable programs. (But if you're not, you should as always feel perfectly
! free to write for your own system's idiosyncrasies (sometimes called
! "features"). Slavish adherence to portability concerns shouldn't get
! in the way of your getting your job done.)
OPERATION is one of LOCK_SH, LOCK_EX, or LOCK_UN, possibly combined with
LOCK_NB. These constants are traditionally valued 1, 2, 8 and 4, but
***************
*** 1332,1343 ****
LOCK_EX then C<flock()> will return immediately rather than blocking
waiting for the lock (check the return status to see if you got it).
! To avoid the possibility of mis-coordination, Perl flushes FILEHANDLE
! before (un)locking it.
Note that the emulation built with lockf(3) doesn't provide shared
locks, and it requires that FILEHANDLE be open with write intent. These
! are the semantics that lockf(3) implements. Most (all?) systems
implement lockf(3) in terms of fcntl(2) locking, though, so the
differing semantics shouldn't bite too many people.
--- 1472,1483 ----
LOCK_EX then C<flock()> will return immediately rather than blocking
waiting for the lock (check the return status to see if you got it).
! To avoid the possibility of miscoordination, Perl now flushes FILEHANDLE
! before locking or unlocking it.
Note that the emulation built with lockf(3) doesn't provide shared
locks, and it requires that FILEHANDLE be open with write intent. These
! are the semantics that lockf(3) implements. Most if not all systems
implement lockf(3) in terms of fcntl(2) locking, though, so the
differing semantics shouldn't bite too many people.
***************
*** 1370,1413 ****
print MBOX $msg,"\n\n";
unlock();
See also L<DB_File> for other flock() examples.
=item fork
! Does a fork(2) system call. Returns the child pid to the parent process,
! C<0> to the child process, or C<undef> if the fork is unsuccessful.
Note: unflushed buffers remain unflushed in both processes, which means
you may need to set C<$|> ($AUTOFLUSH in English) or call the C<autoflush()>
method of C<IO::Handle> to avoid duplicate output.
! If you C<fork()> without ever waiting on your children, you will accumulate
! zombies:
!
! $SIG{CHLD} = sub { wait };
!
! There's also the double-fork trick (error checking on
! C<fork()> returns omitted);
!
! unless ($pid = fork) {
! unless (fork) {
! exec "what you really wanna do";
! die "no exec";
! # ... or ...
! ## (some_perl_code_here)
! exit 0;
! }
! exit 0;
! }
! waitpid($pid,0);
!
! See also L<perlipc> for more examples of forking and reaping
! moribund children.
Note that if your forked child inherits system file descriptors like
STDIN and STDOUT that are actually connected by a pipe or socket, even
! if you exit, then the remote server (such as, say, httpd or rsh) won't think
! you're done. You should reopen those to F</dev/null> if it's any issue.
=item format
--- 1510,1546 ----
print MBOX $msg,"\n\n";
unlock();
+ On systems that support a real flock(), locks are inherited across fork()
+ calls, whereas those that must resort to the more capricious fcntl()
+ function lose the locks, making it harder to write servers.
+
See also L<DB_File> for other flock() examples.
=item fork
! Does a fork(2) system call to create a new process running the
! same program at the same point. It returns the child pid to the
! parent process, C<0> to the child process, or C<undef> if the fork is
! unsuccessful. File descriptors (and sometimes locks on those descriptors)
! are shared, while everything else is copied. On most systems supporting
! fork(), great care has gone into making it extremely efficient (for
! example, using copy-on-write technology on data pages), making it the
! dominant paradigm for multitasking over the last few decades.
Note: unflushed buffers remain unflushed in both processes, which means
you may need to set C<$|> ($AUTOFLUSH in English) or call the C<autoflush()>
method of C<IO::Handle> to avoid duplicate output.
! If you C<fork()> without ever waiting on your children, you will
! accumulate zombies. On some systems, you can avoid this by setting
! C<$SIG{CHLD}> to C<"IGNORE">. See also L<perlipc> for more examples of
! forking and reaping moribund children.
Note that if your forked child inherits system file descriptors like
STDIN and STDOUT that are actually connected by a pipe or socket, even
! if you exit, then the remote server (such as, say, a CGI script or a
! backgrounded job launced from a remote shell) won't think you're done.
! You should reopen those to F</dev/null> if it's any issue.
=item format
***************
*** 1450,1459 ****
=item getc
Returns the next character from the input file attached to FILEHANDLE,
! or the undefined value at end of file, or if there was an error. If
! FILEHANDLE is omitted, reads from STDIN. This is not particularly
! efficient. It cannot be used to get unbuffered single-characters,
! however. For that, try something more like:
if ($BSD_STYLE) {
system "stty cbreak </dev/tty >/dev/tty 2>&1";
--- 1583,1593 ----
=item getc
Returns the next character from the input file attached to FILEHANDLE,
! or the undefined value at end of file, or if there was an error.
! If FILEHANDLE is omitted, reads from STDIN. This is not particularly
! efficient. However, it cannot be used by itself to fetch single
! characters without waiting for the user to hit enter. For that, try
! something more like:
if ($BSD_STYLE) {
system "stty cbreak </dev/tty >/dev/tty 2>&1";
***************
*** 1475,1484 ****
Determination of whether $BSD_STYLE should be set
is left as an exercise to the reader.
! The C<POSIX::getattr()> function can do this more portably on systems
! purporting POSIX compliance.
! See also the C<Term::ReadKey> module from your nearest CPAN site;
! details on CPAN can be found on L<perlmod/CPAN>.
=item getlogin
--- 1609,1618 ----
Determination of whether $BSD_STYLE should be set
is left as an exercise to the reader.
! The C<POSIX::getattr()> function can do this more portably on
! systems purporting POSIX compliance. See also the C<Term::ReadKey>
! module from your nearest CPAN site; details on CPAN can be found on
! L<perlmodlib/CPAN>.
=item getlogin
***************
*** 1606,1626 ****
$name = getgrent();
#etc.
! In I<getpw*()> the fields C<$quota>, C<$comment>, and C<$expire> are special
! cases in the sense that in many systems they are unsupported. If the
! C<$quota> is unsupported, it is an empty scalar. If it is supported, it
! usually encodes the disk quota. If the C<$comment> field is unsupported,
! it is an empty scalar. If it is supported it usually encodes some
! administrative comment about the user. In some systems the $quota
! field may be C<$change> or C<$age>, fields that have to do with password
! aging. In some systems the C<$comment> field may be C<$class>. The C<$expire>
! field, if present, encodes the expiration period of the account or the
! password. For the availability and the exact meaning of these fields
! in your system, please consult your getpwnam(3) documentation and your
! F<pwd.h> file. You can also find out from within Perl which meaning
! your C<$quota> and C<$comment> fields have and whether you have the C<$expire>
! field by using the C<Config> module and the values C<d_pwquota>, C<d_pwage>,
! C<d_pwchange>, C<d_pwcomment>, and C<d_pwexpire>.
The C<$members> value returned by I<getgr*()> is a space separated list of
the login names of the members of the group.
--- 1740,1765 ----
$name = getgrent();
#etc.
! In I<getpw*()> the fields C<$quota>, C<$comment>, and C<$expire> are
! special cases in the sense that in many systems they are unsupported.
! If the C<$quota> is unsupported, it is an empty scalar. If it is
! supported, it usually encodes the disk quota. If the C<$comment>
! field is unsupported, it is an empty scalar. If it is supported it
! usually encodes some administrative comment about the user. In some
! systems the $quota field may be C<$change> or C<$age>, fields that have
! to do with password aging. In some systems the C<$comment> field may
! be C<$class>. The C<$expire> field, if present, encodes the expiration
! period of the account or the password. For the availability and the
! exact meaning of these fields in your system, please consult your
! getpwnam(3) documentation and your F<pwd.h> file. You can also find
! out from within Perl what your C<$quota> and C<$comment> fields mean
! and whether you have the C<$expire> field by using the C<Config> module
! and the values C<d_pwquota>, C<d_pwage>, C<d_pwchange>, C<d_pwcomment>,
! and C<d_pwexpire>. Shadow password files are only supported if your
! vendor has implemented them in the intuitive fashion that calling the
! regular C library routines gets the shadow versions if you're running
! under privilege. Those that incorrectly implement a separate library
! call are not supported.
The C<$members> value returned by I<getgr*()> is a space separated list of
the login names of the members of the group.
***************
*** 1634,1639 ****
--- 1773,1787 ----
($a,$b,$c,$d) = unpack('C4',$addr[0]);
+ The Socket library makes this slightly easier:
+
+ use Socket;
+ $iaddr = inet_aton("127.1"); # or whatever address
+ $name = gethostbyaddr($iaddr, AF_INET);
+
+ # or going the other way
+ $straddr = inet_ntoa($iaddr");
+
If you get tired of remembering which element of the return list contains
which return value, by-name interfaces are also provided in modules:
C<File::stat>, C<Net::hostent>, C<Net::netent>, C<Net::protoent>, C<Net::servent>,
***************
*** 1664,1674 ****
=item glob
! Returns the value of EXPR with filename expansions such as the standard Unix shell F</bin/sh> would
! do. This is the internal function implementing the C<E<lt>*.cE<gt>>
! operator, but you can use it directly. If EXPR is omitted, C<$_> is used.
! The C<E<lt>*.cE<gt>> operator is discussed in more detail in
! L<perlop/"I/O Operators">.
=item gmtime EXPR
--- 1812,1822 ----
=item glob
! Returns the value of EXPR with filename expansions such as the
! standard Unix shell F</bin/csh> would do. This is the internal function
! implementing the C<E<lt>*.cE<gt>> operator, but you can use it directly.
! If EXPR is omitted, C<$_> is used. The C<E<lt>*.cE<gt>> operator is
! discussed in more detail in L<perlop/"I/O Operators">.
=item gmtime EXPR
***************
*** 1681,1689 ****
gmtime(time);
All array elements are numeric, and come straight out of a struct tm.
! In particular this means that C<$mon> has the range C<0..11> and C<$wday> has
! the range C<0..6> with sunday as day C<0>. Also, C<$year> is the number of
! years since 1900, that is, C<$year> is C<123> in year 2023, I<not> simply the last two digits of the year.
If EXPR is omitted, does C<gmtime(time())>.
--- 1829,1840 ----
gmtime(time);
All array elements are numeric, and come straight out of a struct tm.
! In particular this means that C<$mon> has the range C<0..11> and C<$wday>
! has the range C<0..6> with sunday as day C<0>. Also, C<$year> is the
! number of years since 1900, that is, C<$year> is C<123> in year 2023,
! I<not> simply the last two digits of the year. If you assume it is,
! then you create non-Y2K-compliant programs--and you wouldn't want to do
! that, would you?
If EXPR is omitted, does C<gmtime(time())>.
***************
*** 1694,1711 ****
Also see the C<timegm()> function provided by the C<Time::Local> module,
and the strftime(3) function available via the POSIX module.
! This scalar value is B<not> locale dependent, see L<perllocale>, but
! instead a Perl builtin. Also see the C<Time::Local> module, and the
! strftime(3) and mktime(3) function available via the POSIX module. To
get somewhat similar but locale dependent date strings, set up your
locale environment variables appropriately (please see L<perllocale>)
and try for example:
use POSIX qw(strftime);
! $now_string = strftime "%a %b %e %H:%M:%S %Y", gmtime;
! Note that the C<%a> and C<%b>, the short forms of the day of the week
! and the month of the year, may not necessarily be three characters wide.
=item goto LABEL
--- 1845,1863 ----
Also see the C<timegm()> function provided by the C<Time::Local> module,
and the strftime(3) function available via the POSIX module.
! This scalar value is B<not> locale dependent (see L<perllocale>), but
! is instead a Perl builtin. Also see the C<Time::Local> module, and the
! strftime(3) and mktime(3) functions available via the POSIX module. To
get somewhat similar but locale dependent date strings, set up your
locale environment variables appropriately (please see L<perllocale>)
and try for example:
use POSIX qw(strftime);
! $now_string = strftime "%a %b %e %H:%M:%S %Y", gmtime;
! Note that the C<%a> and C<%b> escapes, which represent the short forms
! of the day of the week and the month of the year, may not necessarily
! be three characters wide in all locales.
=item goto LABEL
***************
*** 1741,1753 ****
=item grep EXPR,LIST
! This is similar in spirit to, but not the same as, grep(1)
! and its relatives. In particular, it is not limited to using
! regular expressions.
Evaluates the BLOCK or EXPR for each element of LIST (locally setting
C<$_> to each element) and returns the list value consisting of those
! elements for which the expression evaluated to TRUE. In a scalar
context, returns the number of times the expression was TRUE.
@foo = grep(!/^#/, @bar); # weed out comments
--- 1893,1904 ----
=item grep EXPR,LIST
! This is similar in spirit to, but not the same as, grep(1) and its
! relatives. In particular, it is not limited to using regular expressions.
Evaluates the BLOCK or EXPR for each element of LIST (locally setting
C<$_> to each element) and returns the list value consisting of those
! elements for which the expression evaluated to TRUE. In scalar
context, returns the number of times the expression was TRUE.
@foo = grep(!/^#/, @bar); # weed out comments
***************
*** 1756,1769 ****
@foo = grep {!/^#/} @bar; # weed out comments
! Note that, because C<$_> is a reference into the list value, it can be used
! to modify the elements of the array. While this is useful and
! supported, it can cause bizarre results if the LIST is not a named
! array. Similarly, grep returns aliases into the original list,
! much like the way that a for loop's index variable aliases the list
! elements. That is, modifying an element of a list returned by grep
! (for example, in a C<foreach>, C<map()> or another C<grep()>)
! actually modifies the element in the original list.
See also L</map> for an array composed of the results of the BLOCK or EXPR.
--- 1907,1920 ----
@foo = grep {!/^#/} @bar; # weed out comments
! Note that, because C<$_> is a reference into the list value, it can
! be used to modify the elements of the array. While this is useful and
! supported, it can cause bizarre results if the LIST is not a named array.
! Similarly, grep returns aliases into the original list, much as a for
! loop's index variable aliases the list elements. That is, modifying an
! element of a list returned by grep (for example, in a C<foreach>, C<map()>
! or another C<grep()>) actually modifies the element in the original list.
! This is usually something to be avoided when writing clear code.
See also L</map> for an array composed of the results of the BLOCK or EXPR.
***************
*** 1771,1779 ****
=item hex
! Interprets EXPR as a hex string and returns the corresponding
! value. (To convert strings that might start with either 0 or 0x
! see L</oct>.) If EXPR is omitted, uses C<$_>.
print hex '0xAf'; # prints '175'
print hex 'aF'; # same
--- 1922,1930 ----
=item hex
! Interprets EXPR as a hex string and returns the corresponding value.
! (To convert strings that might start with either 0, 0x, or 0b, see
! L</oct>.) If EXPR is omitted, uses C<$_>.
print hex '0xAf'; # prints '175'
print hex 'aF'; # same
***************
*** 1789,1817 ****
=item index STR,SUBSTR
! Returns the position of the first occurrence of SUBSTR in STR at or after
! POSITION. If POSITION is omitted, starts searching from the beginning of
! the string. The return value is based at C<0> (or whatever you've set the C<$[>
! variable to--but don't do that). If the substring is not found, returns
! one less than the base, ordinarily C<-1>.
=item int EXPR
=item int
Returns the integer portion of EXPR. If EXPR is omitted, uses C<$_>.
! You should not use this for rounding, because it truncates
! towards C<0>, and because machine representations of floating point
! numbers can sometimes produce counterintuitive results. Usually C<sprintf()> or C<printf()>,
! or the C<POSIX::floor> or C<POSIX::ceil> functions, would serve you better.
=item ioctl FILEHANDLE,FUNCTION,SCALAR
! Implements the ioctl(2) function. You'll probably have to say
require "ioctl.ph"; # probably in /usr/local/lib/perl/ioctl.ph
! first to get the correct function definitions. If F<ioctl.ph> doesn't
exist or doesn't have the correct definitions you'll have to roll your
own, based on your C header files such as F<E<lt>sys/ioctl.hE<gt>>.
(There is a Perl script called B<h2ph> that comes with the Perl kit that
--- 1940,1973 ----
=item index STR,SUBSTR
! The index function searches for one string within another, but without
! the wildcard-like behavior of a full regular-expression pattern match.
! It returns the position of the first occurrence of SUBSTR in STR at
! or after POSITION. If POSITION is omitted, starts searching from the
! beginning of the string. The return value is based at C<0> (or whatever
! you've set the C<$[> variable to--but don't do that). If the substring
! is not found, returns one less than the base, ordinarily C<-1>.
=item int EXPR
=item int
Returns the integer portion of EXPR. If EXPR is omitted, uses C<$_>.
! You should not use this function for rounding: one because it truncates
! towards C<0>, and two because machine representations of floating point
! numbers can sometimes produce counterintuitive results. For example,
! C<int(-6.725/0.025)> produces -268 rather than the correct -269; that's
! because it's really more like -268.99999999999994315658 instead. Usually,
! the C<sprintf()>, C<printf()>, or the C<POSIX::floor> and C<POSIX::ceil>
! functions will serve you better than will int().
=item ioctl FILEHANDLE,FUNCTION,SCALAR
! Implements the ioctl(2) function. You'll probably first have to say
require "ioctl.ph"; # probably in /usr/local/lib/perl/ioctl.ph
! to get the correct function definitions. If F<ioctl.ph> doesn't
exist or doesn't have the correct definitions you'll have to roll your
own, based on your C header files such as F<E<lt>sys/ioctl.hE<gt>>.
(There is a Perl script called B<h2ph> that comes with the Perl kit that
***************
*** 1847,1865 ****
still easily determine the actual value returned by the operating
system:
! ($retval = ioctl(...)) || ($retval = -1);
printf "System returned %d\n", $retval;
! The special string "C<0> but true" is excempt from B<-w> complaints
about improper numeric conversions.
=item join EXPR,LIST
! Joins the separate strings of LIST into a single string with
! fields separated by the value of EXPR, and returns the string.
! Example:
! $_ = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
See L</split>.
--- 2003,2020 ----
still easily determine the actual value returned by the operating
system:
! $retval = ioctl(...) || -1;
printf "System returned %d\n", $retval;
! The special string "C<0> but true" is exempt from B<-w> complaints
about improper numeric conversions.
=item join EXPR,LIST
! Joins the separate strings of LIST into a single string with fields
! separated by the value of EXPR, and returns that new string. Example:
! $rec = join(':', $login,$passwd,$uid,$gid,$gcos,$home,$shell);
See L</split>.
***************
*** 1867,1875 ****
Returns a list consisting of all the keys of the named hash. (In a
scalar context, returns the number of keys.) The keys are returned in
! an apparently random order, but it is the same order as either the
! C<values()> or C<each()> function produces (given that the hash has not been
! modified). As a side effect, it resets HASH's iterator.
Here is yet another way to print your environment:
--- 2022,2032 ----
Returns a list consisting of all the keys of the named hash. (In a
scalar context, returns the number of keys.) The keys are returned in
! an apparently random order. The actual random order is subject to
! change in future versions of perl, but it is guaranteed to be the same
! order as either the C<values()> or C<each()> function produces (given
! that the hash has not been modified). As a side effect, it resets
! HASH's iterator.
Here is yet another way to print your environment:
***************
*** 1885,1891 ****
print $key, '=', $ENV{$key}, "\n";
}
! To sort an array by value, you'll need to use a C<sort()> function.
Here's a descending numeric sort of a hash by its values:
foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
--- 2042,2048 ----
print $key, '=', $ENV{$key}, "\n";
}
! To sort a hash by value, you'll need to use a C<sort()> function.
Here's a descending numeric sort of a hash by its values:
foreach $key (sort { $hash{$b} <=> $hash{$a} } keys %hash) {
***************
*** 1899,1912 ****
keys %hash = 200;
! then C<%hash> will have at least 200 buckets allocated for it--256 of them, in fact, since
! it rounds up to the next power of two. These
buckets will be retained even if you do C<%hash = ()>, use C<undef
%hash> if you want to free the storage while C<%hash> is still in scope.
You can't shrink the number of buckets allocated for the hash using
C<keys()> in this way (but you needn't worry about doing this by accident,
as trying has no effect).
=item kill LIST
Sends a signal to a list of processes. The first element of
--- 2056,2071 ----
keys %hash = 200;
! then C<%hash> will have at least 200 buckets allocated for it--256 of them,
! in fact, since it rounds up to the next power of two. These
buckets will be retained even if you do C<%hash = ()>, use C<undef
%hash> if you want to free the storage while C<%hash> is still in scope.
You can't shrink the number of buckets allocated for the hash using
C<keys()> in this way (but you needn't worry about doing this by accident,
as trying has no effect).
+ See also C<each()>, C<values()> and C<sort()>.
+
=item kill LIST
Sends a signal to a list of processes. The first element of
***************
*** 1936,1941 ****
--- 2095,2104 ----
#...
}
+ C<last> cannot be used to exit a block which returns a value such as
+ C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
+ a grep() or map() operation.
+
See also L</continue> for an illustration of how C<last>, C<next>, and
C<redo> work.
***************
*** 1945,1951 ****
Returns an lowercased version of EXPR. This is the internal function
implementing the C<\L> escape in double-quoted strings.
! Respects current C<LC_CTYPE> locale if C<use locale> in force. See L<perllocale>.
If EXPR is omitted, uses C<$_>.
--- 2108,2114 ----
Returns an lowercased version of EXPR. This is the internal function
implementing the C<\L> escape in double-quoted strings.
! Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
If EXPR is omitted, uses C<$_>.
***************
*** 1955,1961 ****
Returns the value of EXPR with the first character lowercased. This is
the internal function implementing the C<\l> escape in double-quoted strings.
! Respects current C<LC_CTYPE> locale if C<use locale> in force. See L<perllocale>.
If EXPR is omitted, uses C<$_>.
--- 2118,2124 ----
Returns the value of EXPR with the first character lowercased. This is
the internal function implementing the C<\l> escape in double-quoted strings.
! Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
If EXPR is omitted, uses C<$_>.
***************
*** 1963,1992 ****
=item length
! Returns the length in bytes of the value of EXPR. If EXPR is
! omitted, returns length of C<$_>.
=item link OLDFILE,NEWFILE
Creates a new filename linked to the old filename. Returns TRUE for
! success, FALSE otherwise.
=item listen SOCKET,QUEUESIZE
Does the same thing that the listen system call does. Returns TRUE if
! it succeeded, FALSE otherwise. See example in L<perlipc/"Sockets: Client/Server Communication">.
=item local EXPR
A local modifies the listed variables to be local to the enclosing
block, file, or eval. If more than one value is listed, the list must
be placed in parentheses. See L<perlsub/"Temporary Values via local()">
for details, including issues with tied arrays and hashes.
- You really probably want to be using C<my()> instead, because C<local()> isn't
- what most people think of as "local". See L<perlsub/"Private Variables
- via my()"> for details.
-
=item localtime EXPR
Converts a time as returned by the time function to a 9-element array
--- 2126,2157 ----
=item length
! Returns the length in characters of the value of EXPR. If EXPR is
! omitted, returns length of C<$_>. Note that this cannot be used on
! an entire array or hash to find out how many elements these have.
! For that, use C<scalar @array> and C<scalar keys %hash> respectively.
=item link OLDFILE,NEWFILE
Creates a new filename linked to the old filename. Returns TRUE for
! success, FALSE otherwise.
=item listen SOCKET,QUEUESIZE
Does the same thing that the listen system call does. Returns TRUE if
! it succeeded, FALSE otherwise. See the example in L<perlipc/"Sockets: Client/Server Communication">.
=item local EXPR
+ You really probably want to be using C<my()> instead, because C<local()> isn't
+ what most people think of as "local". See L<perlsub/"Private Variables
+ via my()"> for details.
+
A local modifies the listed variables to be local to the enclosing
block, file, or eval. If more than one value is listed, the list must
be placed in parentheses. See L<perlsub/"Temporary Values via local()">
for details, including issues with tied arrays and hashes.
=item localtime EXPR
Converts a time as returned by the time function to a 9-element array
***************
*** 1998,2006 ****
localtime(time);
All array elements are numeric, and come straight out of a struct tm.
! In particular this means that C<$mon> has the range C<0..11> and C<$wday> has
! the range C<0..6> with sunday as day C<0>. Also, C<$year> is the number of
! years since 1900, that is, C<$year> is C<123> in year 2023, and I<not> simply the last two digits of the year.
If EXPR is omitted, uses the current time (C<localtime(time)>).
--- 2163,2174 ----
localtime(time);
All array elements are numeric, and come straight out of a struct tm.
! In particular this means that C<$mon> has the range C<0..11> and C<$wday>
! has the range C<0..6> with sunday as day C<0>. Also, C<$year> is the
! number of years since 1900, that is, C<$year> is C<123> in year 2023,
! and I<not> simply the last two digits of the year. If you assume it is,
! then you create non-Y2K-compliant programs--and you wouldn't want to do
! that, would you?
If EXPR is omitted, uses the current time (C<localtime(time)>).
***************
*** 2016,2022 ****
and try for example:
use POSIX qw(strftime);
! $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
Note that the C<%a> and C<%b>, the short forms of the day of the week
and the month of the year, may not necessarily be three characters wide.
--- 2184,2190 ----
and try for example:
use POSIX qw(strftime);
! $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;
Note that the C<%a> and C<%b>, the short forms of the day of the week
and the month of the year, may not necessarily be three characters wide.
***************
*** 2025,2032 ****
=item log
! Returns the natural logarithm (base I<e>) of EXPR. If EXPR is omitted, returns log
! of C<$_>.
=item lstat FILEHANDLE
--- 2193,2209 ----
=item log
! Returns the natural logarithm (base I<e>) of EXPR. If EXPR is omitted,
! returns log of C<$_>. To get the log of another base, use basic algebra:
! The base-N log of a number is is equal to the natural log of that number
! divided by the natural log of N. For example:
!
! sub log10 {
! my $n = shift;
! return log($n)/log(10);
! }
!
! See also L</exp> for the inverse operation.
=item lstat FILEHANDLE
***************
*** 2054,2059 ****
--- 2231,2238 ----
evaluation. Evaluates BLOCK or EXPR in a list context, so each element of LIST
may produce zero, one, or more elements in the returned value.
+ In scalar context, returns the total number of elements so generated.
+
@chars = map(chr, @nums);
translates a list of numbers to the corresponding characters. And
***************
*** 2067,2083 ****
$hash{getkey($_)} = $_;
}
! Note that, because C<$_> is a reference into the list value, it can be used
! to modify the elements of the array. While this is useful and
! supported, it can cause bizarre results if the LIST is not a named
! array. See also L</grep> for an array composed of those items of the
! original list for which the BLOCK or EXPR evaluates to true.
=item mkdir FILENAME,MODE
! Creates the directory specified by FILENAME, with permissions specified
! by MODE (as modified by umask). If it succeeds it returns TRUE, otherwise
! it returns FALSE and sets C<$!> (errno).
=item msgctl ID,CMD,ARG
--- 2246,2270 ----
$hash{getkey($_)} = $_;
}
! Note that, because C<$_> is a reference into the list value, it can
! be used to modify the elements of the array. While this is useful and
! supported, it can cause bizarre results if the LIST is not a named array.
! Using a regular C<foreach> loop for this purpose would be clearer in
! most cases. See also L</grep> for an array composed of those items of
! the original list for which the BLOCK or EXPR evaluates to true.
=item mkdir FILENAME,MODE
! Creates the directory specified by FILENAME, with permissions
! specified by MODE (as modified by C<umask>). If it succeeds it
! returns TRUE, otherwise it returns FALSE and sets C<$!> (errno).
!
! In general, it is better to create directories with permissive MODEs,
! and let the user modify that with their C<umask>, than it is to supply
! a restrictive MODE and give the user no way to be more permissive.
! The exceptions to this rule are when the file or directory should be
! kept private (mail files, for instance). The perlfunc(1) entry on
! C<umask> discusses the choice of MODE in more detail.
=item msgctl ID,CMD,ARG
***************
*** 2137,2142 ****
--- 2324,2333 ----
executed even on discarded lines. If the LABEL is omitted, the command
refers to the innermost enclosing loop.
+ C<next> cannot be used to exit a block which returns a value such as
+ C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
+ a grep() or map() operation.
+
See also L</continue> for an illustration of how C<last>, C<next>, and
C<redo> work.
***************
*** 2149,2156 ****
=item oct
Interprets EXPR as an octal string and returns the corresponding
! value. (If EXPR happens to start off with C<0x>, interprets it as
! a hex string instead.) The following will handle decimal, octal, and
hex in the standard Perl or C notation:
$val = oct($val) if $val =~ /^0/;
--- 2340,2348 ----
=item oct
Interprets EXPR as an octal string and returns the corresponding
! value. (If EXPR happens to start off with C<0x>, interprets it as a
! hex string. If EXPR starts off with C<0b>, it is interpreted as a
! binary string.) The following will handle decimal, binary, octal, and
hex in the standard Perl or C notation:
$val = oct($val) if $val =~ /^0/;
***************
*** 2170,2176 ****
variable of the same name as the FILEHANDLE contains the filename.
(Note that lexical variables--those declared with C<my()>--will not work
for this purpose; so if you're using C<my()>, specify EXPR in your call
! to open.)
If the filename begins with C<'E<lt>'> or nothing, the file is opened for input.
If the filename begins with C<'E<gt>'>, the file is truncated and opened for
--- 2362,2369 ----
variable of the same name as the FILEHANDLE contains the filename.
(Note that lexical variables--those declared with C<my()>--will not work
for this purpose; so if you're using C<my()>, specify EXPR in your call
! to open.) See L<perlopentut> for a kinder, gentler explanation of opening
! files.
If the filename begins with C<'E<lt>'> or nothing, the file is opened for input.
If the filename begins with C<'E<gt>'>, the file is truncated and opened for
***************
*** 2181,2187 ****
always preferred for read/write updates--the C<'+E<gt>'> mode would clobber the
file first. You can't usually use either read-write mode for updating
textfiles, since they have variable length records. See the B<-i>
! switch in L<perlrun> for a better approach.
The prefix and the filename may be separated with spaces.
These various prefixes correspond to the fopen(3) modes of C<'r'>, C<'r+'>, C<'w'>,
--- 2374,2381 ----
always preferred for read/write updates--the C<'+E<gt>'> mode would clobber the
file first. You can't usually use either read-write mode for updating
textfiles, since they have variable length records. See the B<-i>
! switch in L<perlrun> for a better approach. The file is created with
! permissions of C<0666> modified by the process' C<umask> value.
The prefix and the filename may be separated with spaces.
These various prefixes correspond to the fopen(3) modes of C<'r'>, C<'r+'>, C<'w'>,
***************
*** 2189,2195 ****
If the filename begins with C<'|'>, the filename is interpreted as a
command to which output is to be piped, and if the filename ends with a
! C<'|'>, the filename is interpreted See L<perlipc/"Using open() for IPC">
for more examples of this. (You are not allowed to C<open()> to a command
that pipes both in I<and> out, but see L<IPC::Open2>, L<IPC::Open3>,
and L<perlipc/"Bidirectional Communication"> for alternatives.)
--- 2383,2390 ----
If the filename begins with C<'|'>, the filename is interpreted as a
command to which output is to be piped, and if the filename ends with a
! C<'|'>, the filename is interpreted as a command which pipes output to
! us. See L<perlipc/"Using open() for IPC">
for more examples of this. (You are not allowed to C<open()> to a command
that pipes both in I<and> out, but see L<IPC::Open2>, L<IPC::Open3>,
and L<perlipc/"Bidirectional Communication"> for alternatives.)
***************
*** 2290,2296 ****
print STDOUT "stdout 2\n";
print STDERR "stderr 2\n";
-
If you specify C<'E<lt>&=N'>, where C<N> is a number, then Perl will do an
equivalent of C's C<fdopen()> of that file descriptor; this is more
parsimonious of file descriptors. For example:
--- 2485,2490 ----
***************
*** 2320,2326 ****
NOTE: On any operation that may do a fork, any unflushed buffers remain
unflushed in both processes, which means you may need to set C<$|> to
! avoid duplicate output.
Closing any piped filehandle causes the parent process to wait for the
child to finish, and returns the status value in C<$?>.
--- 2514,2522 ----
NOTE: On any operation that may do a fork, any unflushed buffers remain
unflushed in both processes, which means you may need to set C<$|> to
! avoid duplicate output. On systems that support a close-on-exec flag on
! files, the flag will be set for the newly opened file descriptor as
! determined by the value of $^F. See L<perlvar/$^F>.
Closing any piped filehandle causes the parent process to wait for the
child to finish, and returns the status value in C<$?>.
***************
*** 2370,2376 ****
$first; # Or here.
}
! See L</seek()> for some details about mixing reading and writing.
=item opendir DIRHANDLE,EXPR
--- 2566,2572 ----
$first; # Or here.
}
! See L</seek> for some details about mixing reading and writing.
=item opendir DIRHANDLE,EXPR
***************
*** 2392,2399 ****
sequence of characters that give the order and type of values, as
follows:
A An ascii string, will be space padded.
! a An ascii string, will be null padded.
b A bit string (ascending bit order, like vec()).
B A bit string (descending bit order).
h A hex string (low nybble first).
--- 2588,2597 ----
sequence of characters that give the order and type of values, as
follows:
+ a A string with arbitrary binary data, will be null padded.
A An ascii string, will be space padded.
! Z A null terminated (asciz) string, will be null padded.
!
b A bit string (ascending bit order, like vec()).
B A bit string (descending bit order).
h A hex string (low nybble first).
***************
*** 2409,2415 ****
i A signed integer value.
I An unsigned integer value.
! (This 'integer' is _at_least_ 32 bits wide. Its exact
size depends on what a local C compiler calls 'int',
and may even be larger than the 'long' described in
the next item.)
--- 2607,2613 ----
i A signed integer value.
I An unsigned integer value.
! (This 'integer' is _at least_ 32 bits wide. Its exact
size depends on what a local C compiler calls 'int',
and may even be larger than the 'long' described in
the next item.)
***************
*** 2426,2431 ****
--- 2624,2635 ----
(These 'shorts' and 'longs' are _exactly_ 16 bits and
_exactly_ 32 bits, respectively.)
+ q A signed quad (64-bit) value.
+ Q An unsigned quad value.
+ (Available only if your system supports 64-bit integer values
+ _and_ if Perl has been compiled to support those.
+ Causes a fatal error otherwise.)
+
f A single-precision float in the native format.
d A double-precision float in the native format.
***************
*** 2443,2478 ****
X Back up a byte.
@ Null fill to absolute position.
Each letter may optionally be followed by a number giving a repeat
! count. With all types except C<"a">, C<"A">, C<"b">, C<"B">, C<"h">, C<"H">, and C<"P"> the
! pack function will gobble up that many values from the LIST. A C<*> for the
! repeat count means to use however many items are left. The C<"a"> and C<"A">
! types gobble just one value, but pack it as a string of length count,
! padding with nulls or spaces as necessary. (When unpacking, C<"A"> strips
! trailing spaces and nulls, but C<"a"> does not.) Likewise, the C<"b"> and C<"B">
! fields pack a string that many bits long. The C<"h"> and C<"H"> fields pack a
! string that many nybbles long. The C<"p"> type packs a pointer to a null-
! terminated string. You are responsible for ensuring the string is not a
! temporary value (which can potentially get deallocated before you get
! around to using the packed result). The C<"P"> packs a pointer to a structure
! of the size indicated by the length. A NULL pointer is created if the
! corresponding value for C<"p"> or C<"P"> is C<undef>.
! Real numbers (floats and doubles) are
! in the native machine format only; due to the multiplicity of floating
! formats around, and the lack of a standard "network" representation, no
! facility for interchange has been made. This means that packed floating
! point data written on one machine may not be readable on another - even if
! both use IEEE floating point arithmetic (as the endian-ness of the memory
! representation is not part of the IEEE spec). Note that Perl uses doubles
! internally for all numeric calculation, and converting from double into
! float and thence back to double again will lose precision (i.e.,
! C<unpack("f", pack("f", $foo)>) will not in general equal C<$foo>).
Examples:
! $foo = pack("cccc",65,66,67,68);
# foo eq "ABCD"
! $foo = pack("c4",65,66,67,68);
# same thing
$foo = pack("ccxxcc",65,66,67,68);
--- 2647,2753 ----
X Back up a byte.
@ Null fill to absolute position.
+ The following rules apply:
+
+ =over 8
+
+ =item *
+
Each letter may optionally be followed by a number giving a repeat
! count. With all types except C<"a">, C<"A">, C<"Z">, C<"b">, C<"B">, C<"h">,
! C<"H">, and C<"P"> the pack function will gobble up that many values from
! the LIST. A C<*> for the repeat count means to use however many items are
! left.
!
! =item *
!
! The C<"a">, C<"A">, and C<"Z"> types gobble just one value, but pack it as a
! string of length count, padding with nulls or spaces as necessary. When
! unpacking, C<"A"> strips trailing spaces and nulls, C<"Z"> strips everything
! after the first null, and C<"a"> returns data verbatim.
!
! =item *
!
! Likewise, the C<"b"> and C<"B"> fields pack a string that many bits long.
!
! =item *
!
! The C<"h"> and C<"H"> fields pack a string that many nybbles long.
!
! =item *
!
! The C<"p"> type packs a pointer to a null-terminated string. You are
! responsible for ensuring the string is not a temporary value (which can
! potentially get deallocated before you get around to using the packed result).
! The C<"P"> type packs a pointer to a structure of the size indicated by the
! length. A NULL pointer is created if the corresponding value for C<"p"> or
! C<"P"> is C<undef>.
!
! =item *
!
! The integer formats C<"s">, C<"S">, C<"i">, C<"I">, C<"l">, and C<"L">
! are inherently non-portable between processors and operating systems
! because they obey the native byteorder and endianness. For example a
! 4-byte integer 0x87654321 (2271560481 decimal) be ordered natively
! (arranged in and handled by the CPU registers) into bytes as
!
! 0x12 0x34 0x56 0x78 # little-endian
! 0x78 0x56 0x34 0x12 # big-endian
!
! Basically, the Intel, Alpha, and VAX CPUs and little-endian, while
! everybody else, for example Motorola m68k/88k, PPC, Sparc, HP PA,
! Power, and Cray are big-endian. MIPS can be either: Digital used it
! in little-endian mode, SGI uses it in big-endian mode.
!
! The names `big-endian' and `little-endian' are joking references to
! the classic "Gulliver's Travels" (via the paper "On Holy Wars and a
! Plea for Peace" by Danny Cohen, USC/ISI IEN 137, April 1, 1980) and
! the egg-eating habits of the lilliputs.
!
! Some systems may even have weird byte orders such as
!
! 0x56 0x78 0x12 0x34
! 0x34 0x12 0x78 0x56
!
! You can see your system's preference with
!
! print join(" ", map { sprintf "%#02x", $_ }
! unpack("C*",pack("L",0x12345678))), "\n";
!
! The byteorder on the platform where Perl was built is also available
! via L<Config>:
!
! use Config;
! print $Config{byteorder}, "\n";
!
! Byteorders C<'1234'> and C<'12345678'> are little-endian, C<'4321'>
! and C<'87654321'> are big-endian.
!
! If you want portable packed integers use the formats C<"n">, C<"N">,
! C<"v">, and C<"V">, their byte endianness and size is known.
!
! =item *
!
! Real numbers (floats and doubles) are in the native machine format only;
! due to the multiplicity of floating formats around, and the lack of a
! standard "network" representation, no facility for interchange has been
! made. This means that packed floating point data written on one machine
! may not be readable on another - even if both use IEEE floating point
! arithmetic (as the endian-ness of the memory representation is not part
! of the IEEE spec).
!
! Note that Perl uses doubles internally for all numeric calculation, and
! converting from double into float and thence back to double again will
! lose precision (i.e., C<unpack("f", pack("f", $foo)>) will not in general
! equal C<$foo>).
!
! =back
Examples:
! $foo = pack("CCCC",65,66,67,68);
# foo eq "ABCD"
! $foo = pack("C4",65,66,67,68);
# same thing
$foo = pack("ccxxcc",65,66,67,68);
***************
*** 2494,2522 ****
$foo = pack("i9pl", gmtime);
# a real struct tm (on my system anyway)
sub bintodec {
unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}
! The same template may generally also be used in the unpack function.
=item package
=item package NAMESPACE
Declares the compilation unit as being in the given namespace. The scope
! of the package declaration is from the declaration itself through the end of
! the enclosing block (the same scope as the C<local()> operator). All further
! unqualified dynamic identifiers will be in this namespace. A package
! statement affects only dynamic variables--including those you've used
! C<local()> on--but I<not> lexical variables created with C<my()>. Typically it
! would be the first declaration in a file to be included by the C<require>
! or C<use> operator. You can switch into a package in more than one place;
! it merely influences which symbol table is used by the compiler for the
! rest of that block. You can refer to variables and filehandles in other
! packages by prefixing the identifier with the package name and a double
! colon: C<$Package::Variable>. If the package name is null, the C<main>
! package as assumed. That is, C<$::sail> is equivalent to C<$main::sail>.
If NAMESPACE is omitted, then there is no current package, and all
identifiers must be fully qualified or lexicals. This is stricter
--- 2769,2806 ----
$foo = pack("i9pl", gmtime);
# a real struct tm (on my system anyway)
+ $utmp_template = "Z8 Z8 Z16 L";
+ $utmp = pack($utmp_template, @utmp1);
+ # a struct utmp (BSDish)
+
+ @utmp2 = unpack($utmp_template, $utmp);
+ # "@utmp1" eq "@utmp2"
+
sub bintodec {
unpack("N", pack("B32", substr("0" x 32 . shift, -32)));
}
! The same template may generally also be used in unpack().
=item package
=item package NAMESPACE
Declares the compilation unit as being in the given namespace. The scope
! of the package declaration is from the declaration itself through the end
! of the enclosing block, file, or eval (the same as the C<my()> operator).
! All further unqualified dynamic identifiers will be in this namespace.
! A package statement affects only dynamic variables--including those
! you've used C<local()> on--but I<not> lexical variables, which are created
! with C<my()>. Typically it would be the first declaration in a file to
! be included by the C<require> or C<use> operator. You can switch into a
! package in more than one place; it merely influences which symbol table
! is used by the compiler for the rest of that block. You can refer to
! variables and filehandles in other packages by prefixing the identifier
! with the package name and a double colon: C<$Package::Variable>.
! If the package name is null, the C<main> package as assumed. That is,
! C<$::sail> is equivalent to C<$main::sail> (as well as to C<$main'sail>,
! still seen in older code).
If NAMESPACE is omitted, then there is no current package, and all
identifiers must be fully qualified or lexicals. This is stricter
***************
*** 2536,2554 ****
See L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication">
for examples of such things.
=item pop ARRAY
=item pop
Pops and returns the last value of the array, shortening the array by
! 1. Has a similar effect to
$tmp = $ARRAY[$#ARRAY--];
If there are no elements in the array, returns the undefined value.
! If ARRAY is omitted, pops the
! C<@ARGV> array in the main program, and the C<@_> array in subroutines, just
! like C<shift()>.
=item pos SCALAR
--- 2820,2841 ----
See L<IPC::Open2>, L<IPC::Open3>, and L<perlipc/"Bidirectional Communication">
for examples of such things.
+ On systems that support a close-on-exec flag on files, the flag will be set
+ for the newly opened file descriptors as determined by the value of $^F.
+ See L<perlvar/$^F>.
+
=item pop ARRAY
=item pop
Pops and returns the last value of the array, shortening the array by
! one element. Has a similar effect to
$tmp = $ARRAY[$#ARRAY--];
If there are no elements in the array, returns the undefined value.
! If ARRAY is omitted, pops the C<@ARGV> array in the main program, and
! the C<@_> array in subroutines, just like C<shift()>.
=item pos SCALAR
***************
*** 2568,2587 ****
Prints a string or a comma-separated list of strings. Returns TRUE
if successful. FILEHANDLE may be a scalar variable name, in which case
! the variable contains the name of or a reference to the filehandle, thus introducing one
! level of indirection. (NOTE: If FILEHANDLE is a variable and the next
! token is a term, it may be misinterpreted as an operator unless you
! interpose a C<+> or put parentheses around the arguments.) If FILEHANDLE is
! omitted, prints by default to standard output (or to the last selected
! output channel--see L</select>). If LIST is also omitted, prints C<$_> to
! the currently selected output channel. To set the default output channel to something other than
! STDOUT use the select operation. Note that, because print takes a
! LIST, anything in the LIST is evaluated in list context, and any
! subroutine that you call will have one or more of its expressions
! evaluated in list context. Also be careful not to follow the print
! keyword with a left parenthesis unless you want the corresponding right
! parenthesis to terminate the arguments to the print--interpose a C<+> or
! put parentheses around all the arguments.
Note that if you're storing FILEHANDLES in an array or other expression,
you will have to use a block returning its value instead:
--- 2855,2874 ----
Prints a string or a comma-separated list of strings. Returns TRUE
if successful. FILEHANDLE may be a scalar variable name, in which case
! the variable contains the name of or a reference to the filehandle, thus
! introducing one level of indirection. (NOTE: If FILEHANDLE is a variable
! and the next token is a term, it may be misinterpreted as an operator
! unless you interpose a C<+> or put parentheses around the arguments.)
! If FILEHANDLE is omitted, prints by default to standard output (or to the
! last selected output channel--see L</select>). If LIST is also omitted,
! prints C<$_> to the currently selected output channel. To set the default
! output channel to something other than STDOUT use the select operation.
! Note that, because print takes a LIST, anything in the LIST is evaluated
! in list context, and any subroutine that you call will have one or
! more of its expressions evaluated in list context. Also be careful
! not to follow the print keyword with a left parenthesis unless you want
! the corresponding right parenthesis to terminate the arguments to the
! print--interpose a C<+> or put parentheses around all the arguments.
Note that if you're storing FILEHANDLES in an array or other expression,
you will have to use a block returning its value instead:
***************
*** 2609,2620 ****
function has no prototype). FUNCTION is a reference to, or the name of,
the function whose prototype you want to retrieve.
! If FUNCTION is a string starting with C<CORE::>, the rest is taken as
! a name for Perl builtin. If builtin is not I<overridable> (such as
C<qw//>) or its arguments cannot be expressed by a prototype (such as
! C<system()>) - in other words, the builtin does not behave like a Perl
! function - returns C<undef>. Otherwise, the string describing the
! equivalent prototype is returned.
=item push ARRAY,LIST
--- 2896,2907 ----
function has no prototype). FUNCTION is a reference to, or the name of,
the function whose prototype you want to retrieve.
! If FUNCTION is a string starting with C<CORE::>, the rest is taken as a
! name for Perl builtin. If the builtin is not I<overridable> (such as
C<qw//>) or its arguments cannot be expressed by a prototype (such as
! C<system()>) returns C<undef> because the builtin does not really behave
! like a Perl function. Otherwise, the string describing the equivalent
! prototype is returned.
=item push ARRAY,LIST
***************
*** 2638,2644 ****
=item qw/STRING/
! Generalized quotes. See L<perlop>.
=item quotemeta EXPR
--- 2925,2931 ----
=item qw/STRING/
! Generalized quotes. See L<perlop/"Regexp Quote-Like Operators">.
=item quotemeta EXPR
***************
*** 2695,2704 ****
=item readline EXPR
! Reads from the filehandle whose typeglob is contained in EXPR. In scalar context, a single line
! is read and returned. In list context, reads until end-of-file is
! reached and returns a list of lines (however you've defined lines
! with C<$/> or C<$INPUT_RECORD_SEPARATOR>).
This is the internal function implementing the C<E<lt>EXPRE<gt>>
operator, but you can use it directly. The C<E<lt>EXPRE<gt>>
operator is discussed in more detail in L<perlop/"I/O Operators">.
--- 2982,2998 ----
=item readline EXPR
! Reads from the filehandle whose typeglob is contained in EXPR. In scalar
! context, each call reads and returns the next line, until end-of-file is
! reached, whereupon the subsequent call returns undef. In list context,
! reads until end-of-file is reached and returns a list of lines. Note that
! the notion of "line" used here is however you may have defined it
! with C<$/> or C<$INPUT_RECORD_SEPARATOR>). See L<perlvar/"$/">.
!
! When C<$/> is set to C<undef>, when readline() is in scalar
! context (i.e. file slurp mode), and when an empty file is read, it
! returns C<''> the first time, followed by C<undef> subsequently.
!
This is the internal function implementing the C<E<lt>EXPRE<gt>>
operator, but you can use it directly. The C<E<lt>EXPRE<gt>>
operator is discussed in more detail in L<perlop/"I/O Operators">.
***************
*** 2726,2732 ****
operator, but you can use it directly. The C<qx/EXPR/>
operator is discussed in more detail in L<perlop/"I/O Operators">.
! =item recv SOCKET,SCALAR,LEN,FLAGS
Receives a message on a socket. Attempts to receive LENGTH bytes of
data into variable SCALAR from the specified SOCKET filehandle.
--- 3020,3026 ----
operator, but you can use it directly. The C<qx/EXPR/>
operator is discussed in more detail in L<perlop/"I/O Operators">.
! =item recv SOCKET,SCALAR,LENGTH,FLAGS
Receives a message on a socket. Attempts to receive LENGTH bytes of
data into variable SCALAR from the specified SOCKET filehandle.
***************
*** 2763,2768 ****
--- 3057,3066 ----
print;
}
+ C<redo> cannot be used to retry a block which returns a value such as
+ C<eval {}>, C<sub {}> or C<do {}>, and should not be used to exit
+ a grep() or map() operation.
+
See also L</continue> for an illustration of how C<last>, C<next>, and
C<redo> work.
***************
*** 2788,2803 ****
if (ref($r) eq "HASH") {
print "r is a reference to a hash.\n";
}
! if (!ref($r)) {
print "r is not a reference at all.\n";
}
See also L<perlref>.
=item rename OLDNAME,NEWNAME
! Changes the name of a file. Returns C<1> for success, C<0> otherwise. Will
! not work across file system boundaries.
=item require EXPR
--- 3086,3109 ----
if (ref($r) eq "HASH") {
print "r is a reference to a hash.\n";
}
! unless (ref($r)) {
print "r is not a reference at all.\n";
}
+ if (UNIVERSAL::isa($r, "HASH")) { # for subclassing
+ print "r is a reference to something that isa hash.\n";
+ }
See also L<perlref>.
=item rename OLDNAME,NEWNAME
! Changes the name of a file. Returns C<1> for success, C<0> otherwise.
! Behavior of this function varies wildly depending on your system
! implementation. For example, it will usually not work across file system
! boundaries, even though the system I<mv> command sometimes compensates
! for this. Other restrictions include whether it works on directories,
! open files, or pre-existing files. Check L<perlport> and either the
! rename(2) manpage or equivalent system documentation for details.
=item require EXPR
***************
*** 2880,2891 ****
reset 'X'; # reset all X variables
reset 'a-z'; # reset lower case variables
! reset; # just reset ?? searches
Resetting C<"A-Z"> is not recommended because you'll wipe out your
! C<@ARGV> and C<@INC> arrays and your C<%ENV> hash. Resets only package variables--lexical variables
! are unaffected, but they clean themselves up on scope exit anyway,
! so you'll probably want to use them instead. See L</my>.
=item return EXPR
--- 3186,3198 ----
reset 'X'; # reset all X variables
reset 'a-z'; # reset lower case variables
! reset; # just reset ?one-time? searches
Resetting C<"A-Z"> is not recommended because you'll wipe out your
! C<@ARGV> and C<@INC> arrays and your C<%ENV> hash. Resets only package
! variables--lexical variables are unaffected, but they clean themselves
! up on scope exit anyway, so you'll probably want to use them instead.
! See L</my>.
=item return EXPR
***************
*** 2895,2923 ****
given in EXPR. Evaluation of EXPR may be in list, scalar, or void
context, depending on how the return value will be used, and the context
may vary from one execution to the next (see C<wantarray()>). If no EXPR
! is given, returns an empty list in list context, an undefined value in
! scalar context, or nothing in a void context.
! (Note that in the absence of a return, a subroutine, eval, or do FILE
! will automatically return the value of the last expression evaluated.)
=item reverse LIST
In list context, returns a list value consisting of the elements
of LIST in the opposite order. In scalar context, concatenates the
! elements of LIST, and returns a string value consisting of those bytes,
! but in the opposite order.
print reverse <>; # line tac, last line first
undef $/; # for efficiency of <>
! print scalar reverse <>; # byte tac, last line tsrif
This operator is also handy for inverting a hash, although there are some
caveats. If a value is duplicated in the original hash, only one of those
can be represented as a key in the inverted hash. Also, this has to
unwind one hash and build a whole new one, which may take some time
! on a large hash.
%by_name = reverse %by_address; # Invert the hash
--- 3202,3231 ----
given in EXPR. Evaluation of EXPR may be in list, scalar, or void
context, depending on how the return value will be used, and the context
may vary from one execution to the next (see C<wantarray()>). If no EXPR
! is given, returns an empty list in list context, the undefined value in
! scalar context, and (of course) nothing at all in a void context.
! (Note that in the absence of a explicit C<return>, a subroutine, eval,
! or do FILE will automatically return the value of the last expression
! evaluated.)
=item reverse LIST
In list context, returns a list value consisting of the elements
of LIST in the opposite order. In scalar context, concatenates the
! elements of LIST and returns a string value with all characters
! in the opposite order.
print reverse <>; # line tac, last line first
undef $/; # for efficiency of <>
! print scalar reverse <>; # character tac, last line tsrif
This operator is also handy for inverting a hash, although there are some
caveats. If a value is duplicated in the original hash, only one of those
can be represented as a key in the inverted hash. Also, this has to
unwind one hash and build a whole new one, which may take some time
! on a large hash, such as from a DBM file.
%by_name = reverse %by_address; # Invert the hash
***************
*** 2930,2936 ****
=item rindex STR,SUBSTR
! Works just like index except that it returns the position of the LAST
occurrence of SUBSTR in STR. If POSITION is specified, returns the
last occurrence at or before that position.
--- 3238,3244 ----
=item rindex STR,SUBSTR
! Works just like index() except that it returns the position of the LAST
occurrence of SUBSTR in STR. If POSITION is specified, returns the
last occurrence at or before that position.
***************
*** 2954,2964 ****
@counts = ( scalar @a, scalar @b, scalar @c );
There is no equivalent operator to force an expression to
! be interpolated in list context because it's in practice never
needed. If you really wanted to do so, however, you could use
the construction C<@{[ (some expression) ]}>, but usually a simple
C<(some expression)> suffices.
=item seek FILEHANDLE,POSITION,WHENCE
Sets FILEHANDLE's position, just like the C<fseek()> call of C<stdio()>.
--- 3262,3288 ----
@counts = ( scalar @a, scalar @b, scalar @c );
There is no equivalent operator to force an expression to
! be interpolated in list context because in practice, this is never
needed. If you really wanted to do so, however, you could use
the construction C<@{[ (some expression) ]}>, but usually a simple
C<(some expression)> suffices.
+ Since C<scalar> is a unary operator, if you accidentally use for EXPR a
+ parenthesized list, this behaves as a scalar comma expression, evaluating
+ all but the last element in void context and returning the final element
+ evaluated in scalar context. This is seldom what you want.
+
+ The following single statement:
+
+ print uc(scalar(&foo,$bar)),$baz;
+
+ is the moral equivalent of these two:
+
+ &foo;
+ print(uc($bar),$baz);
+
+ See L<perlop> for more details on unary operators and the comma operator.
+
=item seek FILEHANDLE,POSITION,WHENCE
Sets FILEHANDLE's position, just like the C<fseek()> call of C<stdio()>.
***************
*** 2973,2982 ****
C<seek()> -- buffering makes its effect on the file's system position
unpredictable and non-portable. Use C<sysseek()> instead.
! On some systems you have to do a seek whenever you switch between reading
! and writing. Amongst other things, this may have the effect of calling
! stdio's clearerr(3). A WHENCE of C<1> (C<SEEK_CUR>) is useful for not moving
! the file position:
seek(TEST,0,1);
--- 3297,3306 ----
C<seek()> -- buffering makes its effect on the file's system position
unpredictable and non-portable. Use C<sysseek()> instead.
! Due to the rules and rigors of ANSI C, on some systems you have to do a
! seek whenever you switch between reading and writing. Amongst other
! things, this may have the effect of calling stdio's clearerr(3).
! A WHENCE of C<1> (C<SEEK_CUR>) is useful for not moving the file position:
seek(TEST,0,1);
***************
*** 3123,3129 ****
of the same name. On unconnected sockets you must specify a
destination to send TO, in which case it does a C C<sendto()>. Returns
the number of characters sent, or the undefined value if there is an
! error.
See L<perlipc/"UDP: Message Passing"> for examples.
=item setpgrp PID,PGRP
--- 3447,3453 ----
of the same name. On unconnected sockets you must specify a
destination to send TO, in which case it does a C C<sendto()>. Returns
the number of characters sent, or the undefined value if there is an
! error. The C system call sendmsg(2) is currently unimplemented.
See L<perlipc/"UDP: Message Passing"> for examples.
=item setpgrp PID,PGRP
***************
*** 3132,3138 ****
process. Will produce a fatal error if used on a machine that doesn't
implement setpgrp(2). If the arguments are omitted, it defaults to
C<0,0>. Note that the POSIX version of C<setpgrp()> does not accept any
! arguments, so only setpgrp C<0,0> is portable.
=item setpriority WHICH,WHO,PRIORITY
--- 3456,3462 ----
process. Will produce a fatal error if used on a machine that doesn't
implement setpgrp(2). If the arguments are omitted, it defaults to
C<0,0>. Note that the POSIX version of C<setpgrp()> does not accept any
! arguments, so only C<setpgrp(0,0)> is portable. See also C<POSIX::setsid()>.
=item setpriority WHICH,WHO,PRIORITY
***************
*** 3188,3194 ****
hold the data read. When writing, if STRING is too long, only SIZE
bytes are used; if STRING is too short, nulls are written to fill out
SIZE bytes. Return TRUE if successful, or FALSE if there is an error.
! See also C<IPC::SysV> documentation.
=item shutdown SOCKET,HOW
--- 3512,3519 ----
hold the data read. When writing, if STRING is too long, only SIZE
bytes are used; if STRING is too short, nulls are written to fill out
SIZE bytes. Return TRUE if successful, or FALSE if there is an error.
! See also C<IPC::SysV> documentation and the C<IPC::Shareable> module
! from CPAN.
=item shutdown SOCKET,HOW
***************
*** 3235,3241 ****
For delays of finer granularity than one second, you may use Perl's
C<syscall()> interface to access setitimer(2) if your system supports it,
! or else see L</select()> above.
See also the POSIX module's C<sigpause()> function.
--- 3560,3566 ----
For delays of finer granularity than one second, you may use Perl's
C<syscall()> interface to access setitimer(2) if your system supports it,
! or else see L</select> above.
See also the POSIX module's C<sigpause()> function.
***************
*** 3244,3250 ****
Opens a socket of the specified kind and attaches it to filehandle
SOCKET. DOMAIN, TYPE, and PROTOCOL are specified the same as for the
system call of the same name. You should "C<use Socket;>" first to get
! the proper definitions imported. See the example in L<perlipc/"Sockets: Client/Server Communication">.
=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL
--- 3569,3575 ----
Opens a socket of the specified kind and attaches it to filehandle
SOCKET. DOMAIN, TYPE, and PROTOCOL are specified the same as for the
system call of the same name. You should "C<use Socket;>" first to get
! the proper definitions imported. See the examples in L<perlipc/"Sockets: Client/Server Communication">.
=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL
***************
*** 3583,3596 ****
=item sqrt
Return the square root of EXPR. If EXPR is omitted, returns square
! root of C<$_>.
=item srand EXPR
=item srand
Sets the random number seed for the C<rand()> operator. If EXPR is
! omitted, uses a semi-random value based on the current time and process
ID, among other things. In versions of Perl prior to 5.004 the default
seed was just the current C<time()>. This isn't a particularly good seed,
so many old programs supply their own seed value (often C<time ^ $$> or
--- 3908,3926 ----
=item sqrt
Return the square root of EXPR. If EXPR is omitted, returns square
! root of C<$_>. Only works on non-negative operands, unless you've
! loaded the standard Math::Complex module.
!
! use Math::Complex;
! print sqrt(-2); # prints 1.4142135623731i
=item srand EXPR
=item srand
Sets the random number seed for the C<rand()> operator. If EXPR is
! omitted, uses a semi-random value supplied by the kernel (if it supports
! the F</dev/urandom> device) or based on the current time and process
ID, among other things. In versions of Perl prior to 5.004 the default
seed was just the current C<time()>. This isn't a particularly good seed,
so many old programs supply their own seed value (often C<time ^ $$> or
***************
*** 3672,3681 ****
--- 4002,4027 ----
(This works on machines only for which the device number is negative under NFS.)
+ Because the mode contains both the file type and its permissions, you
+ should mask off the file type portion and (s)printf using a C<"%o">
+ if you want to see the real permissions.
+
+ $mode = (stat($filename))[2];
+ printf "Permissions are %04o\n", $mode & 07777;
+
+
In scalar context, C<stat()> returns a boolean value indicating success
or failure, and, if successful, sets the information associated with
the special filehandle C<_>.
+ The File::stat module provides a convenient, by-name access mechanism:
+
+ use File::stat;
+ $sb = stat($filename);
+ printf "File is %s, size is %s, perm %04o, mtime %s\n",
+ $filename, $sb->size, $sb->mode & 07777,
+ scalar localtime $sb->mtime;
+
=item study SCALAR
=item study
***************
*** 3701,3709 ****
while (<>) {
study;
! print ".IX foo\n" if /\bfoo\b/;
! print ".IX bar\n" if /\bbar\b/;
! print ".IX blurfl\n" if /\bblurfl\b/;
# ...
print;
}
--- 4047,4055 ----
while (<>) {
study;
! print ".IX foo\n" if /\bfoo\b/;
! print ".IX bar\n" if /\bbar\b/;
! print ".IX blurfl\n" if /\bblurfl\b/;
# ...
print;
}
***************
*** 3764,3779 ****
within the string is returned. If the substring is totally outside
the string a warning is produced.
! You can use the C<substr()> function
! as an lvalue, in which case EXPR must be an lvalue. If you assign
! something shorter than LEN, the string will shrink, and if you assign
! something longer than LEN, the string will grow to accommodate it. To
! keep the string the same length you may need to pad or chop your value
! using C<sprintf()>.
! An alternative to using C<substr()> as an lvalue is to specify the
replacement string as the 4th argument. This allows you to replace
! parts of the EXPR and return what was there before in one operation.
=item symlink OLDFILE,NEWFILE
--- 4110,4125 ----
within the string is returned. If the substring is totally outside
the string a warning is produced.
! You can use the substr() function as an lvalue, in which case EXPR
! must itself be an lvalue. If you assign something shorter than LEN,
! the string will shrink, and if you assign something longer than LEN,
! the string will grow to accommodate it. To keep the string the same
! length you may need to pad or chop your value using C<sprintf()>.
! An alternative to using substr() as an lvalue is to specify the
replacement string as the 4th argument. This allows you to replace
! parts of the EXPR and return what was there before in one operation,
! just as you can with splice().
=item symlink OLDFILE,NEWFILE
***************
*** 3782,3788 ****
symbolic links, produces a fatal error at run time. To check for that,
use eval:
! $symlink_exists = eval { symlink("",""); 1 };
=item syscall LIST
--- 4128,4134 ----
symbolic links, produces a fatal error at run time. To check for that,
use eval:
! $symlink_exists = eval { symlink("",""); 1 };
=item syscall LIST
***************
*** 3833,3876 ****
For historical reasons, some values work on almost every system
supported by perl: zero means read-only, one means write-only, and two
means read/write. We know that these values do I<not> work under
! OS/390 Unix and on the Macintosh; you probably don't want to use them
! in new code.
If the file named by FILENAME does not exist and the C<open()> call creates
it (typically because MODE includes the C<O_CREAT> flag), then the value of
PERMS specifies the permissions of the newly created file. If you omit
the PERMS argument to C<sysopen()>, Perl uses the octal value C<0666>.
These permission values need to be in octal, and are modified by your
! process's current C<umask>. The C<umask> value is a number representing
! disabled permissions bits--if your C<umask> were C<027> (group can't write;
! others can't read, write, or execute), then passing C<sysopen()> C<0666> would
! create a file with mode C<0640> (C<0666 &~ 027> is C<0640>).
!
! If you find this C<umask()> talk confusing, here's some advice: supply a
! creation mode of C<0666> for regular files and one of C<0777> for directories
! (in C<mkdir()>) and executable files. This gives users the freedom of
! choice: if they want protected files, they might choose process umasks
! of C<022>, C<027>, or even the particularly antisocial mask of C<077>. Programs
! should rarely if ever make policy decisions better left to the user.
! The exception to this is when writing files that should be kept private:
! mail files, web browser cookies, I<.rhosts> files, and so on. In short,
! seldom if ever use C<0644> as argument to C<sysopen()> because that takes
! away the user's option to have a more permissive umask. Better to omit it.
! The C<IO::File> module provides a more object-oriented approach, if you're
! into that kind of thing.
=item sysread FILEHANDLE,SCALAR,LENGTH,OFFSET
=item sysread FILEHANDLE,SCALAR,LENGTH
Attempts to read LENGTH bytes of data into variable SCALAR from the
! specified FILEHANDLE, using the system call read(2). It bypasses
! stdio, so mixing this with other kinds of reads, C<print()>, C<write()>,
! C<seek()>, or C<tell()> can cause confusion because stdio usually buffers
! data. Returns the number of bytes actually read, C<0> at end of file,
! or undef if there was an error. SCALAR will be grown or shrunk so that
! the last byte actually read is the last byte of the scalar after the read.
An OFFSET may be specified to place the read data at some place in the
string other than the beginning. A negative OFFSET specifies
--- 4179,4213 ----
For historical reasons, some values work on almost every system
supported by perl: zero means read-only, one means write-only, and two
means read/write. We know that these values do I<not> work under
! OS/390 & VM/ESA Unix and on the Macintosh; you probably don't want to
! use them in new code.
If the file named by FILENAME does not exist and the C<open()> call creates
it (typically because MODE includes the C<O_CREAT> flag), then the value of
PERMS specifies the permissions of the newly created file. If you omit
the PERMS argument to C<sysopen()>, Perl uses the octal value C<0666>.
These permission values need to be in octal, and are modified by your
! process's current C<umask>.
!
! You should seldom if ever use C<0644> as argument to C<sysopen()>, because
! that takes away the user's option to have a more permissive umask.
! Better to omit it. See the perlfunc(1) entry on C<umask> for more
! on this.
! See L<perlopentut> for a kinder, gentler explanation of opening files.
=item sysread FILEHANDLE,SCALAR,LENGTH,OFFSET
=item sysread FILEHANDLE,SCALAR,LENGTH
Attempts to read LENGTH bytes of data into variable SCALAR from the
! specified FILEHANDLE, using the system call read(2). It bypasses stdio,
! so mixing this with other kinds of reads, C<print()>, C<write()>,
! C<seek()>, C<tell()>, or C<eof()> can cause confusion because stdio
! usually buffers data. Returns the number of bytes actually read, C<0>
! at end of file, or undef if there was an error. SCALAR will be grown or
! shrunk so that the last byte actually read is the last byte of the
! scalar after the read.
An OFFSET may be specified to place the read data at some place in the
string other than the beginning. A negative OFFSET specifies
***************
*** 3879,3895 ****
in the string being padded to the required size with C<"\0"> bytes before
the result of the read is appended.
=item sysseek FILEHANDLE,POSITION,WHENCE
Sets FILEHANDLE's system position using the system call lseek(2). It
bypasses stdio, so mixing this with reads (other than C<sysread()>),
! C<print()>, C<write()>, C<seek()>, or C<tell()> may cause confusion. FILEHANDLE may
! be an expression whose value gives the name of the filehandle. The
! values for WHENCE are C<0> to set the new position to POSITION, C<1> to set
! the it to the current position plus POSITION, and C<2> to set it to EOF
! plus POSITION (typically negative). For WHENCE, you may use the
! constants C<SEEK_SET>, C<SEEK_CUR>, and C<SEEK_END> from either the C<IO::Seekable>
! or the POSIX module.
Returns the new position, or the undefined value on failure. A position
of zero is returned as the string "C<0> but true"; thus C<sysseek()> returns
--- 4216,4236 ----
in the string being padded to the required size with C<"\0"> bytes before
the result of the read is appended.
+ There is no syseof() function, which is ok, since eof() doesn't work
+ very well on device files (like ttys) anyway. Use sysread() and check
+ for a return value for 0 to decide whether you're done.
+
=item sysseek FILEHANDLE,POSITION,WHENCE
Sets FILEHANDLE's system position using the system call lseek(2). It
bypasses stdio, so mixing this with reads (other than C<sysread()>),
! C<print()>, C<write()>, C<seek()>, C<tell()>, or C<eof()> may cause
! confusion. FILEHANDLE may be an expression whose value gives the name
! of the filehandle. The values for WHENCE are C<0> to set the new
! position to POSITION, C<1> to set the it to the current position plus
! POSITION, and C<2> to set it to EOF plus POSITION (typically negative).
! For WHENCE, you may use the constants C<SEEK_SET>, C<SEEK_CUR>, and
! C<SEEK_END> from either the C<IO::Seekable> or the POSIX module.
Returns the new position, or the undefined value on failure. A position
of zero is returned as the string "C<0> but true"; thus C<sysseek()> returns
***************
*** 3900,3906 ****
=item system PROGRAM LIST
! Does exactly the same thing as "C<exec LIST>" except that a fork is done
first, and the parent process waits for the child process to complete.
Note that argument processing varies depending on the number of
arguments. If there is more than one argument in LIST, or if LIST is
--- 4241,4247 ----
=item system PROGRAM LIST
! Does exactly the same thing as "C<exec LIST>", except that a fork is done
first, and the parent process waits for the child process to complete.
Note that argument processing varies depending on the number of
arguments. If there is more than one argument in LIST, or if LIST is
***************
*** 3944,3957 ****
=item syswrite FILEHANDLE,SCALAR,LENGTH
Attempts to write LENGTH bytes of data from variable SCALAR to the
! specified FILEHANDLE, using the system call write(2). It bypasses
stdio, so mixing this with reads (other than C<sysread())>, C<print()>,
! C<write()>, C<seek()>, or C<tell()> may cause confusion because stdio usually
! buffers data. Returns the number of bytes actually written, or C<undef>
! if there was an error. If the LENGTH is greater than the available
! data in the SCALAR after the OFFSET, only as much data as is available
! will be written.
An OFFSET may be specified to write the data from some part of the
string other than the beginning. A negative OFFSET specifies writing
--- 4285,4301 ----
=item syswrite FILEHANDLE,SCALAR,LENGTH
+ =item syswrite FILEHANDLE,SCALAR
+
Attempts to write LENGTH bytes of data from variable SCALAR to the
! specified FILEHANDLE, using the system call write(2). If LENGTH is
! not specified, writes whole SCALAR. It bypasses
stdio, so mixing this with reads (other than C<sysread())>, C<print()>,
! C<write()>, C<seek()>, C<tell()>, or C<eof()> may cause confusion
! because stdio usually buffers data. Returns the number of bytes
! actually written, or C<undef> if there was an error. If the LENGTH is
! greater than the available data in the SCALAR after the OFFSET, only as
! much data as is available will be written.
An OFFSET may be specified to write the data from some part of the
string other than the beginning. A negative OFFSET specifies writing
***************
*** 3964,3970 ****
Returns the current position for FILEHANDLE. FILEHANDLE may be an
expression whose value gives the name of the actual filehandle. If
! FILEHANDLE is omitted, assumes the file last read.
=item telldir DIRHANDLE
--- 4308,4316 ----
Returns the current position for FILEHANDLE. FILEHANDLE may be an
expression whose value gives the name of the actual filehandle. If
! FILEHANDLE is omitted, assumes the file last read.
!
! There is no C<systell()> function. Use C<sysseek(FH, 0, 1)> for that.
=item telldir DIRHANDLE
***************
*** 3979,3989 ****
implementation for the variable. VARIABLE is the name of the variable
to be enchanted. CLASSNAME is the name of a class implementing objects
of correct type. Any additional arguments are passed to the "C<new()>"
! method of the class (meaning C<TIESCALAR>, C<TIEARRAY>, or C<TIEHASH>).
! Typically these are arguments such as might be passed to the C<dbm_open()>
! function of C. The object returned by the "C<new()>" method is also
! returned by the C<tie()> function, which would be useful if you want to
! access other methods in CLASSNAME.
Note that functions such as C<keys()> and C<values()> may return huge lists
when used on large objects, like DBM files. You may prefer to use the
--- 4325,4335 ----
implementation for the variable. VARIABLE is the name of the variable
to be enchanted. CLASSNAME is the name of a class implementing objects
of correct type. Any additional arguments are passed to the "C<new()>"
! method of the class (meaning C<TIESCALAR>, C<TIEHANDLE>, C<TIEARRAY>,
! or C<TIEHASH>). Typically these are arguments such as might be passed
! to the C<dbm_open()> function of C. The object returned by the "C<new()>"
! method is also returned by the C<tie()> function, which would be useful
! if you want to access other methods in CLASSNAME.
Note that functions such as C<keys()> and C<values()> may return huge lists
when used on large objects, like DBM files. You may prefer to use the
***************
*** 4000,4033 ****
A class implementing a hash should have the following methods:
TIEHASH classname, LIST
- DESTROY this
FETCH this, key
STORE this, key, value
DELETE this, key
EXISTS this, key
FIRSTKEY this
NEXTKEY this, lastkey
A class implementing an ordinary array should have the following methods:
TIEARRAY classname, LIST
- DESTROY this
FETCH this, key
STORE this, key, value
! [others TBD]
A class implementing a scalar should have the following methods:
TIESCALAR classname, LIST
- DESTROY this
FETCH this,
STORE this, value
Unlike C<dbmopen()>, the C<tie()> function will not use or require a module
for you--you need to do that explicitly yourself. See L<DB_File>
or the F<Config> module for interesting C<tie()> implementations.
! For further details see L<perltie>, L<tied VARIABLE>.
=item tied VARIABLE
--- 4346,4403 ----
A class implementing a hash should have the following methods:
TIEHASH classname, LIST
FETCH this, key
STORE this, key, value
DELETE this, key
+ CLEAR this
EXISTS this, key
FIRSTKEY this
NEXTKEY this, lastkey
+ DESTROY this
A class implementing an ordinary array should have the following methods:
TIEARRAY classname, LIST
FETCH this, key
STORE this, key, value
! FETCHSIZE this
! STORESIZE this, count
! CLEAR this
! PUSH this, LIST
! POP this
! SHIFT this
! UNSHIFT this, LIST
! SPLICE this, offset, length, LIST
! EXTEND this, count
! DESTROY this
!
! A class implementing a file handle should have the following methods:
!
! TIEHANDLE classname, LIST
! READ this, scalar, length, offset
! READLINE this
! GETC this
! WRITE this, scalar, length, offset
! PRINT this, LIST
! PRINTF this, format, LIST
! CLOSE this
! DESTROY this
A class implementing a scalar should have the following methods:
TIESCALAR classname, LIST
FETCH this,
STORE this, value
+ DESTROY this
+
+ Not all methods indicated above need be implemented. See L<perltie>,
+ L<Tie::Hash>, L<Tie::Array>, L<Tie::Scalar>, and L<Tie::Handle>.
Unlike C<dbmopen()>, the C<tie()> function will not use or require a module
for you--you need to do that explicitly yourself. See L<DB_File>
or the F<Config> module for interesting C<tie()> implementations.
! For further details see L<perltie>, L<"tied VARIABLE">.
=item tied VARIABLE
***************
*** 4070,4075 ****
--- 4440,4446 ----
Returns an uppercased version of EXPR. This is the internal function
implementing the C<\U> escape in double-quoted strings.
Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
+ (It does not attempt to do titlecase mapping on initial letters. See C<ucfirst()> for that.)
If EXPR is omitted, uses C<$_>.
***************
*** 4077,4083 ****
=item ucfirst
! Returns the value of EXPR with the first character uppercased. This is
the internal function implementing the C<\u> escape in double-quoted strings.
Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
--- 4448,4454 ----
=item ucfirst
! Returns the value of EXPR with the first character in uppercase. This is
the internal function implementing the C<\u> escape in double-quoted strings.
Respects current LC_CTYPE locale if C<use locale> in force. See L<perllocale>.
***************
*** 4090,4095 ****
--- 4461,4488 ----
Sets the umask for the process to EXPR and returns the previous value.
If EXPR is omitted, merely returns the current umask.
+ The Unix permission C<rwxr-x---> is represented as three sets of three
+ bits, or three octal digits: C<0750> (the leading 0 indicates octal
+ and isn't one of the digits). The C<umask> value is such a number
+ representing disabled permissions bits. The permission (or "mode")
+ values you pass C<mkdir> or C<sysopen> are modified by your umask, so
+ even if you tell C<sysopen> to create a file with permissions C<0777>,
+ if your umask is C<0022> then the file will actually be created with
+ permissions C<0755>. If your C<umask> were C<0027> (group can't
+ write; others can't read, write, or execute), then passing
+ C<sysopen()> C<0666> would create a file with mode C<0640> (C<0666 &~
+ 027> is C<0640>).
+
+ Here's some advice: supply a creation mode of C<0666> for regular
+ files (in C<sysopen()>) and one of C<0777> for directories (in
+ C<mkdir()>) and executable files. This gives users the freedom of
+ choice: if they want protected files, they might choose process umasks
+ of C<022>, C<027>, or even the particularly antisocial mask of C<077>.
+ Programs should rarely if ever make policy decisions better left to
+ the user. The exception to this is when writing files that should be
+ kept private: mail files, web browser cookies, I<.rhosts> files, and
+ so on.
+
If umask(2) is not implemented on your system and you are trying to
restrict access for I<yourself> (i.e., (EXPR & 0700) > 0), produces a
fatal error at run time. If umask(2) is not implemented and you are
***************
*** 4165,4178 ****
computes the same number as the System V sum program:
while (<>) {
! $checksum += unpack("%16C*", $_);
}
! $checksum %= 65536;
The following efficiently counts the number of set bits in a bit vector:
$setbits = unpack("%32b*", $selectmask);
=item untie VARIABLE
Breaks the binding between a variable and a package. (See C<tie()>.)
--- 4558,4573 ----
computes the same number as the System V sum program:
while (<>) {
! $checksum += unpack("%32C*", $_);
}
! $checksum %= 65535;
The following efficiently counts the number of set bits in a bit vector:
$setbits = unpack("%32b*", $selectmask);
+ See L</pack> for more examples.
+
=item untie VARIABLE
Breaks the binding between a variable and a package. (See C<tie()>.)
***************
*** 4280,4289 ****
Returns a list consisting of all the values of the named hash. (In a
scalar context, returns the number of values.) The values are
! returned in an apparently random order, but it is the same order as
! either the C<keys()> or C<each()> function would produce on the same hash.
! As a side effect, it resets HASH's iterator. See also C<keys()>, C<each()>,
! and C<sort()>.
=item vec EXPR,OFFSET,BITS
--- 4675,4694 ----
Returns a list consisting of all the values of the named hash. (In a
scalar context, returns the number of values.) The values are
! returned in an apparently random order. The actual random order is
! subject to change in future versions of perl, but it is guaranteed to
! be the same order as either the C<keys()> or C<each()> function would
! produce on the same (unmodified) hash.
!
! Note that you cannot modify the values of a hash this way, because the
! returned list is just a copy. You need to use a hash slice for that,
! since it's lvaluable in a way that values() is not.
!
! for (values %hash) { s/foo/bar/g } # FAILS!
! for (@hash{keys %hash}) { s/foo/bar/g } # ok
!
! As a side effect, calling values() resets the HASH's internal iterator.
! See also C<keys()>, C<each()>, and C<sort()>.
=item vec EXPR,OFFSET,BITS
***************
*** 4298,4304 ****
Vectors created with C<vec()> can also be manipulated with the logical
operators C<|>, C<&>, and C<^>, which will assume a bit vector operation is
! desired when both operands are strings.
The following code will build up an ASCII string saying C<'PerlPerlPerl'>.
The comments show the string after each step. Note that this code works
--- 4703,4709 ----
Vectors created with C<vec()> can also be manipulated with the logical
operators C<|>, C<&>, and C<^>, which will assume a bit vector operation is
! desired when both operands are strings. See L<perlop/"Bitwise String Operators">.
The following code will build up an ASCII string saying C<'PerlPerlPerl'>.
The comments show the string after each step. Note that this code works
***************
*** 4327,4354 ****
=item wait
! Waits for a child process to terminate and returns the pid of the
! deceased process, or C<-1> if there are no child processes. The status is
! returned in C<$?>.
=item waitpid PID,FLAGS
! Waits for a particular child process to terminate and returns the pid
! of the deceased process, or C<-1> if there is no such child process. The
! status is returned in C<$?>. If you say
use POSIX ":sys_wait_h";
#...
! waitpid(-1,&WNOHANG);
!
! then you can do a non-blocking wait for any process. Non-blocking wait
! is available on machines supporting either the waitpid(2) or
! wait4(2) system calls. However, waiting for a particular pid with
! FLAGS of C<0> is implemented everywhere. (Perl emulates the system call
! by remembering the status values of processes that have exited but have
! not been harvested by the Perl script yet.)
!
! See L<perlipc> for other examples.
=item wantarray
--- 4732,4766 ----
=item wait
! Behaves like the wait(2) system call on your system: it waits for a child
! process to terminate and returns the pid of the deceased process, or
! C<-1> if there are no child processes. The status is rketurned in C<$?>.
! Note that a return value of C<-1> could mean that child processes are
! being automatically reaped, as described in L<perlipc>.
=item waitpid PID,FLAGS
! Waits for a particular child process to terminate and returns the pid of
! the deceased process, or C<-1> if there is no such child process. On some
! systems, a value of 0 indicates that there are processes still running.
! The status is returned in C<$?>. If you say
use POSIX ":sys_wait_h";
#...
! do {
! $kid = waitpid(-1,&WNOHANG);
! } until $kid == -1;
!
! then you can do a non-blocking wait for all pending zombie processes.
! Non-blocking wait is available on machines supporting either the
! waitpid(2) or wait4(2) system calls. However, waiting for a particular
! pid with FLAGS of C<0> is implemented everywhere. (Perl emulates the
! system call by remembering the status values of processes that have
! exited but have not been harvested by the Perl script yet.)
!
! Note that on some systems, a return value of C<-1> could mean that child
! processes are being automatically reaped. See L<perlipc> for details,
! and for other examples.
=item wantarray
***************
*** 4401,4407 ****
warn "\$foo is alive and $foo!"; # does show up
See L<perlvar> for details on setting C<%SIG> entries, and for more
! examples.
=item write FILEHANDLE
--- 4813,4820 ----
warn "\$foo is alive and $foo!"; # does show up
See L<perlvar> for details on setting C<%SIG> entries, and for more
! examples. See the Carp module for other kinds of warnings using its
! carp() and cluck() functions.
=item write FILEHANDLE
diff -c 'perl5.005_02/pod/perlguts.pod' 'perl5.005_03/pod/perlguts.pod'
Index: ./pod/perlguts.pod
*** ./pod/perlguts.pod Thu Jul 23 23:01:39 1998
--- ./pod/perlguts.pod Sat Mar 27 15:58:43 1999
***************
*** 48,55 ****
void sv_setiv(SV*, IV);
void sv_setuv(SV*, UV);
void sv_setnv(SV*, double);
! void sv_setpv(SV*, char*);
! void sv_setpvn(SV*, char*, int)
void sv_setpvf(SV*, const char*, ...);
void sv_setpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool);
void sv_setsv(SV*, SV*);
--- 48,55 ----
void sv_setiv(SV*, IV);
void sv_setuv(SV*, UV);
void sv_setnv(SV*, double);
! void sv_setpv(SV*, const char*);
! void sv_setpvn(SV*, const char*, int)
void sv_setpvf(SV*, const char*, ...);
void sv_setpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool);
void sv_setsv(SV*, SV*);
***************
*** 68,74 ****
either a pointer to a variable argument list or the address and length of
an array of SVs. The last argument points to a boolean; on return, if that
boolean is true, then locale-specific information has been used to format
! the string, and the string's contents are therefore untrustworty (see
L<perlsec>). This pointer may be NULL if that information is not
important. Note that this function requires you to specify the length of
the format.
--- 68,74 ----
either a pointer to a variable argument list or the address and length of
an array of SVs. The last argument points to a boolean; on return, if that
boolean is true, then locale-specific information has been used to format
! the string, and the string's contents are therefore untrustworthy (see
L<perlsec>). This pointer may be NULL if that information is not
important. Note that this function requires you to specify the length of
the format.
***************
*** 95,103 ****
In the C<SvPV> macro, the length of the string returned is placed into the
variable C<len> (this is a macro, so you do I<not> use C<&len>). If you do not
! care what the length of the data is, use the global variable C<PL_na>. Remember,
! however, that Perl allows arbitrary strings of data that may both contain
! NULs and might not be terminated by a NUL.
If you want to know if the scalar value is TRUE, you can use:
--- 95,114 ----
In the C<SvPV> macro, the length of the string returned is placed into the
variable C<len> (this is a macro, so you do I<not> use C<&len>). If you do not
! care what the length of the data is, use the global variable C<PL_na> or a
! local variable of type C<STRLEN>. However using C<PL_na> can be quite
! inefficient because C<PL_na> must be accessed in thread-local storage in
! threaded Perl. In any case, remember that Perl allows arbitrary strings of
! data that may both contain NULs and might not be terminated by a NUL.
!
! Also remember that C doesn't allow you to safely say C<foo(SvPV(s, len),
! len);>. It might work with your compiler, but it won't work for everyone.
! Break this sort of statement up into separate assignments:
!
! STRLEN len;
! char * ptr;
! ptr = SvPV(len);
! foo(ptr, len);
If you want to know if the scalar value is TRUE, you can use:
***************
*** 138,144 ****
you can use the following functions:
void sv_catpv(SV*, char*);
! void sv_catpvn(SV*, char*, int);
void sv_catpvf(SV*, const char*, ...);
void sv_catpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool);
void sv_catsv(SV*, SV*);
--- 149,155 ----
you can use the following functions:
void sv_catpv(SV*, char*);
! void sv_catpvn(SV*, char*, STRLEN);
void sv_catpvf(SV*, const char*, ...);
void sv_catpvfn(SV*, const char*, STRLEN, va_list *, SV **, I32, bool);
void sv_catsv(SV*, SV*);
***************
*** 262,270 ****
The C<av_clear> function deletes all the elements in the AV* array, but
does not actually delete the array itself. The C<av_undef> function will
delete all the elements in the array plus the array itself. The
! C<av_extend> function extends the array so that it contains C<key>
! elements. If C<key> is less than the current length of the array, then
! nothing is done.
If you know the name of an array variable, you can get a pointer to its AV
by using the following:
--- 273,281 ----
The C<av_clear> function deletes all the elements in the AV* array, but
does not actually delete the array itself. The C<av_undef> function will
delete all the elements in the array plus the array itself. The
! C<av_extend> function extends the array so that it contains at least C<key+1>
! elements. If C<key+1> is less than the currently allocated length of the array,
! then nothing is done.
If you know the name of an array variable, you can get a pointer to its AV
by using the following:
***************
*** 350,360 ****
The hash algorithm is defined in the C<PERL_HASH(hash, key, klen)> macro:
- i = klen;
hash = 0;
! s = key;
! while (i--)
! hash = hash * 33 + *s++;
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use the hash access functions on tied hashes.
--- 361,369 ----
The hash algorithm is defined in the C<PERL_HASH(hash, key, klen)> macro:
hash = 0;
! while (klen--)
! hash = (hash * 33) + *key++;
See L<Understanding the Magic of Tied Hashes and Arrays> for more
information on how to use the hash access functions on tied hashes.
***************
*** 488,494 ****
Copies string into an SV whose reference is C<rv>. Set length to 0 to let
Perl calculate the string length. SV is blessed if C<classname> is non-null.
! SV* sv_setref_pvn(SV* rv, char* classname, PV iv, int length);
Tests whether the SV is blessed into the specified class. It does not
check inheritance relationships.
--- 497,503 ----
Copies string into an SV whose reference is C<rv>. Set length to 0 to let
Perl calculate the string length. SV is blessed if C<classname> is non-null.
! SV* sv_setref_pvn(SV* rv, char* classname, PV iv, STRLEN length);
Tests whether the SV is blessed into the specified class. It does not
check inheritance relationships.
***************
*** 861,867 ****
When the SV is read from or written to, the C<uf_val> or C<uf_set>
function will be called with C<uf_index> as the first arg and a
! pointer to the SV as the second.
Note that because multiple extensions may be using '~' or 'U' magic,
it is important for extensions to take extra care to avoid conflict.
--- 870,889 ----
When the SV is read from or written to, the C<uf_val> or C<uf_set>
function will be called with C<uf_index> as the first arg and a
! pointer to the SV as the second. A simple example of how to add 'U'
! magic is shown below. Note that the ufuncs structure is copied by
! sv_magic, so you can safely allocate it on the stack.
!
! void
! Umagic(sv)
! SV *sv;
! PREINIT:
! struct ufuncs uf;
! CODE:
! uf.uf_val = &my_get_fn;
! uf.uf_set = &my_set_fn;
! uf.uf_index = 0;
! sv_magic(sv, 0, 'U', (char*)&uf, sizeof(uf));
Note that because multiple extensions may be using '~' or 'U' magic,
it is important for extensions to take extra care to avoid conflict.
***************
*** 907,912 ****
--- 929,961 ----
you find yourself actually applying such information in this section, be
aware that the behavior may change in the future, umm, without warning.
+ The perl tie function associates a variable with an object that implements
+ the various GET, SET etc methods. To perform the equivalent of the perl
+ tie function from an XSUB, you must mimic this behaviour. The code below
+ carries out the necessary steps - firstly it creates a new hash, and then
+ creates a second hash which it blesses into the class which will implement
+ the tie methods. Lastly it ties the two hashes together, and returns a
+ reference to the new tied hash. Note that the code below does NOT call the
+ TIEHASH method in the MyTie class -
+ see L<Calling Perl Routines from within C Programs> for details on how
+ to do this.
+
+ SV*
+ mytie()
+ PREINIT:
+ HV *hash;
+ HV *stash;
+ SV *tie;
+ CODE:
+ hash = newHV();
+ tie = newRV_noinc((SV*)newHV());
+ stash = gv_stashpv("MyTie", TRUE);
+ sv_bless(tie, stash);
+ hv_magic(hash, tie, 'P');
+ RETVAL = newRV_noinc(hash);
+ OUTPUT:
+ RETVAL
+
The C<av_store> function, when given a tied array argument, merely
copies the magic of the array onto the value to be "stored", using
C<mg_copy>. It may also return NULL, indicating that the value did not
***************
*** 982,994 ****
I<pseudo-block>, and arrange for some changes to be automatically
undone at the end of it, either explicit, or via a non-local exit (via
die()). A I<block>-like construct is created by a pair of
! C<ENTER>/C<LEAVE> macros (see L<perlcall/EXAMPLE/"Returning a
! Scalar">). Such a construct may be created specially for some
! important localized task, or an existing one (like boundaries of
! enclosing Perl subroutine/block, or an existing pair for freeing TMPs)
! may be used. (In the second case the overhead of additional
! localization must be almost negligible.) Note that any XSUB is
! automatically enclosed in an C<ENTER>/C<LEAVE> pair.
Inside such a I<pseudo-block> the following service is available:
--- 1031,1043 ----
I<pseudo-block>, and arrange for some changes to be automatically
undone at the end of it, either explicit, or via a non-local exit (via
die()). A I<block>-like construct is created by a pair of
! C<ENTER>/C<LEAVE> macros (see L<perlcall/"Returning a Scalar">).
! Such a construct may be created specially for some important localized
! task, or an existing one (like boundaries of enclosing Perl
! subroutine/block, or an existing pair for freeing TMPs) may be
! used. (In the second case the overhead of additional localization must
! be almost negligible.) Note that any XSUB is automatically enclosed in
! an C<ENTER>/C<LEAVE> pair.
Inside such a I<pseudo-block> the following service is available:
***************
*** 1193,1199 ****
=head2 Memory Allocation
! It is suggested that you use the version of malloc that is distributed
with Perl. It keeps pools of various sizes of unallocated memory in
order to satisfy allocation requests more quickly. However, on some
platforms, it may cause spurious malloc or free errors.
--- 1242,1253 ----
=head2 Memory Allocation
! All memory meant to be used with the Perl API functions should be manipulated
! using the macros described in this section. The macros provide the necessary
! transparency between differences in the actual malloc implementation that is
! used within perl.
!
! It is suggested that you enable the version of malloc that is distributed
with Perl. It keeps pools of various sizes of unallocated memory in
order to satisfy allocation requests more quickly. However, on some
platforms, it may cause spurious malloc or free errors.
***************
*** 1460,1466 ****
with C<perl> be referenced with an explicit C<Perl_> prefix.
The sort order of the listing is case insensitive, with any
! occurrences of '_' ignored for the the purpose of sorting.
=over 8
--- 1514,1520 ----
with C<perl> be referenced with an explicit C<Perl_> prefix.
The sort order of the listing is case insensitive, with any
! occurrences of '_' ignored for the purpose of sorting.
=over 8
***************
*** 1594,1600 ****
variable which corresponds to Perl's $DB::sub variable. See C<PL_DBsingle>.
The sub name can be found by
! SvPV( GvSV( PL_DBsub ), PL_na )
=item PL_DBtrace
--- 1648,1654 ----
variable which corresponds to Perl's $DB::sub variable. See C<PL_DBsingle>.
The sub name can be found by
! SvPV( GvSV( PL_DBsub ), len )
=item PL_DBtrace
***************
*** 1731,1737 ****
=item gv_fetchmethod_autoload
Returns the glob which contains the subroutine to call to invoke the
! method on the C<stash>. In fact in the presense of autoloading this may
be the glob for "AUTOLOAD". In this case the corresponding variable
$AUTOLOAD is already setup.
--- 1785,1791 ----
=item gv_fetchmethod_autoload
Returns the glob which contains the subroutine to call to invoke the
! method on the C<stash>. In fact in the presence of autoloading this may
be the glob for "AUTOLOAD". In this case the corresponding variable
$AUTOLOAD is already setup.
***************
*** 1814,1820 ****
necessary dereferencing of possibly C<SV*> keys. The length of
the string is placed in C<len> (this is a macro, so do I<not> use
C<&len>). If you do not care about what the length of the key is,
! you may use the global variable C<PL_na>. Remember though, that hash
keys in perl are free to contain embedded nulls, so using C<strlen()>
or similar is not a good way to find the length of hash keys.
This is very similar to the C<SvPV()> macro described elsewhere in
--- 1868,1875 ----
necessary dereferencing of possibly C<SV*> keys. The length of
the string is placed in C<len> (this is a macro, so do I<not> use
C<&len>). If you do not care about what the length of the key is,
! you may use the global variable C<PL_na>, though this is rather less
! efficient than using a local variable. Remember though, that hash
keys in perl are free to contain embedded nulls, so using C<strlen()>
or similar is not a good way to find the length of hash keys.
This is very similar to the C<SvPV()> macro described elsewhere in
***************
*** 1855,1869 ****
void hv_clear (HV* tb)
- =item hv_delayfree_ent
-
- Releases a hash entry, such as while iterating though the hash, but
- delays actual freeing of key and value until the end of the current
- statement (or thereabouts) with C<sv_2mortal>. See C<hv_iternext>
- and C<hv_free_ent>.
-
- void hv_delayfree_ent (HV* hv, HE* entry)
-
=item hv_delete
Deletes a key/value pair in the hash. The value SV is removed from the hash
--- 1910,1915 ----
***************
*** 1923,1935 ****
HE* hv_fetch_ent (HV* tb, SV* key, I32 lval, U32 hash)
- =item hv_free_ent
-
- Releases a hash entry, such as while iterating though the hash. See
- C<hv_iternext> and C<hv_delayfree_ent>.
-
- void hv_free_ent (HV* hv, HE* entry)
-
=item hv_iterinit
Prepares a starting point to traverse a hash table.
--- 1969,1974 ----
***************
*** 2143,2148 ****
--- 2182,2195 ----
int mg_set (SV* sv)
+ =item modglobal
+
+ C<modglobal> is a general purpose, interpreter global HV for use by
+ extensions that need to keep information on a per-interpreter basis.
+ In a pinch, it can also be used as a symbol table for extensions
+ to share data among each other. It is a good idea to use keys
+ prefixed by the package name of the extension that owns the data.
+
=item Move
The XSUB-writer's interface to the C C<memmove> function. The C<s> is the
***************
*** 2153,2160 ****
=item PL_na
! A variable which may be used with C<SvPV> to tell Perl to calculate the
! string length.
=item New
--- 2200,2208 ----
=item PL_na
! A convenience variable which is typically used with C<SvPV> when one doesn't
! care about the length of the string. It is usually more efficient to
! declare a local variable and use that instead.
=item New
***************
*** 2632,2638 ****
Like C<sv_catpv>, but also handles 'set' magic.
! void sv_catpvn (SV* sv, char* ptr)
=item sv_catpvn
--- 2680,2686 ----
Like C<sv_catpv>, but also handles 'set' magic.
! void sv_catpv_mg (SV* sv, const char* ptr)
=item sv_catpvn
***************
*** 2703,2709 ****
Set the length of the string which is in the SV. See C<SvCUR>.
! void SvCUR_set (SV* sv, int val )
=item sv_dec
--- 2751,2757 ----
Set the length of the string which is in the SV. See C<SvCUR>.
! void SvCUR_set (SV* sv, int val)
=item sv_dec
***************
*** 2713,2725 ****
=item sv_derived_from
- Returns a boolean indicating whether the SV is a subclass of the
- specified class.
-
- int sv_derived_from(SV* sv, char* class)
-
- =item sv_derived_from
-
Returns a boolean indicating whether the SV is derived from the specified
class. This is the function that implements C<UNIVERSAL::isa>. It works
for class names as well as for objects.
--- 2761,2766 ----
***************
*** 2745,2751 ****
Invokes C<mg_get> on an SV if it has 'get' magic. This macro evaluates
its argument more than once.
! void SvGETMAGIC( SV *sv )
=item SvGROW
--- 2786,2792 ----
Invokes C<mg_get> on an SV if it has 'get' magic. This macro evaluates
its argument more than once.
! void SvGETMAGIC(SV *sv)
=item SvGROW
***************
*** 2754,2760 ****
trailing NUL character). Calls C<sv_grow> to perform the expansion if
necessary. Returns a pointer to the character buffer.
! char* SvGROW( SV* sv, int len )
=item sv_grow
--- 2795,2801 ----
trailing NUL character). Calls C<sv_grow> to perform the expansion if
necessary. Returns a pointer to the character buffer.
! char* SvGROW(SV* sv, STRLEN len)
=item sv_grow
***************
*** 2825,2837 ****
=item SvIV
! Returns the integer which is in the SV.
int SvIV (SV* sv)
=item SvIVX
! Returns the integer which is stored in the SV.
int SvIVX (SV* sv)
--- 2866,2878 ----
=item SvIV
! Coerces the given SV to an integer and returns it.
int SvIV (SV* sv)
=item SvIVX
! Returns the integer which is stored in the SV, assuming SvIOK is true.
int SvIVX (SV* sv)
***************
*** 2923,2935 ****
=item SvNV
! Returns the double which is stored in the SV.
double SvNV (SV* sv)
=item SvNVX
! Returns the double which is stored in the SV.
double SvNVX (SV* sv)
--- 2964,2976 ----
=item SvNV
! Coerce the given SV to a double and return it.
double SvNV (SV* sv)
=item SvNVX
! Returns the double which is stored in the SV, assuming SvNOK is true.
double SvNVX (SV* sv)
***************
*** 2982,2999 ****
=item SvPV
Returns a pointer to the string in the SV, or a stringified form of the SV
! if the SV does not contain a string. If C<len> is C<PL_na> then Perl will
! handle the length on its own. Handles 'get' magic.
! char* SvPV (SV* sv, int len )
=item SvPV_force
Like <SvPV> but will force the SV into becoming a string (SvPOK). You
want force if you are going to update the SvPVX directly.
! char* SvPV_force(SV* sv, int len)
!
=item SvPVX
--- 3023,3038 ----
=item SvPV
Returns a pointer to the string in the SV, or a stringified form of the SV
! if the SV does not contain a string. Handles 'get' magic.
! char* SvPV (SV* sv, STRLEN len)
=item SvPV_force
Like <SvPV> but will force the SV into becoming a string (SvPOK). You
want force if you are going to update the SvPVX directly.
! char* SvPV_force(SV* sv, STRLEN len)
=item SvPVX
***************
*** 3081,3093 ****
Copies a string into an SV. The string must be null-terminated.
Does not handle 'set' magic. See C<sv_setpv_mg>.
! void sv_setpv (SV* sv, char* ptr)
=item sv_setpv_mg
Like C<sv_setpv>, but also handles 'set' magic.
! void sv_setpv_mg (SV* sv, char* ptr)
=item sv_setpviv
--- 3120,3132 ----
Copies a string into an SV. The string must be null-terminated.
Does not handle 'set' magic. See C<sv_setpv_mg>.
! void sv_setpv (SV* sv, const char* ptr)
=item sv_setpv_mg
Like C<sv_setpv>, but also handles 'set' magic.
! void sv_setpv_mg (SV* sv, const char* ptr)
=item sv_setpviv
***************
*** 3107,3119 ****
Copies a string into an SV. The C<len> parameter indicates the number of
bytes to be copied. Does not handle 'set' magic. See C<sv_setpvn_mg>.
! void sv_setpvn (SV* sv, char* ptr, STRLEN len)
=item sv_setpvn_mg
Like C<sv_setpvn>, but also handles 'set' magic.
! void sv_setpvn_mg (SV* sv, char* ptr, STRLEN len)
=item sv_setpvf
--- 3146,3158 ----
Copies a string into an SV. The C<len> parameter indicates the number of
bytes to be copied. Does not handle 'set' magic. See C<sv_setpvn_mg>.
! void sv_setpvn (SV* sv, const char* ptr, STRLEN len)
=item sv_setpvn_mg
Like C<sv_setpvn>, but also handles 'set' magic.
! void sv_setpvn_mg (SV* sv, const char* ptr, STRLEN len)
=item sv_setpvf
***************
*** 3361,3373 ****
=item SvUV
! Returns the unsigned integer which is in the SV.
UV SvUV(SV* sv)
=item SvUVX
! Returns the unsigned integer which is stored in the SV.
UV SvUVX(SV* sv)
--- 3400,3412 ----
=item SvUV
! Coerces the given SV to an unsigned integer and returns it.
UV SvUV(SV* sv)
=item SvUVX
! Returns the unsigned integer which is stored in the SV, assuming SvIOK is true.
UV SvUVX(SV* sv)
diff -c 'perl5.005_02/pod/perlhist.pod' 'perl5.005_03/pod/perlhist.pod'
Index: ./pod/perlhist.pod
Prereq: 1.48
*** ./pod/perlhist.pod Fri Aug 7 22:37:10 1998
--- ./pod/perlhist.pod Sun Mar 28 16:29:59 1999
***************
*** 4,13 ****
perlhist - the Perl history records
! =for RCS
#
! # $Id: perlhist.pod,v 1.48 1998/08/03 08:50:12 jhi Exp $
#
=end RCS
=head1 DESCRIPTION
--- 4,15 ----
perlhist - the Perl history records
! =begin RCS
!
#
! # $Id: perlhist.pod,v 1.57 1999/01/26 17:38:07 jhi Exp $
#
+
=end RCS
=head1 DESCRIPTION
***************
*** 265,270 ****
--- 267,276 ----
5.004_04-m3 1998-May-15
5.004_04-m4 1998-May-19
5.004_04-MT5 1998-Jul-21
+ 5.004_04-MT6 1998-Oct-09
+ 5.004_04-MT7 1998-Nov-22
+ 5.004_04-MT8 1998-Dec-03
+ 5.004_04-MT9 1999-***-**
Malcolm 5.004_50 1997-Sep-09 The 5.005 development track.
5.004_51 1997-Oct-02
***************
*** 299,307 ****
5.005_02-T1 1998-Aug-02
5.005_02-T2 1998-Aug-05
5.005_02 1998-Aug-08
! Graham 5.005_03 1998-
Sarathy 5.005_50 1998-Jul-26 The 5.006 development track.
=head2 SELECTED RELEASE SIZES
--- 305,325 ----
5.005_02-T1 1998-Aug-02
5.005_02-T2 1998-Aug-05
5.005_02 1998-Aug-08
! Graham 5.005_03-MT1 1998-Nov-30
! 5.005_03-MT2 1999-Jan-04
! 5.005_03-MT3 1999-Jan-17
! 5.005_03-MT4 1999-Jan-26
! 5.005_03-MT5 1999-Jan-28
! 5.005_03-MT6 1999-Mar-04
! 5.005_03 1999-Mar-28
Sarathy 5.005_50 1998-Jul-26 The 5.006 development track.
+ 5.005_51 1998-Aug-10
+ 5.005_52 1998-Sep-25
+ 5.005_53 1998-Oct-31
+ 5.005_54 1998-Nov-30
+ 5.005_55 1999-Feb-16
+ 5.005_56 1999-Mar-01
=head2 SELECTED RELEASE SIZES
***************
*** 447,457 ****
applied on top of the 5.003_07 (or whatever was before the 5.003_08)
added lines for 110 kilobytes, it removed lines for 19 kilobytes, and
changed lines for 424 kilobytes. Just the lines themselves are
! counted, not their context. The "+ - !" become from the diff(1)s
context diff output format.
Pump- Release Date diff lines kB
! king + - !
===========================================================================
Chip 5.003_08 1996-Nov-19 110 19 424
--- 465,476 ----
applied on top of the 5.003_07 (or whatever was before the 5.003_08)
added lines for 110 kilobytes, it removed lines for 19 kilobytes, and
changed lines for 424 kilobytes. Just the lines themselves are
! counted, not their context. The "+ - !" become from the diff(1)
context diff output format.
Pump- Release Date diff lines kB
! king -------------
! + - !
===========================================================================
Chip 5.003_08 1996-Nov-19 110 19 424
diff -c 'perl5.005_02/pod/perlipc.pod' 'perl5.005_03/pod/perlipc.pod'
Index: ./pod/perlipc.pod
*** ./pod/perlipc.pod Thu Jul 23 23:01:40 1998
--- ./pod/perlipc.pod Sat Mar 27 16:01:12 1999
***************
*** 56,62 ****
You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
the handler, in which case Perl will try to discard the signal or do the
! default thing. Some signals can be neither trapped nor ignored, such as
the KILL and STOP (but not the TSTP) signals. One strategy for
temporarily ignoring signals is to use a local() statement, which will be
automatically restored once your block is exited. (Remember that local()
--- 56,72 ----
You may also choose to assign the strings C<'IGNORE'> or C<'DEFAULT'> as
the handler, in which case Perl will try to discard the signal or do the
! default thing.
!
! On most UNIX platforms, the C<CHLD> (sometimes also known as C<CLD>) signal
! has special behavior with respect to a value of C<'IGNORE'>.
! Setting C<$SIG{CHLD}> to C<'IGNORE'> on such a platform has the effect of
! not creating zombie processes when the parent process fails to C<wait()>
! on its child processes (i.e. child processes are automatically reaped).
! Calling C<wait()> with C<$SIG{CHLD}> set to C<'IGNORE'> usually returns
! C<-1> on such platforms.
!
! Some signals can be neither trapped nor ignored, such as
the KILL and STOP (but not the TSTP) signals. One strategy for
temporarily ignoring signals is to use a local() statement, which will be
automatically restored once your block is exited. (Remember that local()
***************
*** 317,362 ****
=head2 Complete Dissociation of Child from Parent
In some cases (starting server processes, for instance) you'll want to
! complete dissociate the child process from the parent. The easiest
! way is to use:
!
! use POSIX qw(setsid);
! setsid() or die "Can't start a new session: $!";
!
! However, you may not be on POSIX. The following process is reported
! to work on most Unixish systems. Non-Unix users should check their
! Your_OS::Process module for other solutions.
!
! =over 4
!
! =item *
!
! Open /dev/tty and use the TIOCNOTTY ioctl on it. See L<tty(4)>
! for details.
!
! =item *
!
! Change directory to /
! =item *
!
! Reopen STDIN, STDOUT, and STDERR so they're not connected to the old
! tty.
!
! =item *
!
! Background yourself like this:
!
! fork && exit;
!
! =item *
!
! Ignore hangup signals in case you're running on a shell that doesn't
! automatically no-hup you:
!
! $SIG{HUP} = 'IGNORE'; # or whatever you'd like
!
! =back
=head2 Safe Pipe Opens
--- 327,359 ----
=head2 Complete Dissociation of Child from Parent
In some cases (starting server processes, for instance) you'll want to
! completely dissociate the child process from the parent. This is
! often called daemonization. A well behaved daemon will also chdir()
! to the root directory (so it doesn't prevent unmounting the filesystem
! containing the directory from which it was launched) and redirect its
! standard file descriptors from and to F</dev/null> (so that random
! output doesn't wind up on the user's terminal).
!
! use POSIX 'setsid';
!
! sub daemonize {
! chdir '/' or die "Can't chdir to /: $!";
! open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
! open STDOUT, '>/dev/null'
! or die "Can't write to /dev/null: $!";
! defined(my $pid = fork) or die "Can't fork: $!";
! exit if $pid;
! setsid or die "Can't start a new session: $!";
! open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
! }
!
! The fork() has to come before the setsid() to ensure that you aren't a
! process group leader (the setsid() will fail if you are). If your
! system doesn't have the setsid() function, open F</dev/tty> and use the
! C<TIOCNOTTY> ioctl() on it instead. See L<tty(4)> for details.
! Non-Unix users should check their Your_OS::Process module for other
! solutions.
=head2 Safe Pipe Opens
***************
*** 1194,1200 ****
This server accepts one of five different commands, sending output
back to the client. Note that unlike most network servers, this one
only handles one incoming client at a time. Multithreaded servers are
! covered in Chapter 6 of the Camel as well as later in this manpage.
Here's the code. We'll
--- 1191,1197 ----
This server accepts one of five different commands, sending output
back to the client. Note that unlike most network servers, this one
only handles one incoming client at a time. Multithreaded servers are
! covered in Chapter 6 of the Camel.
Here's the code. We'll
diff -c 'perl5.005_02/pod/perllocale.pod' 'perl5.005_03/pod/perllocale.pod'
Index: ./pod/perllocale.pod
*** ./pod/perllocale.pod Sat Aug 1 23:03:23 1998
--- ./pod/perllocale.pod Sat Jan 23 17:28:11 1999
***************
*** 215,220 ****
--- 215,222 ----
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,242 ****
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
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.
Two special locales are worth particular mention: "C" and "POSIX".
Currently these are effectively the same locale: the difference is
--- 227,244 ----
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
configuration resides have not been. The basic form of the name is
! 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
***************
*** 276,285 ****
locale inconsistencies or to run Perl under the default locale "C".
Perl's moaning about locale problems can be silenced by setting the
! environment variable PERL_BADLANG to a non-zero value, for example
! "1". This method really just sweeps the problem under the carpet: you
! tell Perl to shut up even when Perl sees that something is wrong. Do
! not be surprised if later something locale-dependent misbehaves.
Perl can be run under the "C" locale by setting the environment
variable LC_ALL to "C". This method is perhaps a bit more civilized
--- 278,287 ----
locale inconsistencies or to run Perl under the default locale "C".
Perl's moaning about locale problems can be silenced by setting the
! environment variable PERL_BADLANG to a zero value, for example "0".
! This method really just sweeps the problem under the carpet: you tell
! Perl to shut up even when Perl sees that something is wrong. Do not
! be surprised if later something locale-dependent misbehaves.
Perl can be run under the "C" locale by setting the environment
variable LC_ALL to "C". This method is perhaps a bit more civilized
***************
*** 330,336 ****
(prefix matches do not count and case usually counts) like "En_US"
without the quotes, then you should be okay because you are using a
locale name that should be installed and available in your system.
! In this case, see L<Fixing system locale configuration>.
=head2 Permanently fixing your locale configuration
--- 332,338 ----
(prefix matches do not count and case usually counts) like "En_US"
without the quotes, then you should be okay because you are using a
locale name that should be installed and available in your system.
! In this case, see L<Permanently fixing system locale configuration>.
=head2 Permanently fixing your locale configuration
***************
*** 349,355 ****
standardization is weak in this area. See again the L<Finding
locales> about general rules.
! =head2 Permanently fixing system locale configuration
Contact a system administrator (preferably your own) and report the exact
error message you get, and ask them to read this same documentation you
--- 351,357 ----
standardization is weak in this area. See again the L<Finding
locales> about general rules.
! =head2 Fixing system locale configuration
Contact a system administrator (preferably your own) and report the exact
error message you get, and ask them to read this same documentation you
***************
*** 710,716 ****
=item B<In-memory formatting function> (sprintf()):
! Result is tainted if "use locale" is in effect.
=item B<Output formatting functions> (printf() and write()):
--- 712,718 ----
=item B<In-memory formatting function> (sprintf()):
! Result is tainted if C<use locale> is in effect.
=item B<Output formatting functions> (printf() and write()):
***************
*** 785,793 ****
A string that can suppress Perl's warning about failed locale settings
at startup. Failure can occur if the locale support in the operating
system is lacking (broken) in some way--or if you mistyped the name of
! a locale when you set up your environment. If this environment variable
! is absent, or has a value that does not evaluate to integer zero--that
! is, "0" or ""--Perl will complain about locale setting failures.
B<NOTE>: PERL_BADLANG only gives you a way to hide the warning message.
The message tells about some problem in your system's locale support,
--- 787,796 ----
A string that can suppress Perl's warning about failed locale settings
at startup. Failure can occur if the locale support in the operating
system is lacking (broken) in some way--or if you mistyped the name of
! a locale when you set up your environment. If this environment
! variable is absent, or has a value that does not evaluate to integer
! zero--that is, "0" or ""-- Perl will complain about locale setting
! failures.
B<NOTE>: PERL_BADLANG only gives you a way to hide the warning message.
The message tells about some problem in your system's locale support,
***************
*** 806,811 ****
--- 809,828 ----
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
***************
*** 854,860 ****
(see L<The setlocale function>). By default, Perl still behaves this
way for backward compatibility. If you want a Perl application to pay
attention to locale information, you B<must> use the S<C<use locale>>
! pragma (see L<The use locale Pragma>) to instruct it to do so.
Versions of Perl from 5.002 to 5.003 did use the C<LC_CTYPE>
information if available; that is, C<\w> did understand what
--- 871,877 ----
(see L<The setlocale function>). By default, Perl still behaves this
way for backward compatibility. If you want a Perl application to pay
attention to locale information, you B<must> use the S<C<use locale>>
! pragma (see L<The use locale pragma>) to instruct it to do so.
Versions of Perl from 5.002 to 5.003 did use the C<LC_CTYPE>
information if available; that is, C<\w> did understand what
diff -c 'perl5.005_02/pod/perllol.pod' 'perl5.005_03/pod/perllol.pod'
Index: ./pod/perllol.pod
*** ./pod/perllol.pod Thu Jul 23 23:01:41 1998
--- ./pod/perllol.pod Sat Mar 27 16:01:50 1999
***************
*** 34,40 ****
$ref_to_LoL = [
[ "fred", "barney", "pebbles", "bambam", "dino", ],
[ "homer", "bart", "marge", "maggie", ],
! [ "george", "jane", "alroy", "judy", ],
];
print $ref_to_LoL->[2][2];
--- 34,40 ----
$ref_to_LoL = [
[ "fred", "barney", "pebbles", "bambam", "dino", ],
[ "homer", "bart", "marge", "maggie", ],
! [ "george", "jane", "elroy", "judy", ],
];
print $ref_to_LoL->[2][2];
diff -c 'perl5.005_02/pod/perlmod.pod' 'perl5.005_03/pod/perlmod.pod'
Index: ./pod/perlmod.pod
*** ./pod/perlmod.pod Thu Jul 23 23:01:42 1998
--- ./pod/perlmod.pod Sat Mar 27 16:02:17 1999
***************
*** 243,249 ****
# non-exported package globals go here
use vars qw(@more $stuff);
! # initalize package globals, first exported ones
$Var1 = '';
%Hashit = ();
--- 243,249 ----
# non-exported package globals go here
use vars qw(@more $stuff);
! # initialize package globals, first exported ones
$Var1 = '';
%Hashit = ();
diff -c 'perl5.005_02/pod/perlmodinstall.pod' 'perl5.005_03/pod/perlmodinstall.pod'
Index: ./pod/perlmodinstall.pod
*** ./pod/perlmodinstall.pod Sat Jul 25 21:02:23 1998
--- ./pod/perlmodinstall.pod Sat Mar 27 16:45:25 1999
***************
*** 178,193 ****
A. DECOMPRESS
! You can either use StuffIt Expander ( http://www.aladdinsys.com/ ) in
! combination with I<DropStuff with Expander Enhancer>
! (shareware), or the freeware MacGzip (
http://persephone.cps.unizar.es/general/gente/spd/gzip/gzip.html ).
B. UNPACK
If you're using DropStuff or Stuffit, you can just extract the tar
! archive. Otherwise, you can use the freeware I<suntar> (
! http://www.cirfid.unibo.it/~speranza ).
C. BUILD
--- 178,204 ----
A. DECOMPRESS
! In general, all Macintosh decompression utilities mentioned here
! can be found in the Info-Mac Hyperarchive
! ( http://hyperarchive.lcs.mit.edu/HyperArchive.html ).
! Specificly the "Commpress & Translate" listing
! ( http://hyperarchive.lcs.mit.edu/HyperArchive/Abstracts/cmp/HyperArchive.html ).
!
!
! You can either use the shareware StuffIt Expander
! ( http://hyperarchive.lcs.mit.edu/HyperArchive/Archive/cmp/stuffit-expander-401.hqx )
! in combination with I<DropStuff with Expander Enhancer>
! ( http://hyperarchive.lcs.mit.edu/HyperArchive/Archive/cmp/drop-stuff-with-ee-40.hqx )
! or the freeware MacGzip (
http://persephone.cps.unizar.es/general/gente/spd/gzip/gzip.html ).
+
B. UNPACK
If you're using DropStuff or Stuffit, you can just extract the tar
! archive. Otherwise, you can use the freeware I<suntar>
! ( http://hyperarchive.lcs.mit.edu/HyperArchive/Archive/cmp/suntar-221.hqx )
! or I<Tar> ( http://hyperarchive.lcs.mit.edu/HyperArchive/Archive/cmp/tar-40b.hqx ).
C. BUILD
***************
*** 212,217 ****
--- 223,237 ----
D. INSTALL
Make sure the newlines for the modules are in Mac format, not Unix format.
+ If they are not then you might have decompressed them incorrectly. Check
+ your decompression and unpacking utilities settings to make sure they are
+ translating text files properly.
+ As a last resort, you can use the perl one-liner:
+
+ perl -i.bak -pe 's/(?:\015)?\012/\015/g' filenames
+
+ on the source files.
+
Move the files manually into the correct folders.
Move the files to their final destination: This will
diff -c 'perl5.005_02/pod/perlmodlib.pod' 'perl5.005_03/pod/perlmodlib.pod'
Index: ./pod/perlmodlib.pod
*** ./pod/perlmodlib.pod Thu Jul 23 23:01:42 1998
--- ./pod/perlmodlib.pod Sat Mar 27 16:30:04 1999
***************
*** 21,27 ****
They work somewhat like pragmas in that they tend to affect the compilation of
your program, and thus will usually work well only when used within a
! C<use>, or C<no>. Most of these are locally scoped, so an inner BLOCK
may countermand any of these by saying:
no integer;
--- 21,27 ----
They work somewhat like pragmas in that they tend to affect the compilation of
your program, and thus will usually work well only when used within a
! C<use>, or C<no>. Most of these are lexically scoped, so an inner BLOCK
may countermand any of these by saying:
no integer;
***************
*** 261,266 ****
--- 261,274 ----
create or remove a series of directories
+ =item File::Spec
+
+ portably perform operations on file names
+
+ =item File::Spec::Functions
+
+ function call interface to File::Spec module
+
=item File::stat
by-name interface to Perl's builtin stat() functions
***************
*** 608,691 ****
=item *
Africa
! South Africa ftp://ftp.is.co.za/programming/perl/CPAN/
=item *
Asia
! Hong Kong ftp://ftp.hkstar.com/pub/CPAN/
! Japan ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/
! ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
! South Korea ftp://ftp.nuri.net/pub/CPAN/
! Taiwan ftp://dongpo.math.ncu.edu.tw/perl/CPAN/
! ftp://ftp.wownet.net/pub2/PERL/
=item *
Australasia
! Australia ftp://ftp.netinfo.com.au/pub/perl/CPAN/
! New Zealand ftp://ftp.tekotago.ac.nz/pub/perl/CPAN/
=item *
Europe
! Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/
! Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/
! Czech Republic ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/
! Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/
! Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/
! France ftp://ftp.ibp.fr/pub/perl/CPAN/
! ftp://ftp.pasteur.fr/pub/computing/unix/perl/CPAN/
! Germany ftp://ftp.gmd.de/packages/CPAN/
! ftp://ftp.leo.org/pub/comp/programming/languages/perl/CPAN/
! ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/
! ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/
! ftp://ftp.uni-erlangen.de/pub/source/Perl/CPAN/
! ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/
! Greece ftp://ftp.ntua.gr/pub/lang/perl/
! Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/
! Italy ftp://cis.utovrm.it/CPAN/
! the Netherlands ftp://ftp.cs.ruu.nl/pub/PERL/CPAN/
! ftp://ftp.EU.net/packages/cpan/
! Norway ftp://ftp.uit.no/pub/languages/perl/cpan/
! Poland ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/
! ftp://sunsite.icm.edu.pl/pub/CPAN/
! Portugal ftp://ftp.ci.uminho.pt/pub/lang/perl/
! ftp://ftp.telepac.pt/pub/CPAN/
! Russia ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/
! Slovenia ftp://ftp.arnes.si/software/perl/CPAN/
! Spain ftp://ftp.etse.urv.es/pub/mirror/perl/
! ftp://ftp.rediris.es/mirror/CPAN/
! Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/
! UK ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
! ftp://sunsite.doc.ic.ac.uk/packages/CPAN/
! ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/
=item *
North America
! Ontario ftp://ftp.utilis.com/public/CPAN/
! ftp://enterprise.ic.gc.ca/pub/perl/CPAN/
! Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/
! California ftp://ftp.digital.com/pub/plan/perl/CPAN/
! ftp://ftp.cdrom.com/pub/perl/CPAN/
! Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
! Florida ftp://ftp.cis.ufl.edu/pub/perl/CPAN/
! Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/
! Massachusetts ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/
! New York ftp://ftp.rge.com/pub/languages/perl/
! North Carolina ftp://ftp.duke.edu/pub/perl/
! Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/
! Oregon http://www.perl.org/CPAN/
! ftp://ftp.orst.edu/pub/packages/CPAN/
! Pennsylvania ftp://ftp.epix.net/pub/languages/perl/
! Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/
! ftp://ftp.metronet.com/pub/perl/
=item *
South America
! Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/
=back
--- 616,748 ----
=item *
Africa
! South Africa ftp://ftp.is.co.za/programming/perl/CPAN/
! ftp://ftpza.co.za/pub/mirrors/cpan/
=item *
Asia
! Armenia ftp://sunsite.aua.am/pub/CPAN/
! China ftp://freesoft.cei.gov.cn/pub/languages/perl/CPAN/
! Hong Kong ftp://ftp.hkstar.com/pub/CPAN/
! Israel ftp://bioinfo.weizmann.ac.il/pub/software/perl/CPAN/
! Japan ftp://ftp.dti.ad.jp/pub/lang/CPAN/
! ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/
! ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/
! ftp://ftp.meisei-u.ac.jp/pub/CPAN/
! ftp://mirror.nucba.ac.jp/mirror/Perl/
! Singapore ftp://ftp.nus.edu.sg/pub/unix/perl/CPAN/
! South Korea ftp://ftp.bora.net/pub/CPAN/
! ftp://ftp.nuri.net/pub/CPAN/
! Taiwan ftp://ftp.wownet.net/pub2/PERL/
! ftp://ftp1.sinica.edu.tw/pub1/perl/CPAN/
! Thailand ftp://ftp.cs.riubon.ac.th/pub/mirrors/CPAN/
! ftp://ftp.nectec.or.th/pub/mirrors/CPAN/
=item *
Australasia
! Australia ftp://cpan.topend.com.au/pub/CPAN/
! ftp://ftp.labyrinth.net.au/pub/perl/CPAN/
! ftp://ftp.sage-au.org.au/pub/compilers/perl/CPAN/
! ftp://mirror.aarnet.edu.au/pub/perl/CPAN/
! New Zealand ftp://ftp.auckland.ac.nz/pub/perl/CPAN/
! ftp://sunsite.net.nz/pub/languages/perl/CPAN/
!
! =item *
! Central America
!
! Costa Rica ftp://ftp.ucr.ac.cr/pub/Unix/CPAN/
=item *
Europe
! Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/
! Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/
! Bulgaria ftp://ftp.ntrl.net/pub/mirrors/CPAN/
! Croatia ftp://ftp.linux.hr/pub/CPAN/
! Czech Republic ftp://ftp.fi.muni.cz/pub/perl/
! ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/
! Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/
! Estonia ftp://ftp.ut.ee/pub/languages/perl/CPAN/
! Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/
! France ftp://ftp.lip6.fr/pub/perl/CPAN/
! ftp://ftp.oleane.net/pub/mirrors/CPAN/
! ftp://ftp.pasteur.fr/pub/computing/CPAN/
! Germany ftp://ftp.archive.de.uu.net/pub/CPAN/
! ftp://ftp.gmd.de/packages/CPAN/
! ftp://ftp.gwdg.de/pub/languages/perl/CPAN/
! ftp://ftp.leo.org/pub/comp/programming/languages/script/perl/CPAN/
! ftp://ftp.mpi-sb.mpg.de/pub/perl/CPAN/
! ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/
! ftp://ftp.uni-erlangen.de/pub/source/CPAN/
! ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/
! Greece ftp://ftp.ntua.gr/pub/lang/perl/
! Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/
! Ireland ftp://sunsite.compapp.dcu.ie/pub/perl/
! Italy ftp://cis.uniRoma2.it/CPAN/
! ftp://ftp.flashnet.it/pub/CPAN/
! ftp://ftp.unipi.it/pub/mirror/perl/CPAN/
! Netherlands ftp://ftp.cs.uu.nl/mirror/CPAN/
! ftp://ftp.nluug.nl/pub/languages/perl/CPAN/
! Norway ftp://ftp.uit.no/pub/languages/perl/cpan/
! ftp://sunsite.uio.no/pub/languages/perl/CPAN/
! Poland ftp://ftp.man.szczecin.pl/pub/perl/CPAN/
! ftp://ftp.man.torun.pl/pub/doc/CPAN/
! ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/
! ftp://sunsite.icm.edu.pl/pub/CPAN/
! Portugal ftp://ftp.ci.uminho.pt/pub/mirrors/cpan/
! ftp://ftp.ua.pt/pub/CPAN/
! Romania ftp://ftp.dntis.ro/pub/mirrors/perl-cpan/
! ftp://ftp.dnttm.ro/pub/CPAN/
! Russia ftp://cpan.npi.msu.su/CPAN/
! ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/
! Slovakia ftp://ftp.entry.sk/pub/languages/perl/CPAN/
! Slovenia ftp://ftp.arnes.si/software/perl/CPAN/
! Spain ftp://ftp.etse.urv.es/pub/perl/
! ftp://ftp.rediris.es/mirror/CPAN/
! Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/
! Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/
! Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/
! United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/
! ftp://ftp.flirble.org/pub/languages/perl/CPAN/
! ftp://ftp.plig.org/pub/CPAN/
! ftp://sunsite.doc.ic.ac.uk/packages/CPAN/
! ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/
=item *
North America
! Alberta ftp://sunsite.ualberta.ca/pub/Mirror/CPAN/
! California ftp://ftp.cdrom.com/pub/perl/CPAN/
! ftp://ftp.digital.com/pub/plan/perl/CPAN/
! Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/
! Florida ftp://ftp.cise.ufl.edu/pub/perl/CPAN/
! Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/
! Indiana ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN/
! ftp://ftp.uwsg.indiana.edu/pub/perl/CPAN/
! Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/
! Massachusetts ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/
! ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/
! Mexico D.F. ftp://ftp.msg.com.mx/pub/CPAN/
! New York ftp://ftp.rge.com/pub/languages/perl/
! North Carolina ftp://ftp.duke.edu/pub/perl/
! Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/
! Ontario ftp://ftp.crc.ca/pub/packages/perl/CPAN/
! Oregon ftp://ftp.orst.edu/pub/packages/CPAN/
! Pennsylvania ftp://ftp.epix.net/pub/languages/perl/
! Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/
! Utah ftp://mirror.xmission.com/CPAN/
! Virginia ftp://ftp.perl.org/pub/perl/CPAN/
! ftp://ruff.cs.jmu.edu/pub/CPAN/
! Washington ftp://ftp.spu.edu/pub/CPAN/
=item *
South America
! Brazil ftp://cpan.if.usp.br/pub/mirror/CPAN/
! Chile ftp://ftp.ing.puc.cl/pub/unix/perl/CPAN/
! ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/
=back
diff -c 'perl5.005_02/pod/perlobj.pod' 'perl5.005_03/pod/perlobj.pod'
Index: ./pod/perlobj.pod
*** ./pod/perlobj.pod Thu Jul 23 23:01:43 1998
--- ./pod/perlobj.pod Sat Mar 27 16:45:33 1999
***************
*** 84,90 ****
}
If you care about inheritance (and you should; see
! L<perlmod/"Modules: Creation, Use, and Abuse">),
then you want to use the two-arg form of bless
so that your constructors may be inherited:
--- 84,90 ----
}
If you care about inheritance (and you should; see
! L<perlmodlib/"Modules: Creation, Use, and Abuse">),
then you want to use the two-arg form of bless
so that your constructors may be inherited:
***************
*** 251,257 ****
There are times when one syntax is more readable, and times when the
other syntax is more readable. The indirect object syntax is less
cluttered, but it has the same ambiguity as ordinary list operators.
! Indirect object method calls are parsed using the same rule as list
operators: "If it looks like a function, it is a function". (Presuming
for the moment that you think two words in a row can look like a
function name. C++ programmers seem to think so with some regularity,
--- 251,257 ----
There are times when one syntax is more readable, and times when the
other syntax is more readable. The indirect object syntax is less
cluttered, but it has the same ambiguity as ordinary list operators.
! Indirect object method calls are usually parsed using the same rule as list
operators: "If it looks like a function, it is a function". (Presuming
for the moment that you think two words in a row can look like a
function name. C++ programmers seem to think so with some regularity,
***************
*** 268,274 ****
Critter->new('Bam' x 2), 1.4, 45
! which is unlikely to do what you want.
There are times when you wish to specify which class's method to use.
In this case, you can call your method as an ordinary subroutine
--- 268,287 ----
Critter->new('Bam' x 2), 1.4, 45
! which is unlikely to do what you want. Confusingly, however, this
! rule applies only when the indirect object is a bareword package name,
! not when it's a scalar, a BLOCK, or a C<Package::> qualified package name.
! In those cases, the arguments are parsed in the same way as an
! indirect object list operator like print, so
!
! new Critter:: ('Bam' x 2), 1.4, 45
!
! is the same as
!
! Critter::->new(('Bam' x 2), 1.4, 45)
!
! For more reasons why the indirect object syntax is ambiguous, see
! L<"WARNING"> below.
There are times when you wish to specify which class's method to use.
In this case, you can call your method as an ordinary subroutine
diff -c 'perl5.005_02/pod/perlop.pod' 'perl5.005_03/pod/perlop.pod'
Index: ./pod/perlop.pod
*** ./pod/perlop.pod Thu Jul 23 23:01:44 1998
--- ./pod/perlop.pod Sat Mar 27 18:04:48 1999
***************
*** 44,50 ****
=head2 Terms and List Operators (Leftward)
! A TERM has the highest precedence in Perl. They includes variables,
quote and quote-like operators, any expression in parentheses,
and any function whose arguments are parenthesized. Actually, there
aren't really functions in this sense, just list operators and unary
--- 44,50 ----
=head2 Terms and List Operators (Leftward)
! A TERM has the highest precedence in Perl. They include variables,
quote and quote-like operators, any expression in parentheses,
and any function whose arguments are parenthesized. Actually, there
aren't really functions in this sense, just list operators and unary
***************
*** 620,628 ****
"" qq{} Literal yes
`` qx{} Command yes (unless '' is delimiter)
qw{} Word list no
! // m{} Pattern match yes
! qr{} Pattern yes
! s{}{} Substitution yes
tr{}{} Transliteration no (but see below)
Note that there can be whitespace between the operator and the quoting
--- 620,628 ----
"" qq{} Literal yes
`` qx{} Command yes (unless '' is delimiter)
qw{} Word list no
! // m{} Pattern match yes (unless '' is delimiter)
! qr{} Pattern yes (unless '' is delimiter)
! s{}{} Substitution yes (unless '' is delimiter)
tr{}{} Transliteration no (but see below)
Note that there can be whitespace between the operator and the quoting
***************
*** 645,652 ****
\b backspace (BS)
\a alarm (bell) (BEL)
\e escape (ESC)
! \033 octal char
! \x1b hex char
\c[ control char
\l lowercase next char
--- 645,652 ----
\b backspace (BS)
\a alarm (bell) (BEL)
\e escape (ESC)
! \033 octal char (ESC)
! \x1b hex char (ESC)
\c[ control char
\l lowercase next char
***************
*** 752,773 ****
If "/" is the delimiter then the initial C<m> is optional. With the C<m>
you can use any pair of non-alphanumeric, non-whitespace characters
! as delimiters (if single quotes are used, no interpretation is done
! on the replacement string. Unlike Perl 4, Perl 5 treats backticks as normal
! delimiters; the replacement text is not evaluated as a command).
! This is particularly useful for matching Unix path names
! that contain "/", to avoid LTS (leaning toothpick syndrome). If "?" is
the delimiter, then the match-only-once rule of C<?PATTERN?> applies.
PATTERN may contain variables, which will be interpolated (and the
! pattern recompiled) every time the pattern search is evaluated. (Note
! that C<$)> and C<$|> might not be interpolated because they look like
! end-of-string tests.) If you want such a pattern to be compiled only
! once, add a C</o> after the trailing delimiter. This avoids expensive
! run-time recompilations, and is useful when the value you are
! interpolating won't change over the life of the script. However, mentioning
! C</o> constitutes a promise that you won't change the variables in the pattern.
! If you change them, Perl won't even notice.
If the PATTERN evaluates to the empty string, the last
I<successfully> matched regular expression is used instead.
--- 752,773 ----
If "/" is the delimiter then the initial C<m> is optional. With the C<m>
you can use any pair of non-alphanumeric, non-whitespace characters
! as delimiters. This is particularly useful for matching Unix path names
! that contain "/", to avoid LTS (leaning toothpick syndrome). If "?" is
the delimiter, then the match-only-once rule of C<?PATTERN?> applies.
+ If "'" is the delimiter, no variable interpolation is performed on the
+ PATTERN.
PATTERN may contain variables, which will be interpolated (and the
! pattern recompiled) every time the pattern search is evaluated, except
! for when the delimiter is a single quote. (Note that C<$)> and C<$|>
! might not be interpolated because they look like end-of-string tests.)
! If you want such a pattern to be compiled only once, add a C</o> after
! the trailing delimiter. This avoids expensive run-time recompilations,
! and is useful when the value you are interpolating won't change over
! the life of the script. However, mentioning C</o> constitutes a promise
! that you won't change the variables in the pattern. If you change them,
! Perl won't even notice.
If the PATTERN evaluates to the empty string, the last
I<successfully> matched regular expression is used instead.
***************
*** 829,838 ****
($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g);
# scalar context
! $/ = ""; $* = 1; # $* deprecated in modern perls
! while (defined($paragraph = <>)) {
! while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) {
! $sentences++;
}
}
print "$sentences\n";
--- 829,840 ----
($one,$five,$fifteen) = (`uptime` =~ /(\d+\.\d+)/g);
# scalar context
! {
! local $/ = "";
! while (defined($paragraph = <>)) {
! while ($paragraph =~ /[a-z]['")]*[.!?]+['")]*\s/g) {
! $sentences++;
! }
}
}
print "$sentences\n";
***************
*** 907,920 ****
if /(tcl|rexx|python)/; # :-)
$baz = "\n"; # a one-character string
! =item qr/STRING/imosx
! A string which is (possibly) interpolated and then compiled as a
! regular expression. The result may be used as a pattern in a match
$re = qr/$pattern/;
$string =~ /foo${re}bar/; # can be interpolated in other patterns
$string =~ $re; # or used standalone
Options are:
--- 909,958 ----
if /(tcl|rexx|python)/; # :-)
$baz = "\n"; # a one-character string
! =item qr/PATTERN/imosx
!
! Quote-as-a-regular-expression operator. I<STRING> is interpolated the
! same way as I<PATTERN> in C<m/PATTERN/>. If "'" is used as the
! delimiter, no variable interpolation is done. Returns a Perl value
! which may be used instead of the corresponding C</STRING/imosx> expression.
!
! For example,
!
! $rex = qr/my.STRING/is;
! s/$rex/foo/;
! is equivalent to
!
! s/my.STRING/foo/is;
!
! The result may be used as a subpattern in a match:
$re = qr/$pattern/;
$string =~ /foo${re}bar/; # can be interpolated in other patterns
$string =~ $re; # or used standalone
+ $string =~ /$re/; # or this way
+
+ Since Perl may compile the pattern at the moment of execution of qr()
+ operator, using qr() may have speed advantages in I<some> situations,
+ notably if the result of qr() is used standalone:
+
+ sub match {
+ my $patterns = shift;
+ my @compiled = map qr/$_/i, @$patterns;
+ grep {
+ my $success = 0;
+ foreach my $pat @compiled {
+ $success = 1, last if /$pat/;
+ }
+ $success;
+ } @_;
+ }
+
+ Precompilation of the pattern into an internal representation at the
+ moment of qr() avoids a need to recompile the pattern every time a
+ match C</$pat/> is attempted. (Note that Perl has many other
+ internal optimizations, but none would be triggered in the above
+ example if we did not use qr() operator.)
Options are:
***************
*** 924,942 ****
s Treat string as single line.
x Use extended regular expressions.
- The benefit from this is that the pattern is precompiled into an internal
- representation, and does not need to be recompiled every time a match
- is attempted. This makes it very efficient to do something like:
-
- foreach $pattern (@pattern_list) {
- my $re = qr/$pattern/;
- foreach $line (@lines) {
- if($line =~ /$re/) {
- do_something($line);
- }
- }
- }
-
See L<perlre> for additional information on valid syntax for STRING, and
for a detailed look at the semantics of regular expressions.
--- 962,967 ----
***************
*** 1023,1028 ****
--- 1048,1059 ----
This equivalency means that if used in scalar context, you'll get split's
(unfortunate) scalar context behavior, complete with mysterious warnings.
+ However do not rely on this as in a future release it could be changed to
+ be exactly equivalent to the list
+
+ ('foo', 'bar', 'baz')
+
+ Which in a scalar context would result in C<'baz'>.
Some frequently seen examples:
***************
*** 1045,1051 ****
be scalar variable, an array element, a hash element, or an assignment
to one of those, i.e., an lvalue.)
! If the delimiter chosen is single quote, no variable interpolation is
done on either the PATTERN or the REPLACEMENT. Otherwise, if the
PATTERN contains a $ that looks like a variable rather than an
end-of-string test, the variable will be interpolated into the pattern
--- 1076,1082 ----
be scalar variable, an array element, a hash element, or an assignment
to one of those, i.e., an lvalue.)
! If the delimiter chosen is a single quote, no variable interpolation is
done on either the PATTERN or the REPLACEMENT. Otherwise, if the
PATTERN contains a $ that looks like a variable rather than an
end-of-string test, the variable will be interpolated into the pattern
***************
*** 1148,1153 ****
--- 1179,1185 ----
specified via the =~ or !~ operator, the $_ string is transliterated. (The
string specified with =~ must be a scalar variable, an array element, a
hash element, or an assignment to one of those, i.e., an lvalue.)
+
A character range may be specified with a hyphen, so C<tr/A-J/0-9/>
does the same replacement as C<tr/ACEGIBDFHJ/0246813579/>.
For B<sed> devotees, C<y> is provided as a synonym for C<tr>. If the
***************
*** 1155,1160 ****
--- 1187,1199 ----
its own pair of quotes, which may or may not be bracketing quotes,
e.g., C<tr[A-Z][a-z]> or C<tr(+\-*/)/ABCD/>.
+ Note also that the whole range idea is rather unportable between
+ character sets--and even within character sets they may cause results
+ you probably didn't expect. A sound principle is to use only ranges
+ that begin from and end at either alphabets of equal case (a-e, A-E),
+ or digits (0-4). Anything else is unsafe. If in doubt, spell out the
+ character sets in full.
+
Options:
c Complement the SEARCHLIST.
***************
*** 1229,1234 ****
--- 1268,1280 ----
first steps of parsing are the same for all Perl quoting operators, so here
they are discussed together.
+ The most important detail of Perl parsing rules is the first one
+ discussed below; when processing a quoted construct, Perl I<first>
+ finds the end of the construct, then it interprets the contents of the
+ construct. If you understand this rule, you may skip the rest of this
+ section on the first reading. The other rules would
+ contradict user's expectations much less frequently than the first one.
+
Some of the passes discussed below are performed concurrently, but as
far as results are the same, we consider them one-by-one. For different
quoting constructs Perl performs different number of passes, from
***************
*** 1238,1269 ****
=item Finding the end
! First pass is finding the end of the quoted construct, be it multichar ender
C<"\nEOF\n"> of C<<<EOF> construct, C</> which terminates C<qq/> construct,
C<]> which terminates C<qq[> construct, or C<E<gt>> which terminates a
fileglob started with C<<>.
! When searching for multichar construct no skipping is performed. When
! searching for one-char non-matching delimiter, such as C</>, combinations
C<\\> and C<\/> are skipped. When searching for one-char matching delimiter,
such as C<]>, combinations C<\\>, C<\]> and C<\[> are skipped, and
! nested C<[>, C<]> are skipped as well.
! For 3-parts constructs, C<s///> etc. the search is repeated once more.
! During this search no attention is paid to the semantic of the construct, thus
"$hash{"$foo/$bar"}"
! or
m/
! bar # This is not a comment, this slash / terminated m//!
/x
! do not form legal quoted expressions. Note that since the slash which
! terminated C<m//> was followed by a C<SPACE>, this is not C<m//x>,
! thus C<#> was interpreted as a literal C<#>.
=item Removal of backslashes before delimiters
--- 1284,1320 ----
=item Finding the end
! First pass is finding the end of the quoted construct, be it
! a multichar delimiter
C<"\nEOF\n"> of C<<<EOF> construct, C</> which terminates C<qq/> construct,
C<]> which terminates C<qq[> construct, or C<E<gt>> which terminates a
fileglob started with C<<>.
! When searching for one-char non-matching delimiter, such as C</>, combinations
C<\\> and C<\/> are skipped. When searching for one-char matching delimiter,
such as C<]>, combinations C<\\>, C<\]> and C<\[> are skipped, and
! nested C<[>, C<]> are skipped as well. When searching for multichar delimiter
! no skipping is performed.
! For constructs with 3-part delimiters (C<s///> etc.) the search is
! repeated once more.
! During this search no attention is paid to the semantic of the construct,
! thus:
"$hash{"$foo/$bar"}"
! or:
m/
! bar # NOT a comment, this slash / terminated m//!
/x
! do not form legal quoted expressions, the quoted part ends on the first C<">
! and C</>, and the rest happens to be a syntax error. Note that since the slash
! which terminated C<m//> was followed by a C<SPACE>, the above is not C<m//x>,
! but rather C<m//> with no 'x' switch. So the embedded C<#> is interpreted
! as a literal C<#>.
=item Removal of backslashes before delimiters
***************
*** 1297,1338 ****
=item C<"">, C<``>, C<qq//>, C<qx//>, C<<file*globE<gt>>
C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> (possibly paired with C<\E>) are converted
! to corresponding Perl constructs, thus C<"$foo\Qbaz$bar"> is converted to
$foo . (quotemeta("baz" . $bar));
Other combinations of C<\> with following chars are substituted with
! appropriate expansions.
! Interpolated scalars and arrays are converted to C<join> and C<.> Perl
! constructs, thus C<"'@arr'"> becomes
! "'" . (join $", @arr) . "'";
! Since all three above steps are performed simultaneously left-to-right,
! the is no way to insert a literal C<$> or C<@> inside C<\Q\E> pair: it
! cannot be protected by C<\>, since any C<\> (except in C<\E>) is
! interpreted as a literal inside C<\Q\E>, and any C<$> is
interpreted as starting an interpolated scalar.
! Note also that the interpolating code needs to make decision where the
! interpolated scalar ends, say, whether C<"a $b -E<gt> {c}"> means
"a " . $b . " -> {c}";
! or
"a " . $b -> {c};
! Most the time the decision is to take the longest possible text which does
! not include spaces between components and contains matching braces/brackets.
=item C<?RE?>, C</RE/>, C<m/RE/>, C<s/RE/foo/>,
Processing of C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> and interpolation happens
(almost) as with C<qq//> constructs, but I<the substitution of C<\> followed by
! other chars is not performed>! Moreover, inside C<(?{BLOCK})> no processing
! is performed at all.
Interpolation has several quirks: C<$|>, C<$(> and C<$)> are not interpolated, and
constructs C<$var[SOMETHING]> are I<voted> (by several different estimators)
--- 1348,1411 ----
=item C<"">, C<``>, C<qq//>, C<qx//>, C<<file*globE<gt>>
C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> (possibly paired with C<\E>) are converted
! to corresponding Perl constructs, thus C<"$foo\Qbaz$bar"> is converted to :
$foo . (quotemeta("baz" . $bar));
Other combinations of C<\> with following chars are substituted with
! appropriate expansions.
!
! Let it be stressed that I<whatever is between C<\Q> and C<\E>> is interpolated
! in the usual way. Say, C<"\Q\\E"> has no C<\E> inside: it has C<\Q>, C<\\>,
! and C<E>, thus the result is the same as for C<"\\\\E">. Generally speaking,
! having backslashes between C<\Q> and C<\E> may lead to counterintuitive
! results. So, C<"\Q\t\E"> is converted to:
!
! quotemeta("\t")
!
! which is the same as C<"\\\t"> (since TAB is not alphanumerical). Note also
! that:
! $str = '\t';
! return "\Q$str";
! may be closer to the conjectural I<intention> of the writer of C<"\Q\t\E">.
! Interpolated scalars and arrays are internally converted to the C<join> and
! C<.> Perl operations, thus C<"$foo >>> '@arr'"> becomes:
!
! $foo . " >>> '" . (join $", @arr) . "'";
!
! All the operations in the above are performed simultaneously left-to-right.
!
! Since the result of "\Q STRING \E" has all the metacharacters quoted
! there is no way to insert a literal C<$> or C<@> inside a C<\Q\E> pair: if
! protected by C<\> C<$> will be quoted to became "\\\$", if not, it is
interpreted as starting an interpolated scalar.
! Note also that the interpolating code needs to make a decision on where the
! interpolated scalar ends. For instance, whether C<"a $b -E<gt> {c}"> means:
"a " . $b . " -> {c}";
! or:
"a " . $b -> {c};
! I<Most of the time> the decision is to take the longest possible text which
! does not include spaces between components and contains matching
! braces/brackets. Since the outcome may be determined by I<voting> based
! on heuristic estimators, the result I<is not strictly predictable>, but
! is usually correct for the ambiguous cases.
=item C<?RE?>, C</RE/>, C<m/RE/>, C<s/RE/foo/>,
Processing of C<\Q>, C<\U>, C<\u>, C<\L>, C<\l> and interpolation happens
(almost) as with C<qq//> constructs, but I<the substitution of C<\> followed by
! RE-special chars (including C<\>) is not performed>! Moreover,
! inside C<(?{BLOCK})>, C<(?# comment )>, and C<#>-comment of
! C<//x>-regular expressions no processing is performed at all.
! This is the first step where presence of the C<//x> switch is relevant.
Interpolation has several quirks: C<$|>, C<$(> and C<$)> are not interpolated, and
constructs C<$var[SOMETHING]> are I<voted> (by several different estimators)
***************
*** 1340,1354 ****
the place where the notation C<${arr[$bar]}> comes handy: C</${arr[0-9]}/>
is interpreted as an array element C<-9>, not as a regular expression from
variable C<$arr> followed by a digit, which is the interpretation of
! C</$arr[0-9]/>.
Note that absence of processing of C<\\> creates specific restrictions on the
post-processed text: if the delimiter is C</>, one cannot get the combination
C<\/> into the result of this step: C</> will finish the regular expression,
C<\/> will be stripped to C</> on the previous step, and C<\\/> will be left
as is. Since C</> is equivalent to C<\/> inside a regular expression, this
! does not matter unless the delimiter is special character for the RE engine, as
! in C<s*foo*bar*>, C<m[foo]>, or C<?foo?>.
=back
--- 1413,1437 ----
the place where the notation C<${arr[$bar]}> comes handy: C</${arr[0-9]}/>
is interpreted as an array element C<-9>, not as a regular expression from
variable C<$arr> followed by a digit, which is the interpretation of
! C</$arr[0-9]/>. Since voting among different estimators may be performed,
! the result I<is not predictable>.
!
! It is on this step that C<\1> is converted to C<$1> in the replacement
! text of C<s///>.
Note that absence of processing of C<\\> creates specific restrictions on the
post-processed text: if the delimiter is C</>, one cannot get the combination
C<\/> into the result of this step: C</> will finish the regular expression,
C<\/> will be stripped to C</> on the previous step, and C<\\/> will be left
as is. Since C</> is equivalent to C<\/> inside a regular expression, this
! does not matter unless the delimiter is a special character for the RE engine,
! as in C<s*foo*bar*>, C<m[foo]>, or C<?foo?>, or an alphanumeric char, as in:
!
! m m ^ a \s* b mmx;
!
! In the above RE, which is intentionally obfuscated for illustration, the
! delimiter is C<m>, the modifier is C<mx>, and after backslash-removal the
! RE is the same as for C<m/ ^ a s* b /mx>).
=back
***************
*** 1367,1398 ****
Whatever happens in the RE engine is better be discussed in L<perlre>,
but for the sake of continuity let us do it here.
! This is the first step where presence of the C<//x> switch is relevant.
The RE engine scans the string left-to-right, and converts it to a finite
automaton.
Backslashed chars are either substituted by corresponding literal
! strings, or generate special nodes of the finite automaton. Characters
! which are special to the RE engine generate corresponding nodes. C<(?#...)>
comments are ignored. All the rest is either converted to literal strings
to match, or is ignored (as is whitespace and C<#>-style comments if
C<//x> is present).
Note that the parsing of the construct C<[...]> is performed using
! absolutely different rules than the rest of the regular expression.
! Similarly, the C<(?{...})> is only checked for matching braces.
=item Optimization of regular expressions
This step is listed for completeness only. Since it does not change
semantics, details of this step are not documented and are subject
! to change.
=back
=head2 I/O Operators
There are several I/O operators you should know about.
A string enclosed by backticks (grave accents) first undergoes
variable substitution just like a double quoted string. It is then
interpreted as a command, and the output of that command is the value
--- 1450,1497 ----
Whatever happens in the RE engine is better be discussed in L<perlre>,
but for the sake of continuity let us do it here.
! This is another step where presence of the C<//x> switch is relevant.
The RE engine scans the string left-to-right, and converts it to a finite
automaton.
Backslashed chars are either substituted by corresponding literal
! strings (as with C<\{>), or generate special nodes of the finite automaton
! (as with C<\b>). Characters which are special to the RE engine (such as
! C<|>) generate corresponding nodes or groups of nodes. C<(?#...)>
comments are ignored. All the rest is either converted to literal strings
to match, or is ignored (as is whitespace and C<#>-style comments if
C<//x> is present).
Note that the parsing of the construct C<[...]> is performed using
! rather different rules than for the rest of the regular expression.
! The terminator of this construct is found using the same rules as for
! finding a terminator of a C<{}>-delimited construct, the only exception
! being that C<]> immediately following C<[> is considered as if preceded
! by a backslash. Similarly, the terminator of C<(?{...})> is found using
! the same rules as for finding a terminator of a C<{}>-delimited construct.
!
! It is possible to inspect both the string given to RE engine, and the
! resulting finite automaton. See arguments C<debug>/C<debugcolor>
! of C<use L<re>> directive, and/or B<-Dr> option of Perl in
! L<perlrun/Switches>.
=item Optimization of regular expressions
This step is listed for completeness only. Since it does not change
semantics, details of this step are not documented and are subject
! to change. This step is performed over the finite automaton generated
! during the previous pass.
!
! However, in older versions of Perl C<L<split>> used to silently
! optimize C</^/> to mean C</^/m>. This behaviour, though present
! in current versions of Perl, may be deprecated in future.
=back
=head2 I/O Operators
There are several I/O operators you should know about.
+
A string enclosed by backticks (grave accents) first undergoes
variable substitution just like a double quoted string. It is then
interpreted as a command, and the output of that command is the value
***************
*** 1410,1418 ****
always undergo shell expansion as well, see L<perlsec> for
security concerns.)
! Evaluating a filehandle in angle brackets yields the next line from
! that file (newline, if any, included), or C<undef> at end of file.
! Ordinarily you must assign that value to a variable, but there is one
situation where an automatic assignment happens. I<If and ONLY if> the
input symbol is the only thing inside the conditional of a C<while> or
C<for(;;)> loop, the value is automatically assigned to the variable
--- 1509,1521 ----
always undergo shell expansion as well, see L<perlsec> for
security concerns.)
! In a scalar context, evaluating a filehandle in angle brackets yields the
! next line from that file (newline, if any, included), or C<undef> at
! end-of-file. When C<$/> is set to C<undef> (i.e. file slurp mode),
! and the file is empty, it returns C<''> the first time, followed by
! C<undef> subsequently.
!
! Ordinarily you must assign the returned value to a variable, but there is one
situation where an automatic assignment happens. I<If and ONLY if> the
input symbol is the only thing inside the conditional of a C<while> or
C<for(;;)> loop, the value is automatically assigned to the variable
***************
*** 1449,1461 ****
filehandles C<stdin>, C<stdout>, and C<stderr> will also work except in
packages, where they would be interpreted as local identifiers rather
than global.) Additional filehandles may be created with the open()
! function. See L<perlfunc/open()> for details on this.
If a E<lt>FILEHANDLEE<gt> is used in a context that is looking for a list, a
list consisting of all the input lines is returned, one line per list
element. It's easy to make a I<LARGE> data space this way, so use with
care.
The null filehandle E<lt>E<gt> is special and can be used to emulate the
behavior of B<sed> and B<awk>. Input from E<lt>E<gt> comes either from
standard input, or from each file listed on the command line. Here's
--- 1552,1567 ----
filehandles C<stdin>, C<stdout>, and C<stderr> will also work except in
packages, where they would be interpreted as local identifiers rather
than global.) Additional filehandles may be created with the open()
! function. See L<perlfunc/open> for details on this.
If a E<lt>FILEHANDLEE<gt> is used in a context that is looking for a list, a
list consisting of all the input lines is returned, one line per list
element. It's easy to make a I<LARGE> data space this way, so use with
care.
+ E<lt>FILEHANDLEE<gt> may also be spelt readline(FILEHANDLE). See
+ L<perlfunc/readline>.
+
The null filehandle E<lt>E<gt> is special and can be used to emulate the
behavior of B<sed> and B<awk>. Input from E<lt>E<gt> comes either from
standard input, or from each file listed on the command line. Here's
***************
*** 1622,1630 ****
(C<~ | & ^>).
If the operands to a binary bitwise op are strings of different sizes,
! B<or> and B<xor> ops will act as if the shorter operand had additional
! zero bits on the right, while the B<and> op will act as if the longer
! operand were truncated to the length of the shorter.
# ASCII-based examples
print "j p \n" ^ " a h"; # prints "JAPH\n"
--- 1728,1737 ----
(C<~ | & ^>).
If the operands to a binary bitwise op are strings of different sizes,
! B<|> and B<^> ops will act as if the shorter operand had additional
! zero bits on the right, while the B<&> op will act as if the longer
! operand were truncated to the length of the shorter. Note that the
! granularity for such extension or truncation is one or more I<bytes>.
# ASCII-based examples
print "j p \n" ^ " a h"; # prints "JAPH\n"
***************
*** 1644,1649 ****
--- 1751,1759 ----
$baz = 0+$foo & 0+$bar; # both ops explicitly numeric
$biz = "$foo" ^ "$bar"; # both ops explicitly stringy
+
+ See L<perlfunc/vec> for information on how to manipulate individual bits
+ in a bit vector.
=head2 Integer Arithmetic
diff -c /dev/null 'perl5.005_03/pod/perlopentut.pod'
Index: pod/perlopentut.pod
*** pod/perlopentut.pod Wed Dec 31 18:00:00 1969
--- pod/perlopentut.pod Sun Jan 24 08:48:05 1999
***************
*** 0 ****
--- 1,862 ----
+ =head1 NAME
+
+ perlopentut - tutorial on opening things in Perl
+
+ =head1 DESCRIPTION
+
+ Perl has two simple, built-in ways to open files: the shell way for
+ convenience, and the C way for precision. The choice is yours.
+
+ =head1 Open E<agrave> la shell
+
+ Perl's C<open> function was designed to mimic the way command-line
+ redirection in the shell works. Here are some basic examples
+ from the shell:
+
+ $ myprogram file1 file2 file3
+ $ myprogram < inputfile
+ $ myprogram > outputfile
+ $ myprogram >> outputfile
+ $ myprogram | otherprogram
+ $ otherprogram | myprogram
+
+ And here are some more advanced examples:
+
+ $ otherprogram | myprogram f1 - f2
+ $ otherprogram 2>&1 | myprogram -
+ $ myprogram <&3
+ $ myprogram >&4
+
+ Programmers accustomed to constructs like those above can take comfort
+ in learning that Perl directly supports these familiar constructs using
+ virtually the same syntax as the shell.
+
+ =head2 Simple Opens
+
+ The C<open> function takes two arguments: the first is a filehandle,
+ and the second is a single string comprising both what to open and how
+ to open it. C<open> returns true when it works, and when it fails,
+ returns a false value and sets the special variable $! to reflect
+ the system error. If the filehandle was previously opened, it will
+ be implicitly closed first.
+
+ For example:
+
+ open(INFO, "datafile") || die("can't open datafile: $!");
+ open(INFO, "< datafile") || die("can't open datafile: $!");
+ open(RESULTS,"> runstats") || die("can't open runstats: $!");
+ open(LOG, ">> logfile ") || die("can't open logfile: $!");
+
+ If you prefer the low-punctuation version, you could write that this way:
+
+ open INFO, "< datafile" or die "can't open datafile: $!";
+ open RESULTS,"> runstats" or die "can't open runstats: $!";
+ open LOG, ">> logfile " or die "can't open logfile: $!";
+
+ A few things to notice. First, the leading less-than is optional.
+ If omitted, Perl assumes that you want to open the file for reading.
+
+ The other important thing to notice is that, just as in the shell,
+ any white space before or after the filename is ignored. This is good,
+ because you wouldn't want these to do different things:
+
+ open INFO, "<datafile"
+ open INFO, "< datafile"
+ open INFO, "< datafile"
+
+ Ignoring surround whitespace also helps for when you read a filename in
+ from a different file, and forget to trim it before opening:
+
+ $filename = <INFO>; # oops, \n still there
+ open(EXTRA, "< $filename") || die "can't open $filename: $!";
+
+ This is not a bug, but a feature. Because C<open> mimics the shell in
+ its style of using redirection arrows to specify how to open the file, it
+ also does so with respect to extra white space around the filename itself
+ as well. For accessing files with naughty names, see L</"Dispelling
+ the Dweomer">.
+
+ =head2 Pipe Opens
+
+ In C, when you want to open a file using the standard I/O library,
+ you use the C<fopen> function, but when opening a pipe, you use the
+ C<popen> function. But in the shell, you just use a different redirection
+ character. That's also the case for Perl. The C<open> call
+ remains the same--just its argument differs.
+
+ If the leading character is a pipe symbol, C<open) starts up a new
+ command and open a write-only filehandle leading into that command.
+ This lets you write into that handle and have what you write show up on
+ that command's standard input. For example:
+
+ open(PRINTER, "| lpr -Plp1") || die "cannot fork: $!";
+ print PRINTER "stuff\n";
+ close(PRINTER) || die "can't close lpr: $!";
+
+ If the trailing character is a pipe, you start up a new command and open a
+ read-only filehandle leading out of that command. This lets whatever that
+ command writes to its standard output show up on your handle for reading.
+ For example:
+
+ open(NET, "netstat -i -n |") || die "cannot fork: $!";
+ while (<NET>) { } # do something with input
+ close(NET) || die "can't close netstat: $!";
+
+ What happens if you try to open a pipe to or from a non-existent command?
+ In most systems, such an C<open> will not return an error. That's
+ because in the traditional C<fork>/C<exec> model, running the other
+ program happens only in the forked child process, which means that
+ the failed C<exec> can't be reflected in the return value of C<open>.
+ Only a failed C<fork> shows up there. See L<perlfaq8/"Why doesn't open()
+ return an error when a pipe open fails?"> to see how to cope with this.
+ There's also an explanation in L<perlipc>.
+
+ If you would like to open a bidirectional pipe, the IPC::Open2
+ library will handle this for you. Check out L<perlipc/"Bidirectional
+ Communication with Another Process">
+
+ =head2 The Minus File
+
+ Again following the lead of the standard shell utilities, Perl's
+ C<open> function treats a file whose name is a single minus, "-", in a
+ special way. If you open minus for reading, it really means to access
+ the standard input. If you open minus for writing, it really means to
+ access the standard output.
+
+ If minus can be used as the default input or default output? What happens
+ if you open a pipe into or out of minus? What's the default command it
+ would run? The same script as you're current running! This is actually
+ a stealth C<fork> hidden inside an C<open> call. See L<perlipc/"Safe Pipe
+ Opens"> for details.
+
+ =head2 Mixing Reads and Writes
+
+ It is possible to specify both read and write access. All you do is
+ add a "+" symbol in front of the redirection. But as in the shell,
+ using a less-than on a file never creates a new file; it only opens an
+ existing one. On the other hand, using a greater-than always clobbers
+ (truncates to zero length) an existing file, or creates a brand-new one
+ if there isn't an old one. Adding a "+" for read-write doesn't affect
+ whether it only works on existing files or always clobbers existing ones.
+
+ open(WTMP, "+< /usr/adm/wtmp")
+ || die "can't open /usr/adm/wtmp: $!";
+
+ open(SCREEN, "+> /tmp/lkscreen")
+ || die "can't open /tmp/lkscreen: $!";
+
+ open(LOGFILE, "+>> /tmp/applog"
+ || die "can't open /tmp/applog: $!";
+
+ The first one won't create a new file, and the second one will always
+ clobber an old one. The third one will create a new file if necessary
+ and not clobber an old one, and it will allow you to read at any point
+ in the file, but all writes will always go to the end. In short,
+ the first case is substantially more common than the second and third
+ cases, which are almost always wrong. (If you know C, the plus in
+ Perl's C<open> is historically derived from the one in C's fopen(3S),
+ which it ultimately calls.)
+
+ In fact, when it comes to updating a file, unless you're working on
+ a binary file as in the WTMP case above, you probably don't want to
+ use this approach for updating. Instead, Perl's B<-i> flag comes to
+ the rescue. The following command takes all the C, C++, or yacc source
+ or header files and changes all their foo's to bar's, leaving
+ the old version in the original file name with a ".orig" tacked
+ on the end:
+
+ $ perl -i.orig -pe 's/\bfoo\b/bar/g' *.[Cchy]
+
+ This is a short cut for some renaming games that are really
+ the best way to update textfiles. See the second question in
+ L<perlfaq5> for more details.
+
+ =head2 Filters
+
+ One of the most common uses for C<open> is one you never
+ even notice. When you process the ARGV filehandle using
+ C<E<lt>ARGVE<gt>>, Perl actually does an implicit open
+ on each file in @ARGV. Thus a program called like this:
+
+ $ myprogram file1 file2 file3
+
+ Can have all its files opened and processed one at a time
+ using a construct no more complex than:
+
+ while (<>) {
+ # do something with $_
+ }
+
+ If @ARGV is empty when the loop first begins, Perl pretends you've opened
+ up minus, that is, the standard input. In fact, $ARGV, the currently
+ open file during C<E<lt>ARGVE<gt>> processing, is even set to "-"
+ in these circumstances.
+
+ You are welcome to pre-process your @ARGV before starting the loop to
+ make sure it's to your liking. One reason to do this might be to remove
+ command options beginning with a minus. While you can always roll the
+ simple ones by hand, the Getopts modules are good for this.
+
+ use Getopt::Std;
+
+ # -v, -D, -o ARG, sets $opt_v, $opt_D, $opt_o
+ getopts("vDo:");
+
+ # -v, -D, -o ARG, sets $args{v}, $args{D}, $args{o}
+ getopts("vDo:", \%args);
+
+ Or the standard Getopt::Long module to permit named arguments:
+
+ use Getopt::Long;
+ GetOptions( "verbose" => \$verbose, # --verbose
+ "Debug" => \$debug, # --Debug
+ "output=s" => \$output );
+ # --output=somestring or --output somestring
+
+ Another reason for preprocessing arguments is to make an empty
+ argument list default to all files:
+
+ @ARGV = glob("*") unless @ARGV;
+
+ You could even filter out all but plain, text files. This is a bit
+ silent, of course, and you might prefer to mention them on the way.
+
+ @ARGV = grep { -f && -T } @ARGV;
+
+ If you're using the B<-n> or B<-p> command-line options, you
+ should put changes to @ARGV in a C<BEGIN{}> block.
+
+ Remember that a normal C<open> has special properties, in that it might
+ call fopen(3S) or it might called popen(3S), depending on what its
+ argument looks like; that's why it's sometimes called "magic open".
+ Here's an example:
+
+ $pwdinfo = `domainname` =~ /^(\(none\))?$/
+ ? '< /etc/passwd'
+ : 'ypcat passwd |';
+
+ open(PWD, $pwdinfo)
+ or die "can't open $pwdinfo: $!";
+
+ This sort of thing also comes into play in filter processing. Because
+ C<E<lt>ARGVE<gt>> processing employs the normal, shell-style Perl C<open>,
+ it respects all the special things we've already seen:
+
+ $ myprogram f1 "cmd1|" - f2 "cmd2|" f3 < tmpfile
+
+ That program will read from the file F<f1>, the process F<cmd1>, standard
+ input (F<tmpfile> in this case), the F<f2> file, the F<cmd2> command,
+ and finally the F<f3> file.
+
+ Yes, this also means that if you have a file named "-" (and so on) in
+ your directory, that they won't be processed as literal files by C<open>.
+ You'll need to pass them as "./-" much as you would for the I<rm> program.
+ Or you could use C<sysopen> as described below.
+
+ One of the more interesting applications is to change files of a certain
+ name into pipes. For example, to autoprocess gzipped or compressed
+ files by decompressing them with I<gzip>:
+
+ @ARGV = map { /^\.(gz|Z)$/ ? "gzip -dc $_ |" : $_ } @ARGV;
+
+ Or, if you have the I<GET> program installed from LWP,
+ you can fetch URLs before processing them:
+
+ @ARGV = map { m#^\w+://# ? "GET $_ |" : $_ } @ARGV;
+
+ It's not for nothing that this is called magic C<E<lt>ARGVE<gt>>.
+ Pretty nifty, eh?
+
+ =head1 Open E<agrave> la C
+
+ If you want the convenience of the shell, then Perl's C<open> is
+ definitely the way to go. On the other hand, if you want finer precision
+ than C's simplistic fopen(3S) provides, then you should look to Perl's
+ C<sysopen>, which is a direct hook into the open(2) system call.
+ That does mean it's a bit more involved, but that's the price of
+ precision.
+
+ C<sysopen> takes 3 (or 4) arguments.
+
+ sysopen HANDLE, PATH, FLAGS, [MASK]
+
+ The HANDLE argument is a filehandle just as with C<open>. The PATH is
+ a literal path, one that doesn't pay attention to any greater-thans or
+ less-thans or pipes or minuses, nor ignore white space. If it's there,
+ it's part of the path. The FLAGS argument contains one or more values
+ derived from the Fcntl module that have been or'd together using the
+ bitwise "|" operator. The final argument, the MASK, is optional; if
+ present, it is combined with the user's current umask for the creation
+ mode of the file. You should usually omit this.
+
+ Although the traditional values of read-only, write-only, and read-write
+ are 0, 1, and 2 respectively, this is known not to hold true on some
+ systems. Instead, it's best to load in the appropriate constants first
+ from the Fcntl module, which supplies the following standard flags:
+
+ O_RDONLY Read only
+ O_WRONLY Write only
+ O_RDWR Read and write
+ O_CREAT Create the file if it doesn't exist
+ O_EXCL Fail if the file already exists
+ O_APPEND Append to the file
+ O_TRUNC Truncate the file
+ O_NONBLOCK Non-blocking access
+
+ Less common flags that are sometimes available on some operating systems
+ include C<O_BINARY>, C<O_TEXT>, C<O_SHLOCK>, C<O_EXLOCK>, C<O_DEFER>,
+ C<O_SYNC>, C<O_ASYNC>, C<O_DSYNC>, C<O_RSYNC>, C<O_NOCTTY>, C<O_NDELAY>
+ and C<O_LARGEFILE>. Consult your open(2) manpage or its local equivalent
+ for details.
+
+ Here's how to use C<sysopen> to emulate the simple C<open> calls we had
+ before. We'll omit the C<|| die $!> checks for clarity, but make sure
+ you always check the return values in real code. These aren't quite
+ the same, since C<open> will trim leading and trailing white space,
+ but you'll get the idea:
+
+ To open a file for reading:
+
+ open(FH, "< $path");
+ sysopen(FH, $path, O_RDONLY);
+
+ To open a file for writing, creating a new file if needed or else truncating
+ an old file:
+
+ open(FH, "> $path");
+ sysopen(FH, $path, O_WRONLY | O_TRUNC | O_CREAT);
+
+ To open a file for appending, creating one if necessary:
+
+ open(FH, ">> $path");
+ sysopen(FH, $path, O_WRONLY | O_APPEND | O_CREAT);
+
+ To open a file for update, where the file must already exist:
+
+ open(FH, "+< $path");
+ sysopen(FH, $path, O_RDWR);
+
+ And here are things you can do with C<sysopen> that you cannot do with
+ a regular C<open>. As you see, it's just a matter of controlling the
+ flags in the third argument.
+
+ To open a file for writing, creating a new file which must not previously
+ exist:
+
+ sysopen(FH, $path, O_WRONLY | O_EXCL | O_CREAT);
+
+ To open a file for appending, where that file must already exist:
+
+ sysopen(FH, $path, O_WRONLY | O_APPEND);
+
+ To open a file for update, creating a new file if necessary:
+
+ sysopen(FH, $path, O_RDWR | O_CREAT);
+
+ To open a file for update, where that file must not already exist:
+
+ sysopen(FH, $path, O_RDWR | O_EXCL | O_CREAT);
+
+ To open a file without blocking, creating one if necessary:
+
+ sysopen(FH, $path, O_WRONLY | O_NONBLOCK | O_CREAT);
+
+ =head2 Permissions E<agrave> la mode
+
+ If you omit the MASK argument to C<sysopen>, Perl uses the octal value
+ 0666. The normal MASK to use for executables and directories should
+ be 0777, and for anything else, 0666.
+
+ Why so permissive? Well, it isn't really. The MASK will be modified
+ by your process's current C<umask>. A umask is a number representing
+ I<disabled> permissions bits; that is, bits that will not be turned on
+ in the created files' permissions field.
+
+ For example, if your C<umask> were 027, then the 020 part would
+ disable the group from writing, and the 007 part would disable others
+ from reading, writing, or executing. Under these conditions, passing
+ C<sysopen> 0666 would create a file with mode 0640, since C<0666 &~ 027>
+ is 0640.
+
+ You should seldom use the MASK argument to C<sysopen()>. That takes
+ away the user's freedom to choose what permission new files will have.
+ Denying choice is almost always a bad thing. One exception would be for
+ cases where sensitive or private data is being stored, such as with mail
+ folders, cookie files, and internal temporary files.
+
+ =head1 Obscure Open Tricks
+
+ =head2 Re-Opening Files (dups)
+
+ Sometimes you already have a filehandle open, and want to make another
+ handle that's a duplicate of the first one. In the shell, we place an
+ ampersand in front of a file descriptor number when doing redirections.
+ For example, C<2E<gt>&1> makes descriptor 2 (that's STDERR in Perl)
+ be redirected into descriptor 1 (which is usually Perl's STDOUT).
+ The same is essentially true in Perl: a filename that begins with an
+ ampersand is treated instead as a file descriptor if a number, or as a
+ filehandle if a string.
+
+ open(SAVEOUT, ">&SAVEERR") || die "couldn't dup SAVEERR: $!";
+ open(MHCONTEXT, "<&4") || die "couldn't dup fd4: $!";
+
+ That means that if a function is expecting a filename, but you don't
+ want to give it a filename because you already have the file open, you
+ can just pass the filehandle with a leading ampersand. It's best to
+ use a fully qualified handle though, just in case the function happens
+ to be in a different package:
+
+ somefunction("&main::LOGFILE");
+
+ This way if somefunction() is planning on opening its argument, it can
+ just use the already opened handle. This differs from passing a handle,
+ because with a handle, you don't open the file. Here you have something
+ you can pass to open.
+
+ If you have one of those tricky, newfangled I/O objects that the C++
+ folks are raving about, then this doesn't work because those aren't a
+ proper filehandle in the native Perl sense. You'll have to use fileno()
+ to pull out the proper descriptor number, assuming you can:
+
+ use IO::Socket;
+ $handle = IO::Socket::INET->new("www.perl.com:80");
+ $fd = $handle->fileno;
+ somefunction("&$fd"); # not an indirect function call
+
+ It can be easier (and certainly will be faster) just to use real
+ filehandles though:
+
+ use IO::Socket;
+ local *REMOTE = IO::Socket::INET->new("www.perl.com:80");
+ die "can't connect" unless defined(fileno(REMOTE));
+ somefunction("&main::REMOTE");
+
+ If the filehandle or descriptor number is preceded not just with a simple
+ "&" but rather with a "&=" combination, then Perl will not create a
+ completely new descriptor opened to the same place using the dup(2)
+ system call. Instead, it will just make something of an alias to the
+ existing one using the fdopen(3S) library call This is slightly more
+ parsimonious of systems resources, although this is less a concern
+ these days. Here's an example of that:
+
+ $fd = $ENV{"MHCONTEXTFD"};
+ open(MHCONTEXT, "<&=$fd") or die "couldn't fdopen $fd: $!";
+
+ If you're using magic C<E<lt>ARGVE<gt>>, you could even pass in as a
+ command line argument in @ARGV something like C<"E<lt>&=$MHCONTEXTFD">,
+ but we've never seen anyone actually do this.
+
+ =head2 Dispelling the Dweomer
+
+ Perl is more of a DWIMmer language than something like Java--where DWIM
+ is an acronym for "do what I mean". But this principle sometimes leads
+ to more hidden magic than one knows what to do with. In this way, Perl
+ is also filled with I<dweomer>, an obscure word meaning an enchantment.
+ Sometimes, Perl's DWIMmer is just too much like dweomer for comfort.
+
+ If magic C<open> is a bit too magical for you, you don't have to turn
+ to C<sysopen>. To open a file with arbitrary weird characters in
+ it, it's necessary to protect any leading and trailing whitespace.
+ Leading whitespace is protected by inserting a C<"./"> in front of a
+ filename that starts with whitespace. Trailing whitespace is protected
+ by appending an ASCII NUL byte (C<"\0">) at the end off the string.
+
+ $file =~ s#^(\s)#./$1#;
+ open(FH, "< $file\0") || die "can't open $file: $!";
+
+ This assumes, of course, that your system considers dot the current
+ working directory, slash the directory separator, and disallows ASCII
+ NULs within a valid filename. Most systems follow these conventions,
+ including all POSIX systems as well as proprietary Microsoft systems.
+ The only vaguely popular system that doesn't work this way is the
+ proprietary Macintosh system, which uses a colon where the rest of us
+ use a slash. Maybe C<sysopen> isn't such a bad idea after all.
+
+ If you want to use C<E<lt>ARGVE<gt>> processing in a totally boring
+ and non-magical way, you could do this first:
+
+ # "Sam sat on the ground and put his head in his hands.
+ # 'I wish I had never come here, and I don't want to see
+ # no more magic,' he said, and fell silent."
+ for (@ARGV) {
+ s#^([^./])#./$1#;
+ $_ .= "\0";
+ }
+ while (<>) {
+ # now process $_
+ }
+
+ But be warned that users will not appreciate being unable to use "-"
+ to mean standard input, per the standard convention.
+
+ =head2 Paths as Opens
+
+ You've probably noticed how Perl's C<warn> and C<die> functions can
+ produce messages like:
+
+ Some warning at scriptname line 29, <FH> chunk 7.
+
+ That's because you opened a filehandle FH, and had read in seven records
+ from it. But what was the name of the file, not the handle?
+
+ If you aren't running with C<strict refs>, or if you've turn them off
+ temporarily, then all you have to do is this:
+
+ open($path, "< $path") || die "can't open $path: $!";
+ while (<$path>) {
+ # whatever
+ }
+
+ Since you're using the pathname of the file as its handle,
+ you'll get warnings more like
+
+ Some warning at scriptname line 29, </etc/motd> chunk 7.
+
+ =head2 Single Argument Open
+
+ Remember how we said that Perl's open took two arguments? That was a
+ passive prevarication. You see, it can also take just one argument.
+ If and only if the variable is a global variable, not a lexical, you
+ can pass C<open> just one argument, the filehandle, and it will
+ get the path from the global scalar variable of the same name.
+
+ $FILE = "/etc/motd";
+ open FILE or die "can't open $FILE: $!";
+ while (<FILE>) {
+ # whatever
+ }
+
+ Why is this here? Someone has to cater to the hysterical porpoises.
+ It's something that's been in Perl since the very beginning, if not
+ before.
+
+ =head2 Playing with STDIN and STDOUT
+
+ One clever move with STDOUT is to explicitly close it when you're done
+ with the program.
+
+ END { close(STDOUT) || die "can't close stdout: $!" }
+
+ If you don't do this, and your program fills up the disk partition due
+ to a command line redirection, it won't report the error exit with a
+ failure status.
+
+ You don't have to accept the STDIN and STDOUT you were given. You are
+ welcome to reopen them if you'd like.
+
+ open(STDIN, "< datafile")
+ || die "can't open datafile: $!";
+
+ open(STDOUT, "> output")
+ || die "can't open output: $!";
+
+ And then these can be read directly or passed on to subprocesses.
+ This makes it look as though the program were initially invoked
+ with those redirections from the command line.
+
+ It's probably more interesting to connect these to pipes. For example:
+
+ $pager = $ENV{PAGER} || "(less || more)";
+ open(STDOUT, "| $pager")
+ || die "can't fork a pager: $!";
+
+ This makes it appear as though your program were called with its stdout
+ already piped into your pager. You can also use this kind of thing
+ in conjunction with an implicit fork to yourself. You might do this
+ if you would rather handle the post processing in your own program,
+ just in a different process:
+
+ head(100);
+ while (<>) {
+ print;
+ }
+
+ sub head {
+ my $lines = shift || 20;
+ return unless $pid = open(STDOUT, "|-");
+ die "cannot fork: $!" unless defined $pid;
+ while (<STDIN>) {
+ print;
+ last if --$lines < 0;
+ }
+ exit;
+ }
+
+ This technique can be applied to repeatedly push as many filters on your
+ output stream as you wish.
+
+ =head1 Other I/O Issues
+
+ These topics aren't really arguments related to C<open> or C<sysopen>,
+ but they do affect what you do with your open files.
+
+ =head2 Opening Non-File Files
+
+ When is a file not a file? Well, you could say when it exists but
+ isn't a plain file. We'll check whether it's a symbolic link first,
+ just in case.
+
+ if (-l $file || ! -f _) {
+ print "$file is not a plain file\n";
+ }
+
+ What other kinds of files are there than, well, files? Directories,
+ symbolic links, named pipes, Unix-domain sockets, and block and character
+ devices. Those are all files, too--just not I<plain> files. This isn't
+ the same issue as being a text file. Not all text files are plain files.
+ Not all plain files are textfiles. That's why there are separate C<-f>
+ and C<-T> file tests.
+
+ To open a directory, you should use the C<opendir> function, then
+ process it with C<readdir>, carefully restoring the directory
+ name if necessary:
+
+ opendir(DIR, $dirname) or die "can't opendir $dirname: $!";
+ while (defined($file = readdir(DIR))) {
+ # do something with "$dirname/$file"
+ }
+ closedir(DIR);
+
+ If you want to process directories recursively, it's better to use the
+ File::Find module. For example, this prints out all files recursively,
+ add adds a slash to their names if the file is a directory.
+
+ @ARGV = qw(.) unless @ARGV;
+ use File::Find;
+ find sub { print $File::Find::name, -d && '/', "\n" }, @ARGV;
+
+ This finds all bogus symbolic links beneath a particular directory:
+
+ find sub { print "$File::Find::name\n" if -l && !-e }, $dir;
+
+ As you see, with symbolic links, you can just pretend that it is
+ what it points to. Or, if you want to know I<what> it points to, then
+ C<readlink> is called for:
+
+ if (-l $file) {
+ if (defined($whither = readlink($file))) {
+ print "$file points to $whither\n";
+ } else {
+ print "$file points nowhere: $!\n";
+ }
+ }
+
+ Named pipes are a different matter. You pretend they're regular files,
+ but their opens will normally block until there is both a reader and
+ a writer. You can read more about them in L<perlipc/"Named Pipes">.
+ Unix-domain sockets are rather different beasts as well; they're
+ described in L<perlipc/"Unix-Domain TCP Clients and Servers">.
+
+ When it comes to opening devices, it can be easy and it can tricky.
+ We'll assume that if you're opening up a block device, you know what
+ you're doing. The character devices are more interesting. These are
+ typically used for modems, mice, and some kinds of printers. This is
+ described in L<perlfaq8/"How do I read and write the serial port?">
+ It's often enough to open them carefully:
+
+ sysopen(TTYIN, "/dev/ttyS1", O_RDWR | O_NDELAY | O_NOCTTY)
+ # (O_NOCTTY no longer needed on POSIX systems)
+ or die "can't open /dev/ttyS1: $!";
+ open(TTYOUT, "+>&TTYIN")
+ or die "can't dup TTYIN: $!";
+
+ $ofh = select(TTYOUT); $| = 1; select($ofh);
+
+ print TTYOUT "+++at\015";
+ $answer = <TTYIN>;
+
+ With descriptors that you haven't opened using C<sysopen>, such as a
+ socket, you can set them to be non-blocking using C<fcntl>:
+
+ use Fcntl;
+ fcntl(Connection, F_SETFL, O_NONBLOCK)
+ or die "can't set non blocking: $!";
+
+ Rather than losing yourself in a morass of twisting, turning C<ioctl>s,
+ all dissimilar, if you're going to manipulate ttys, it's best to
+ make calls out to the stty(1) program if you have it, or else use the
+ portable POSIX interface. To figure this all out, you'll need to read the
+ termios(3) manpage, which describes the POSIX interface to tty devices,
+ and then L<POSIX>, which describes Perl's interface to POSIX. There are
+ also some high-level modules on CPAN that can help you with these games.
+ Check out Term::ReadKey and Term::ReadLine.
+
+ What else can you open? To open a connection using sockets, you won't use
+ one of Perl's two open functions. See L<perlipc/"Sockets: Client/Server
+ Communication"> for that. Here's an example. Once you have it,
+ you can use FH as a bidirectional filehandle.
+
+ use IO::Socket;
+ local *FH = IO::Socket::INET->new("www.perl.com:80");
+
+ For opening up a URL, the LWP modules from CPAN are just what
+ the doctor ordered. There's no filehandle interface, but
+ it's still easy to get the contents of a document:
+
+ use LWP::Simple;
+ $doc = get('http://www.sn.no/libwww-perl/');
+
+ =head2 Binary Files
+
+ On certain legacy systems with what could charitably be called terminally
+ convoluted (some would say broken) I/O models, a file isn't a file--at
+ least, not with respect to the C standard I/O library. On these old
+ systems whose libraries (but not kernels) distinguish between text and
+ binary streams, to get files to behave properly you'll have to bend over
+ backwards to avoid nasty problems. On such infelicitous systems, sockets
+ and pipes are already opened in binary mode, and there is currently no
+ way to turn that off. With files, you have more options.
+
+ Another option is to use the C<binmode> function on the appropriate
+ handles before doing regular I/O on them:
+
+ binmode(STDIN);
+ binmode(STDOUT);
+ while (<STDIN>) { print }
+
+ Passing C<sysopen> a non-standard flag option will also open the file in
+ binary mode on those systems that support it. This is the equivalent of
+ opening the file normally, then calling C<binmode>ing on the handle.
+
+ sysopen(BINDAT, "records.data", O_RDWR | O_BINARY)
+ || die "can't open records.data: $!";
+
+ Now you can use C<read> and C<print> on that handle without worrying
+ about the system non-standard I/O library breaking your data. It's not
+ a pretty picture, but then, legacy systems seldom are. CP/M will be
+ with us until the end of days, and after.
+
+ On systems with exotic I/O systems, it turns out that, astonishingly
+ enough, even unbuffered I/O using C<sysread> and C<syswrite> might do
+ sneaky data mutilation behind your back.
+
+ while (sysread(WHENCE, $buf, 1024)) {
+ syswrite(WHITHER, $buf, length($buf));
+ }
+
+ Depending on the vicissitudes of your runtime system, even these calls
+ may need C<binmode> or C<O_BINARY> first. Systems known to be free of
+ such difficulties include Unix, the Mac OS, Plan9, and Inferno.
+
+ =head2 File Locking
+
+ In a multitasking environment, you may need to be careful not to collide
+ with other processes who want to do I/O on the same files as others
+ are working on. You'll often need shared or exclusive locks
+ on files for reading and writing respectively. You might just
+ pretend that only exclusive locks exist.
+
+ Never use the existence of a file C<-e $file> as a locking indication,
+ because there is a race condition between the test for the existence of
+ the file and its creation. Atomicity is critical.
+
+ Perl's most portable locking interface is via the C<flock> function,
+ whose simplicity is emulated on systems that don't directly support it,
+ such as SysV or WindowsNT. The underlying semantics may affect how
+ it all works, so you should learn how C<flock> is implemented on your
+ system's port of Perl.
+
+ File locking I<does not> lock out another process that would like to
+ do I/O. A file lock only locks out others trying to get a lock, not
+ processes trying to do I/O. Because locks are advisory, if one process
+ uses locking and another doesn't, all bets are off.
+
+ By default, the C<flock> call will block until a lock is granted.
+ A request for a shared lock will be granted as soon as there is no
+ exclusive locker. A request for a exclusive lock will be granted as
+ soon as there is no locker of any kind. Locks are on file descriptors,
+ not file names. You can't lock a file until you open it, and you can't
+ hold on to a lock once the file has been closed.
+
+ Here's how to get a blocking shared lock on a file, typically used
+ for reading:
+
+ use 5.004;
+ use Fcntl qw(:DEFAULT :flock);
+ open(FH, "< filename") or die "can't open filename: $!";
+ flock(FH, LOCK_SH) or die "can't lock filename: $!";
+ # now read from FH
+
+ You can get a non-blocking lock by using C<LOCK_NB>.
+
+ flock(FH, LOCK_SH | LOCK_NB)
+ or die "can't lock filename: $!";
+
+ This can be useful for producing more user-friendly behaviour by warning
+ if you're going to be blocking:
+
+ use 5.004;
+ use Fcntl qw(:DEFAULT :flock);
+ open(FH, "< filename") or die "can't open filename: $!";
+ unless (flock(FH, LOCK_SH | LOCK_NB)) {
+ $| = 1;
+ print "Waiting for lock...";
+ flock(FH, LOCK_SH) or die "can't lock filename: $!";
+ print "got it.\n"
+ }
+ # now read from FH
+
+ To get an exclusive lock, typically used for writing, you have to be
+ careful. We C<sysopen> the file so it can be locked before it gets
+ emptied. You can get a nonblocking version using C<LOCK_EX | LOCK_NB>.
+
+ use 5.004;
+ use Fcntl qw(:DEFAULT :flock);
+ sysopen(FH, "filename", O_WRONLY | O_CREAT)
+ or die "can't open filename: $!";
+ flock(FH, LOCK_EX)
+ or die "can't lock filename: $!";
+ truncate(FH, 0)
+ or die "can't truncate filename: $!";
+ # now write to FH
+
+ Finally, due to the uncounted millions who cannot be dissuaded from
+ wasting cycles on useless vanity devices called hit counters, here's
+ how to increment a number in a file safely:
+
+ use Fcntl qw(:DEFAULT :flock);
+
+ sysopen(FH, "numfile", O_RDWR | O_CREAT)
+ or die "can't open numfile: $!";
+ # autoflush FH
+ $ofh = select(FH); $| = 1; select ($ofh);
+ flock(FH, LOCK_EX)
+ or die "can't write-lock numfile: $!";
+
+ $num = <FH> || 0;
+ seek(FH, 0, 0)
+ or die "can't rewind numfile : $!";
+ print FH $num+1, "\n"
+ or die "can't write numfile: $!";
+
+ truncate(FH, tell(FH))
+ or die "can't truncate numfile: $!";
+ close(FH)
+ or die "can't close numfile: $!";
+
+ =head1 SEE ALSO
+
+ The C<open> and C<sysopen> function in perlfunc(1);
+ the standard open(2), dup(2), fopen(3), and fdopen(3) manpages;
+ the POSIX documentation.
+
+ =head1 AUTHOR and COPYRIGHT
+
+ Copyright 1998 Tom Christiansen.
+
+ When included as part of the Standard Version of Perl, or as part of
+ its complete documentation whether printed or otherwise, this work may
+ be distributed only under the terms of Perl's Artistic License. Any
+ distribution of this file or derivatives thereof outside of that
+ package require that special arrangements be made with copyright
+ holder.
+
+ Irrespective of its distribution, all code examples in these files are
+ hereby placed into the public domain. You are permitted and
+ encouraged to use this code in your own programs for fun or for profit
+ as you see fit. A simple comment in the code giving credit would be
+ courteous but is not required.
+
+ =head1 HISTORY
+
+ First release: Sat Jan 9 08:09:11 MST 1999
diff -c 'perl5.005_02/pod/perlpod.pod' 'perl5.005_03/pod/perlpod.pod'
Index: ./pod/perlpod.pod
*** ./pod/perlpod.pod Thu Jul 23 23:01:44 1998
--- ./pod/perlpod.pod Sat Mar 27 16:45:41 1999
***************
*** 171,177 ****
(the quotes are optional)
L</"sec"> ditto
same as above but only 'text' is used for output.
! (Text can not contain the characters '|' or '>')
L<text|name>
L<text|name/ident>
L<text|name/"sec">
--- 171,178 ----
(the quotes are optional)
L</"sec"> ditto
same as above but only 'text' is used for output.
! (Text can not contain the characters '/' and '|',
! and should contain matched '<' or '>')
L<text|name>
L<text|name/ident>
L<text|name/"sec">
***************
*** 184,189 ****
--- 185,192 ----
E<escape> A named character (very similar to HTML escapes)
E<lt> A literal <
E<gt> A literal >
+ E<sol> A literal /
+ E<verbar> A literal |
(these are optional except in other interior
sequences and when preceded by a capital letter)
E<n> Character number n (probably in ASCII)
diff -c 'perl5.005_02/pod/perlport.pod' 'perl5.005_03/pod/perlport.pod'
Index: ./pod/perlport.pod
*** ./pod/perlport.pod Fri Aug 7 22:18:01 1998
--- ./pod/perlport.pod Thu Feb 11 18:06:09 1999
***************
*** 84,90 ****
=head2 Newlines
! In most operating systems, lines in files are separated with newlines.
Just what is used as a newline may vary from OS to OS. Unix
traditionally uses C<\012>, one kind of Windows I/O uses C<\015\012>,
and S<Mac OS> uses C<\015>.
--- 84,90 ----
=head2 Newlines
! In most operating systems, lines in files are terminated by newlines.
Just what is used as a newline may vary from OS to OS. Unix
traditionally uses C<\012>, one kind of Windows I/O uses C<\015\012>,
and S<Mac OS> uses C<\015>.
***************
*** 148,153 ****
--- 148,160 ----
platforms, because now any C<\015>'s (C<\cM>'s) are stripped out
(and there was much rejoicing).
+ An important thing to remember is that functions that return data
+ should translate newlines when appropriate. Often one line of code
+ will suffice:
+
+ $data =~ s/\015?\012/\n/g;
+ return $data;
+
=head2 Numbers endianness and Width
***************
*** 175,181 ****
binary, or consider using modules like C<Data::Dumper> (included in
the standard distribution as of Perl 5.005) and C<Storable>.
! =head2 Files
Most platforms these days structure files in a hierarchical fashion.
So, it is reasonably safe to assume that any platform supports the
--- 182,188 ----
binary, or consider using modules like C<Data::Dumper> (included in
the standard distribution as of Perl 5.005) and C<Storable>.
! =head2 Files and Filesystems
Most platforms these days structure files in a hierarchical fashion.
So, it is reasonably safe to assume that any platform supports the
***************
*** 183,191 ****
how that path is actually written, differs.
While they are similar, file path specifications differ between Unix,
! Windows, S<Mac OS>, OS/2, VMS, S<RISC OS> and probably others. Unix,
! for example, is one of the few OSes that has the idea of a single root
! directory.
VMS, Windows, and OS/2 can work similarly to Unix with C</> as path
separator, or in their own idiosyncratic ways (such as having several
--- 190,198 ----
how that path is actually written, differs.
While they are similar, file path specifications differ between Unix,
! Windows, S<Mac OS>, OS/2, VMS, VOS, S<RISC OS> and probably others.
! Unix, for example, is one of the few OSes that has the idea of a single
! root directory.
VMS, Windows, and OS/2 can work similarly to Unix with C</> as path
separator, or in their own idiosyncratic ways (such as having several
***************
*** 194,199 ****
--- 201,218 ----
S<Mac OS> uses C<:> as a path separator instead of C</>.
+ The filesystem may support neither hard links (C<link()>) nor
+ symbolic links (C<symlink()>, C<readlink()>, C<lstat()>).
+
+ The filesystem may not support neither access timestamp nor change
+ timestamp (meaning that about the only portable timestamp is the
+ modification timestamp), or one second granularity of any timestamps
+ (e.g. the FAT filesystem limits the time granularity to two seconds).
+
+ VOS perl can emulate Unix filenames with C</> as path separator. The
+ native pathname characters greater-than, less-than, number-sign, and
+ percent-sign are always accepted.
+
C<RISC OS> perl can emulate Unix filenames with C</> as path
separator, or go native and use C<.> for path separator and C<:> to
signal filing systems and disc names.
***************
*** 224,242 ****
splits a pathname into pieces (base filename, full path to directory,
and file suffix).
! Even when on a single platform (if you can call UNIX a single
! platform), remember not to count on the existence or the contents of
! system-specific files, like F</etc/passwd>, F</etc/sendmail.conf>, or
! F</etc/resolv.conf>. For example the F</etc/passwd> may exist but it
! may not contain the encrypted passwords because the system is using
! some form of enhanced security-- or it may not contain all the
! accounts because the system is using NIS. If code does need to rely
! on such a file, include a description of the file and its format in
! the code's documentation, and make it easy for the user to override
! the default location of the file.
Do not have two files of the same name with different case, like
! F<test.pl> and <Test.pl>, as many platforms have case-insensitive
filenames. Also, try not to have non-word characters (except for C<.>)
in the names, and keep them to the 8.3 convention, for maximum
portability.
--- 243,263 ----
splits a pathname into pieces (base filename, full path to directory,
and file suffix).
! Even when on a single platform (if you can call UNIX a single platform),
! remember not to count on the existence or the contents of
! system-specific files or directories, like F</etc/passwd>,
! F</etc/sendmail.conf>, F</etc/resolv.conf>, or even F</tmp/>. For
! example, F</etc/passwd> may exist but it may not contain the encrypted
! passwords because the system is using some form of enhanced security --
! or it may not contain all the accounts because the system is using NIS.
! If code does need to rely on such a file, include a description of the
! file and its format in the code's documentation, and make it easy for
! the user to override the default location of the file.
!
! Don't assume a text file will end with a newline.
Do not have two files of the same name with different case, like
! F<test.pl> and F<Test.pl>, as many platforms have case-insensitive
filenames. Also, try not to have non-word characters (except for C<.>)
in the names, and keep them to the 8.3 convention, for maximum
portability.
***************
*** 246,256 ****
make it so the resulting files have a unique (case-insensitively)
first 8 characters.
! Don't assume C<E<lt>> won't be the first character of a filename. Always
! use C<E<gt>> explicitly to open a file for reading:
open(FILE, "<$existing_file") or die $!;
=head2 System Interaction
--- 267,283 ----
make it so the resulting files have a unique (case-insensitively)
first 8 characters.
! There certainly can be whitespace in filenames. Many systems (DOS,
! VMS) cannot have more than one C<"."> in their filenames.
!
! Don't assume C<E<gt>> won't be the first character of a filename.
! Always use C<E<lt>> explicitly to open a file for reading.
open(FILE, "<$existing_file") or die $!;
+ Actually, though, if filenames might use strange characters, it is
+ safest to open it with C<sysopen> instead of C<open>, which is magic.
+
=head2 System Interaction
***************
*** 280,285 ****
--- 307,314 ----
Don't count on per-program environment variables, or per-program current
directories.
+ Don't count on specific values of C<$!>.
+
=head2 Interprocess Communication (IPC)
***************
*** 316,321 ****
--- 345,351 ----
The UNIX System V IPC (C<msg*(), sem*(), shm*()>) is not available
even in all UNIX platforms.
+
=head2 External Subroutines (XS)
XS code, in general, can be made to work with any platform; but dependent
***************
*** 371,377 ****
Assume very little about character sets. Do not assume anything about
the numerical values (C<ord()>, C<chr()>) of characters. Do not
assume that the alphabetic characters are encoded contiguously (in
! numerical sense). Do no assume anything about the ordering of the
characters. The lowercase letters may come before or after the
uppercase letters, the lowercase and uppercase may be interlaced so
that both 'a' and 'A' come before the 'b', the accented and other
--- 401,407 ----
Assume very little about character sets. Do not assume anything about
the numerical values (C<ord()>, C<chr()>) of characters. Do not
assume that the alphabetic characters are encoded contiguously (in
! numerical sense). Do not assume anything about the ordering of the
characters. The lowercase letters may come before or after the
uppercase letters, the lowercase and uppercase may be interlaced so
that both 'a' and 'A' come before the 'b', the accented and other
***************
*** 381,390 ****
=head2 Internationalisation
! If you may assume POSIX (a rather large assumption, that: in practise
! that means UNIX) you may read more about the POSIX locale system from
L<perllocale>. The locale system at least attempts to make things a
! little bit more portable or at least more convenient and
native-friendly for non-English users. The system affects character
sets and encoding, and date and time formatting, among other things.
--- 411,420 ----
=head2 Internationalisation
! If you may assume POSIX (a rather large assumption, that in practice
! means UNIX), you may read more about the POSIX locale system from
L<perllocale>. The locale system at least attempts to make things a
! little bit more portable, or at least more convenient and
native-friendly for non-English users. The system affects character
sets and encoding, and date and time formatting, among other things.
***************
*** 476,482 ****
FreeBSD freebsd freebsd-i386
Linux linux i386-linux
HP-UX hpux PA-RISC1.1
! IRIX irix irix
OSF1 dec_osf alpha-dec_osf
SunOS solaris sun4-solaris
SunOS solaris i86pc-solaris
--- 506,512 ----
FreeBSD freebsd freebsd-i386
Linux linux i386-linux
HP-UX hpux PA-RISC1.1
! IRIX irix irix
OSF1 dec_osf alpha-dec_osf
SunOS solaris sun4-solaris
SunOS solaris i86pc-solaris
***************
*** 547,553 ****
=item The djgpp environment for DOS, C<http://www.delorie.com/djgpp/>
=item The EMX environment for DOS, OS/2, etc. C<emx@iaehv.nl>,
! C<http://www.juge.com/bbs/Hobb.19.html>
=item Build instructions for Win32, L<perlwin32>.
--- 577,584 ----
=item The djgpp environment for DOS, C<http://www.delorie.com/djgpp/>
=item The EMX environment for DOS, OS/2, etc. C<emx@iaehv.nl>,
! C<http://www.leo.org/pub/comp/os/os2/leo/gnu/emx+gcc/index.html> or
! C<ftp://hobbes.nmsu.edu/pub/os2/dev/emx>
=item Build instructions for Win32, L<perlwin32>.
***************
*** 578,584 ****
which is reserved as a path separator.
Instead of C<flock>, see C<FSpSetFLock> and C<FSpRstFLock> in the
! C<Mac::Files> module.
In the MacPerl application, you can't run a program from the command line;
programs that expect C<@ARGV> to be populated can be edited with something
--- 609,615 ----
which is reserved as a path separator.
Instead of C<flock>, see C<FSpSetFLock> and C<FSpRstFLock> in the
! C<Mac::Files> module, or C<chmod(0444, ...)> and C<chmod(0666, ...)>.
In the MacPerl application, you can't run a program from the command line;
programs that expect C<@ARGV> to be populated can be edited with something
***************
*** 613,622 ****
$is_ppc = $MacPerl::Architecture eq 'MacPPC';
$is_68k = $MacPerl::Architecture eq 'Mac68K';
! S<Mac OS X>, to be based on NeXT's OpenStep OS, will be able to run
! MacPerl natively (in the Blue Box, and even in the Yellow Box, once some
! changes to the toolbox calls are made), but Unix perl will also run
! natively.
Also see:
--- 644,652 ----
$is_ppc = $MacPerl::Architecture eq 'MacPPC';
$is_68k = $MacPerl::Architecture eq 'Mac68K';
! S<Mac OS X>, to be based on NeXT's OpenStep OS, will (in theory) be able
! to run MacPerl natively, but Unix perl will also run natively under the
! built-in Unix environment.
Also see:
***************
*** 727,744 ****
=back
=head2 EBCDIC Platforms
Recent versions of Perl have been ported to platforms such as OS/400 on
! AS/400 minicomputers as well as OS/390 for IBM Mainframes. Such computers
! use EBCDIC character sets internally (usually Character Code Set ID 00819
! for OS/400 and IBM-1047 for OS/390). Note that on the mainframe perl
! currently works under the "Unix system services for OS/390" (formerly
! known as OpenEdition).
!
! As of R2.5 of USS for OS/390 that Unix sub-system did not support the
! C<#!> shebang trick for script invocation. Hence, on OS/390 perl scripts
! can executed with a header similar to the following simple script:
: # use perl
eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
--- 757,840 ----
=back
+ =head2 VOS
+
+ Perl on VOS is discussed in F<README.vos> in the perl distribution.
+ Note that perl on VOS can accept either VOS- or Unix-style file
+ specifications as in either of the following:
+
+ $ perl -ne "print if /perl_setup/i" >system>notices
+ $ perl -ne "print if /perl_setup/i" /system/notices
+
+ or even a mixture of both as in:
+
+ $ perl -ne "print if /perl_setup/i" >system/notices
+
+ Note that even though VOS allows the slash character to appear in object
+ names, because the VOS port of Perl interprets it as a pathname
+ delimiting character, VOS files, directories, or links whose names
+ contain a slash character cannot be processed. Such files must be
+ renamed before they can be processed by Perl.
+
+ The following C functions are unimplemented on VOS, and any attempt by
+ Perl to use them will result in a fatal error message and an immediate
+ exit from Perl: dup, do_aspawn, do_spawn, fork, waitpid. Once these
+ functions become available in the VOS POSIX.1 implementation, you can
+ either recompile and rebind Perl, or you can download a newer port from
+ ftp.stratus.com.
+
+ The value of C<$^O> on VOS is "VOS". To determine the architecture that
+ you are running on without resorting to loading all of C<%Config> you
+ can examine the content of the C<@INC> array like so:
+
+ if (grep(/VOS/, @INC)) {
+ print "I'm on a Stratus box!\n";
+ } else {
+ print "I'm not on a Stratus box!\n";
+ die;
+ }
+
+ if (grep(/860/, @INC)) {
+ print "This box is a Stratus XA/R!\n";
+ } elsif (grep(/7100/, @INC)) {
+ print "This box is a Stratus HP 7100 or 8000!\n";
+ } elsif (grep(/8000/, @INC)) {
+ print "This box is a Stratus HP 8000!\n";
+ } else {
+ print "This box is a Stratus 68K...\n";
+ }
+
+ Also see:
+
+ =over 4
+
+ =item L<README.vos>
+
+ =item VOS mailing list
+
+ There is no specific mailing list for Perl on VOS. You can post
+ comments to the comp.sys.stratus newsgroup, or subscribe to the general
+ Stratus mailing list. Send a letter with "Subscribe Info-Stratus" in
+ the message body to majordomo@list.stratagy.com.
+
+ =item VOS Perl on the web at C<http://ftp.stratus.com/pub/vos/vos.html>
+
+ =back
+
+
=head2 EBCDIC Platforms
Recent versions of Perl have been ported to platforms such as OS/400 on
! AS/400 minicomputers as well as OS/390 & VM/ESA for IBM Mainframes. Such
! computers use EBCDIC character sets internally (usually Character Code
! Set ID 00819 for OS/400 and IBM-1047 for OS/390 & VM/ESA). Note that on
! the mainframe perl currently works under the "Unix system services
! for OS/390" (formerly known as OpenEdition) and VM/ESA OpenEdition.
!
! As of R2.5 of USS for OS/390 and Version 2.3 of VM/ESA these Unix
! sub-systems do not support the C<#!> shebang trick for script invocation.
! Hence, on OS/390 and VM/ESA perl scripts can be executed with a header
! similar to the following simple script:
: # use perl
eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
***************
*** 752,767 ****
C<pack>, C<print>, C<printf>, C<ord>, C<sort>, C<sprintf>, C<unpack>), as
well as bit-fiddling with ASCII constants using operators like C<^>, C<&>
and C<|>, not to mention dealing with socket interfaces to ASCII computers
! (see L<"NEWLINES">).
Fortunately, most web servers for the mainframe will correctly translate
the C<\n> in the following statement to its ASCII equivalent (note that
! C<\r> is the same under both Unix and OS/390):
print "Content-type: text/html\r\n\r\n";
The value of C<$^O> on OS/390 is "os390".
Some simple tricks for determining if you are running on an EBCDIC
platform could include any of the following (perhaps all):
--- 848,865 ----
C<pack>, C<print>, C<printf>, C<ord>, C<sort>, C<sprintf>, C<unpack>), as
well as bit-fiddling with ASCII constants using operators like C<^>, C<&>
and C<|>, not to mention dealing with socket interfaces to ASCII computers
! (see L<Newlines>).
Fortunately, most web servers for the mainframe will correctly translate
the C<\n> in the following statement to its ASCII equivalent (note that
! C<\r> is the same under both Unix and OS/390 & VM/ESA):
print "Content-type: text/html\r\n\r\n";
The value of C<$^O> on OS/390 is "os390".
+ The value of C<$^O> on VM/ESA is "vmesa".
+
Some simple tricks for determining if you are running on an EBCDIC
platform could include any of the following (perhaps all):
***************
*** 834,840 ****
expand system variables in filenames if enclosed in angle brackets, so
C<E<lt>System$DirE<gt>.Modules> would look for the file
S<C<$ENV{'System$Dir'} . 'Modules'>>. The obvious implication of this is
! that B<fully qualified filenames can start with C<E<lt>E<gt>> and should
be protected when C<open> is used for input.
Because C<.> was in use as a directory separator and filenames could not
--- 932,938 ----
expand system variables in filenames if enclosed in angle brackets, so
C<E<lt>System$DirE<gt>.Modules> would look for the file
S<C<$ENV{'System$Dir'} . 'Modules'>>. The obvious implication of this is
! that B<fully qualified filenames can start with C<E<lt>E<gt>>> and should
be protected when C<open> is used for input.
Because C<.> was in use as a directory separator and filenames could not
***************
*** 1013,1021 ****
Only good for changing "owner" and "other" read-write access. (S<RISC OS>)
=item chown LIST
! Not implemented. (S<Mac OS>, Win32, Plan9, S<RISC OS>)
Does nothing, but won't fail. (Win32)
--- 1111,1121 ----
Only good for changing "owner" and "other" read-write access. (S<RISC OS>)
+ Access permissions are mapped onto VOS access-control list changes. (VOS)
+
=item chown LIST
! Not implemented. (S<Mac OS>, Win32, Plan9, S<RISC OS>, VOS)
Does nothing, but won't fail. (Win32)
***************
*** 1023,1042 ****
=item chroot
! Not implemented. (S<Mac OS>, Win32, VMS, Plan9, S<RISC OS>)
=item crypt PLAINTEXT,SALT
May not be available if library or source was not provided when building
perl. (Win32)
=item dbmclose HASH
! Not implemented. (VMS, Plan9)
=item dbmopen HASH,DBNAME,MODE
! Not implemented. (VMS, Plan9)
=item dump LABEL
--- 1123,1144 ----
=item chroot
! Not implemented. (S<Mac OS>, Win32, VMS, Plan9, S<RISC OS>, VOS, VM/ESA)
=item crypt PLAINTEXT,SALT
May not be available if library or source was not provided when building
perl. (Win32)
+ Not implemented. (VOS)
+
=item dbmclose HASH
! Not implemented. (VMS, Plan9, VOS)
=item dbmopen HASH,DBNAME,MODE
! Not implemented. (VMS, Plan9, VOS)
=item dump LABEL
***************
*** 1050,1068 ****
Not implemented. (S<Mac OS>)
=item fcntl FILEHANDLE,FUNCTION,SCALAR
Not implemented. (Win32, VMS)
=item flock FILEHANDLE,OPERATION
! Not implemented (S<Mac OS>, VMS, S<RISC OS>).
Available only on Windows NT (not on Windows 95). (Win32)
=item fork
! Not implemented. (S<Mac OS>, Win32, AmigaOS, S<RISC OS>)
=item getlogin
--- 1152,1172 ----
Not implemented. (S<Mac OS>)
+ Implemented via Spawn. (VM/ESA)
+
=item fcntl FILEHANDLE,FUNCTION,SCALAR
Not implemented. (Win32, VMS)
=item flock FILEHANDLE,OPERATION
! Not implemented (S<Mac OS>, VMS, S<RISC OS>, VOS).
Available only on Windows NT (not on Windows 95). (Win32)
=item fork
! Not implemented. (S<Mac OS>, Win32, AmigaOS, S<RISC OS>, VOS, VM/ESA)
=item getlogin
***************
*** 1070,1076 ****
=item getpgrp PID
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item getppid
--- 1174,1180 ----
=item getpgrp PID
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS)
=item getppid
***************
*** 1078,1084 ****
=item getpriority WHICH,WHO
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item getpwnam NAME
--- 1182,1188 ----
=item getpriority WHICH,WHO
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS, VM/ESA)
=item getpwnam NAME
***************
*** 1118,1128 ****
=item getpwent
! Not implemented. (S<Mac OS>, Win32)
=item getgrent
! Not implemented. (S<Mac OS>, Win32, VMS)
=item gethostent
--- 1222,1232 ----
=item getpwent
! Not implemented. (S<Mac OS>, Win32, VM/ESA)
=item getgrent
! Not implemented. (S<Mac OS>, Win32, VMS, VM/ESA)
=item gethostent
***************
*** 1166,1176 ****
=item endpwent
! Not implemented. (S<Mac OS>, Win32)
=item endgrent
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item endhostent
--- 1270,1280 ----
=item endpwent
! Not implemented. (S<Mac OS>, Win32, VM/ESA)
=item endgrent
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VM/ESA)
=item endhostent
***************
*** 1229,1234 ****
--- 1333,1341 ----
Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
+ Link count not updated because hard links are not quite that hard
+ (They are sort of half-way between hard and soft links). (AmigaOS)
+
=item lstat FILEHANDLE
=item lstat EXPR
***************
*** 1247,1253 ****
=item msgrcv ID,VAR,SIZE,TYPE,FLAGS
! Not implemented. (S<Mac OS>, Win32, VMS, Plan9, S<RISC OS>)
=item open FILEHANDLE,EXPR
--- 1354,1360 ----
=item msgrcv ID,VAR,SIZE,TYPE,FLAGS
! Not implemented. (S<Mac OS>, Win32, VMS, Plan9, S<RISC OS>, VOS)
=item open FILEHANDLE,EXPR
***************
*** 1262,1267 ****
--- 1369,1376 ----
Not implemented. (S<Mac OS>)
+ Very limited functionality. (MiNT)
+
=item readlink EXPR
=item readlink
***************
*** 1280,1294 ****
=item semop KEY,OPSTRING
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item setpgrp PID,PGRP
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item setpriority WHICH,WHO,PRIORITY
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL
--- 1389,1403 ----
=item semop KEY,OPSTRING
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS)
=item setpgrp PID,PGRP
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS)
=item setpriority WHICH,WHO,PRIORITY
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS)
=item setsockopt SOCKET,LEVEL,OPTNAME,OPTVAL
***************
*** 1302,1312 ****
=item shmwrite ID,STRING,POS,SIZE
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item stat FILEHANDLE
--- 1411,1421 ----
=item shmwrite ID,STRING,POS,SIZE
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS)
=item socketpair SOCKET1,SOCKET2,DOMAIN,TYPE,PROTOCOL
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS, VM/ESA)
=item stat FILEHANDLE
***************
*** 1330,1343 ****
=item syscall LIST
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>)
=item sysopen FILEHANDLE,FILENAME,MODE,PERMS
The traditional "0", "1", and "2" MODEs are implemented with different
numeric values on some systems. The flags exported by C<Fcntl>
(O_RDONLY, O_WRONLY, O_RDWR) should work everywhere though. (S<Mac
! OS>, OS/390)
=item system LIST
--- 1439,1452 ----
=item syscall LIST
! Not implemented. (S<Mac OS>, Win32, VMS, S<RISC OS>, VOS, VM/ESA)
=item sysopen FILEHANDLE,FILENAME,MODE,PERMS
The traditional "0", "1", and "2" MODEs are implemented with different
numeric values on some systems. The flags exported by C<Fcntl>
(O_RDONLY, O_WRONLY, O_RDWR) should work everywhere though. (S<Mac
! OS>, OS/390, VM/ESA)
=item system LIST
***************
*** 1359,1364 ****
--- 1468,1478 ----
I<scalar> will call the native command line direct and no such emulation
of a child Unix program will exists. Mileage B<will> vary. (S<RISC OS>)
+ Far from being POSIX compliant. Because there may be no underlying
+ /bin/sh tries to work around the problem by forking and execing the
+ first token in its argument string. Handles basic redirection
+ ("E<lt>" or "E<gt>") on its own behalf. (MiNT)
+
=item times
Only the first entry returned is nonzero. (S<Mac OS>)
***************
*** 1375,1386 ****
--- 1489,1510 ----
Not implemented. (VMS)
+ Truncation to zero-length only. (VOS)
+
+ If a FILEHANDLE is supplied, it must be writable and opened in append
+ mode (i.e., use C<open(FH, '>>filename')>
+ or C<sysopen(FH,...,O_APPEND|O_RDWR)>. If a filename is supplied, it
+ should not be held open elsewhere. (Win32)
+
=item umask EXPR
=item umask
Returns undef where unavailable, as of version 5.005.
+ C<umask()> works but the correct permissions are only set when the file
+ is finally close()d. (AmigaOS)
+
=item utime LIST
Only the modification time is updated. (S<Mac OS>, VMS, S<RISC OS>)
***************
*** 1395,1401 ****
=item waitpid PID,FLAGS
! Not implemented. (S<Mac OS>)
Can only be applied to process handles returned for processes spawned
using C<system(1, ...)>. (Win32)
--- 1519,1525 ----
=item waitpid PID,FLAGS
! Not implemented. (S<Mac OS>, VOS)
Can only be applied to process handles returned for processes spawned
using C<system(1, ...)>. (Win32)
***************
*** 1408,1426 ****
=over 4
! =item 1.33, 06 August 1998
Integrate more minor changes.
! =item 1.32, 05 August 1998
Integrate more minor changes.
! =item 1.30, 03 August 1998
Major update for RISC OS, other minor changes.
! =item 1.23, 10 July 1998
First public release with perl5.005.
--- 1532,1574 ----
=over 4
! =item v1.39, 11 February, 1999
!
! Changes from Jarkko and EMX URL fixes Michael Schwern. Additional
! note about newlines added.
!
! =item v1.38, 31 December 1998
!
! More changes from Jarkko.
!
! =item v1.37, 19 December 1998
!
! More minor changes. Merge two separate version 1.35 documents.
!
! =item v1.36, 9 September 1998
!
! Updated for Stratus VOS. Also known as version 1.35.
!
! =item v1.35, 13 August 1998
!
! Integrate more minor changes, plus addition of new sections under
! L<"ISSUES">: L<"Numbers endianness and Width">,
! L<"Character sets and character encoding">,
! L<"Internationalisation">.
!
! =item v1.33, 06 August 1998
Integrate more minor changes.
! =item v1.32, 05 August 1998
Integrate more minor changes.
! =item v1.30, 03 August 1998
Major update for RISC OS, other minor changes.
! =item v1.23, 10 July 1998
First public release with perl5.005.
***************
*** 1429,1444 ****
=head1 AUTHORS / CONTRIBUTORS
Abigail E<lt>abigail@fnx.comE<gt>,
! Charles Bailey E<lt>bailey@genetics.upenn.eduE<gt>,
Graham Barr E<lt>gbarr@pobox.comE<gt>,
Tom Christiansen E<lt>tchrist@perl.comE<gt>,
Nicholas Clark E<lt>Nicholas.Clark@liverpool.ac.ukE<gt>,
Andy Dougherty E<lt>doughera@lafcol.lafayette.eduE<gt>,
Dominic Dunlop E<lt>domo@vo.luE<gt>,
M.J.T. Guy E<lt>mjtg@cus.cam.ac.ukE<gt>,
Luther Huffman E<lt>lutherh@stratcom.comE<gt>,
Nick Ing-Simmons E<lt>nick@ni-s.u-net.comE<gt>,
Andreas J. KE<ouml>nig E<lt>koenig@kulturbox.deE<gt>,
Andrew M. Langmead E<lt>aml@world.std.comE<gt>,
Paul Moore E<lt>Paul.Moore@uk.origin-it.comE<gt>,
Chris Nandor E<lt>pudge@pobox.comE<gt>,
--- 1577,1596 ----
=head1 AUTHORS / CONTRIBUTORS
Abigail E<lt>abigail@fnx.comE<gt>,
! Charles Bailey E<lt>bailey@newman.upenn.eduE<gt>,
Graham Barr E<lt>gbarr@pobox.comE<gt>,
Tom Christiansen E<lt>tchrist@perl.comE<gt>,
Nicholas Clark E<lt>Nicholas.Clark@liverpool.ac.ukE<gt>,
Andy Dougherty E<lt>doughera@lafcol.lafayette.eduE<gt>,
Dominic Dunlop E<lt>domo@vo.luE<gt>,
+ Neale Ferguson E<lt>neale@mailbox.tabnsw.com.auE<gt>
+ Paul Green E<lt>Paul_Green@stratus.comE<gt>,
M.J.T. Guy E<lt>mjtg@cus.cam.ac.ukE<gt>,
+ Jarkko Hietaniemi E<lt>jhi@iki.fi<gt>,
Luther Huffman E<lt>lutherh@stratcom.comE<gt>,
Nick Ing-Simmons E<lt>nick@ni-s.u-net.comE<gt>,
Andreas J. KE<ouml>nig E<lt>koenig@kulturbox.deE<gt>,
+ Markus Laker E<lt>mlaker@contax.co.ukE<gt>,
Andrew M. Langmead E<lt>aml@world.std.comE<gt>,
Paul Moore E<lt>Paul.Moore@uk.origin-it.comE<gt>,
Chris Nandor E<lt>pudge@pobox.comE<gt>,
***************
*** 1449,1461 ****
Hugo van der Sanden E<lt>hv@crypt0.demon.co.ukE<gt>,
Gurusamy Sarathy E<lt>gsar@umich.eduE<gt>,
Paul J. Schinder E<lt>schinder@pobox.comE<gt>,
Dan Sugalski E<lt>sugalskd@ous.eduE<gt>,
Nathan Torkington E<lt>gnat@frii.comE<gt>.
! This document is maintained by Chris Nandor.
=head1 VERSION
! Version 1.34, last modified 07 August 1998.
!
!
--- 1601,1613 ----
Hugo van der Sanden E<lt>hv@crypt0.demon.co.ukE<gt>,
Gurusamy Sarathy E<lt>gsar@umich.eduE<gt>,
Paul J. Schinder E<lt>schinder@pobox.comE<gt>,
+ Michael G Schwern E<lt>schwern@pobox.comE<gt>,
Dan Sugalski E<lt>sugalskd@ous.eduE<gt>,
Nathan Torkington E<lt>gnat@frii.comE<gt>.
! This document is maintained by Chris Nandor
! E<lt>pudge@pobox.comE<gt>.
=head1 VERSION
! Version 1.39, last modified 11 February 1999
diff -c 'perl5.005_02/pod/perlre.pod' 'perl5.005_03/pod/perlre.pod'
Index: ./pod/perlre.pod
*** ./pod/perlre.pod Fri Aug 7 17:08:40 1998
--- ./pod/perlre.pod Thu Mar 4 18:34:48 1999
***************
*** 116,122 ****
(If a curly bracket occurs in any other context, it is treated
as a regular character.) The "*" modifier is equivalent to C<{0,}>, the "+"
modifier to C<{1,}>, and the "?" modifier to C<{0,1}>. n and m are limited
! to integral values less than 65536.
By default, a quantified subpattern is "greedy", that is, it will match as
many times as possible (given a particular starting location) while still
--- 116,126 ----
(If a curly bracket occurs in any other context, it is treated
as a regular character.) The "*" modifier is equivalent to C<{0,}>, the "+"
modifier to C<{1,}>, and the "?" modifier to C<{0,1}>. n and m are limited
! to integral values less than a preset limit defined when perl is built.
! This is usually 32766 on the most common platforms. The actual limit can
! be seen in the error message generated by code such as this:
!
! $_ **= $_ , / {$_} / for 2 .. 42;
By default, a quantified subpattern is "greedy", that is, it will match as
many times as possible (given a particular starting location) while still
***************
*** 458,464 ****
however, that this pattern currently triggers a warning message under
B<-w> saying it C<"matches the null string many times">):
! On simple groups, such as the pattern C<(?> [^()]+ )>, a comparable
effect may be achieved by negative lookahead, as in C<[^()]+ (?! [^()] )>.
This was only 4 times slower on a string with 1000000 C<a>s.
--- 462,468 ----
however, that this pattern currently triggers a warning message under
B<-w> saying it C<"matches the null string many times">):
! On simple groups, such as the pattern C<(?E<gt> [^()]+ )>, a comparable
effect may be achieved by negative lookahead, as in C<[^()]+ (?! [^()] )>.
This was only 4 times slower on a string with 1000000 C<a>s.
***************
*** 730,735 ****
--- 734,746 ----
C<[az-]>, and C<[a\-z]>. All are different from C<[a-z]>, which
specifies a class containing twenty-six characters.)
+ Note also that the whole range idea is rather unportable between
+ character sets--and even within character sets they may cause results
+ you probably didn't expect. A sound principle is to use only ranges
+ that begin from and end at either alphabets of equal case ([a-e],
+ [A-E]), or digits ([0-9]). Anything else is unsafe. If in doubt,
+ spell out the character sets in full.
+
Characters may be specified using a metacharacter syntax much like that
used in C: "\n" matches a newline, "\t" a tab, "\r" a carriage return,
"\f" a form feed, etc. More generally, \I<nnn>, where I<nnn> is a string
***************
*** 752,758 ****
Alternatives are tried from left to right, so the first
alternative found for which the entire expression matches, is the one that
is chosen. This means that alternatives are not necessarily greedy. For
! example: when mathing C<foo|foot> against "barefoot", only the "foo"
part will match, as that is the first alternative tried, and it successfully
matches the target string. (This might not seem important, but it is
important when you are capturing matched text using parentheses.)
--- 763,769 ----
Alternatives are tried from left to right, so the first
alternative found for which the entire expression matches, is the one that
is chosen. This means that alternatives are not necessarily greedy. For
! example: when matching C<foo|foot> against "barefoot", only the "foo"
part will match, as that is the first alternative tried, and it successfully
matches the target string. (This might not seem important, but it is
important when you are capturing matched text using parentheses.)
***************
*** 805,811 ****
to wreak havoc.
A common abuse of this power stems from the ability to make infinite
! loops using regular expressions, with something as innocous as:
'foo' =~ m{ ( o? )* }x;
--- 816,822 ----
to wreak havoc.
A common abuse of this power stems from the ability to make infinite
! loops using regular expressions, with something as innocuous as:
'foo' =~ m{ ( o? )* }x;
diff -c 'perl5.005_02/pod/perlref.pod' 'perl5.005_03/pod/perlref.pod'
Index: ./pod/perlref.pod
*** ./pod/perlref.pod Thu Jul 23 23:01:46 1998
--- ./pod/perlref.pod Sat Mar 27 16:45:52 1999
***************
*** 2,7 ****
--- 2,13 ----
perlref - Perl references and nested data structures
+ =head1 NOTE
+
+ This is complete documentation about all aspects of references.
+ For a shorter, tutorial introduction to just the essential features,
+ see L<perlreftut>.
+
=head1 DESCRIPTION
Before release 5 of Perl it was difficult to represent complex data
***************
*** 89,95 ****
@list = \($a, @b, %c); # same thing!
As a special case, C<\(@foo)> returns a list of references to the contents
! of C<@foo>, not a reference to C<@foo> itself. Likewise for C<%foo>.
=item 3.
--- 95,103 ----
@list = \($a, @b, %c); # same thing!
As a special case, C<\(@foo)> returns a list of references to the contents
! of C<@foo>, not a reference to C<@foo> itself. Likewise for C<%foo>,
! except that the key references are to copies (since the keys are just
! strings rather than full-fledged scalars).
=item 3.
***************
*** 448,454 ****
a symbol table, and thus are invisible to this mechanism. For example:
local $value = 10;
! $ref = \$value;
{
my $value = 20;
print $$ref;
--- 456,462 ----
a symbol table, and thus are invisible to this mechanism. For example:
local $value = 10;
! $ref = "value";
{
my $value = 20;
print $$ref;
***************
*** 551,557 ****
such as in a signal handler or a Tk callback.
Using a closure as a function template allows us to generate many functions
! that act similarly. Suppopose you wanted functions named after the colors
that generated HTML font changes for the various colors:
print "Be ", red("careful"), "with that ", green("light");
--- 559,565 ----
such as in a signal handler or a Tk callback.
Using a closure as a function template allows us to generate many functions
! that act similarly. Suppose you wanted functions named after the colors
that generated HTML font changes for the various colors:
print "Be ", red("careful"), "with that ", green("light");
diff -c /dev/null 'perl5.005_03/pod/perlreftut.pod'
Index: pod/perlreftut.pod
*** pod/perlreftut.pod Wed Dec 31 18:00:00 1969
--- pod/perlreftut.pod Sat Mar 27 16:30:29 1999
***************
*** 0 ****
--- 1,416 ----
+
+ =head1 NAME
+
+ perlreftut - Mark's very short tutorial about references
+
+ =head1 DESCRIPTION
+
+ One of the most important new features in Perl 5 was the capability to
+ manage complicated data structures like multidimensional arrays and
+ nested hashes. To enable these, Perl 5 introduced a feature called
+ `references', and using references is the key to managing complicated,
+ structured data in Perl. Unfortunately, there's a lot of funny syntax
+ to learn, and the main manual page can be hard to follow. The manual
+ is quite complete, and sometimes people find that a problem, because
+ it can be hard to tell what is important and what isn't.
+
+ Fortunately, you only need to know 10% of what's in the main page to get
+ 90% of the benefit. This page will show you that 10%.
+
+ =head1 Who Needs Complicated Data Structures?
+
+ One problem that came up all the time in Perl 4 was how to represent a
+ hash whose values were lists. Perl 4 had hashes, of course, but the
+ values had to be scalars; they couldn't be lists.
+
+ Why would you want a hash of lists? Let's take a simple example: You
+ have a file of city and country names, like this:
+
+ Chicago, USA
+ Frankfurt, Germany
+ Berlin, Germany
+ Washington, USA
+ Helsinki, Finland
+ New York, USA
+
+ and you want to produce an output like this, with each country mentioned
+ once, and then an alphabetical list of the cities in that country:
+
+ Finland: Helsinki.
+ Germany: Berlin, Frankfurt.
+ USA: Chicago, New York, Washington.
+
+ The natural way to do this is to have a hash whose keys are country
+ names. Associated with each country name key is a list of the cities in
+ that country. Each time you read a line of input, split it into a country
+ and a city, look up the list of cities already known to be in that
+ country, and append the new city to the list. When you're done reading
+ the input, iterate over the hash as usual, sorting each list of cities
+ before you print it out.
+
+ If hash values can't be lists, you lose. In Perl 4, hash values can't
+ be lists; they can only be strings. You lose. You'd probably have to
+ combine all the cities into a single string somehow, and then when
+ time came to write the output, you'd have to break the string into a
+ list, sort the list, and turn it back into a string. This is messy
+ and error-prone. And it's frustrating, because Perl already has
+ perfectly good lists that would solve the problem if only you could
+ use them.
+
+ =head1 The Solution
+
+ By the time Perl 5 rolled around, we were already stuck with this
+ design: Hash values must be scalars. The solution to this is
+ references.
+
+ A reference is a scalar value that I<refers to> an entire array or an
+ entire hash (or to just about anything else). Names are one kind of
+ reference that you're already familiar with. Think of the President:
+ a messy, inconvenient bag of blood and bones. But to talk about him,
+ or to represent him in a computer program, all you need is the easy,
+ convenient scalar string "Bill Clinton".
+
+ References in Perl are like names for arrays and hashes. They're
+ Perl's private, internal names, so you can be sure they're
+ unambiguous. Unlike "Bill Clinton", a reference only refers to one
+ thing, and you always know what it refers to. If you have a reference
+ to an array, you can recover the entire array from it. If you have a
+ reference to a hash, you can recover the entire hash. But the
+ reference is still an easy, compact scalar value.
+
+ You can't have a hash whose values are arrays; hash values can only be
+ scalars. We're stuck with that. But a single reference can refer to
+ an entire array, and references are scalars, so you can have a hash of
+ references to arrays, and it'll act a lot like a hash of arrays, and
+ it'll be just as useful as a hash of arrays.
+
+ We'll come back to this city-country problem later, after we've seen
+ some syntax for managing references.
+
+
+ =head1 Syntax
+
+ There are just two ways to make a reference, and just two ways to use
+ it once you have it.
+
+ =head2 Making References
+
+ B<Make Rule 1>
+
+ If you put a C<\> in front of a variable, you get a
+ reference to that variable.
+
+ $aref = \@array; # $aref now holds a reference to @array
+ $href = \%hash; # $href now holds a reference to %hash
+
+ Once the reference is stored in a variable like $aref or $href, you
+ can copy it or store it just the same as any other scalar value:
+
+ $xy = $aref; # $xy now holds a reference to @array
+ $p[3] = $href; # $p[3] now holds a reference to %hash
+ $z = $p[3]; # $z now holds a reference to %hash
+
+
+ These examples show how to make references to variables with names.
+ Sometimes you want to make an array or a hash that doesn't have a
+ name. This is analogous to the way you like to be able to use the
+ string C<"\n"> or the number 80 without having to store it in a named
+ variable first.
+
+ B<Make Rule 2>
+
+ C<[ ITEMS ]> makes a new, anonymous array, and returns a reference to
+ that array. C<{ ITEMS }> makes a new, anonymous hash. and returns a
+ reference to that hash.
+
+ $aref = [ 1, "foo", undef, 13 ];
+ # $aref now holds a reference to an array
+
+ $href = { APR => 4, AUG => 8 };
+ # $href now holds a reference to a hash
+
+
+ The references you get from rule 2 are the same kind of
+ references that you get from rule 1:
+
+ # This:
+ $aref = [ 1, 2, 3 ];
+
+ # Does the same as this:
+ @array = (1, 2, 3);
+ $aref = \@array;
+
+
+ The first line is an abbreviation for the following two lines, except
+ that it doesn't create the superfluous array variable C<@array>.
+
+
+ =head2 Using References
+
+ What can you do with a reference once you have it? It's a scalar
+ value, and we've seen that you can store it as a scalar and get it back
+ again just like any scalar. There are just two more ways to use it:
+
+ B<Use Rule 1>
+
+ If C<$aref> contains a reference to an array, then you
+ can put C<{$aref}> anywhere you would normally put the name of an
+ array. For example, C<@{$aref}> instead of C<@array>.
+
+ Here are some examples of that:
+
+ Arrays:
+
+
+ @a @{$aref} An array
+ reverse @a reverse @{$aref} Reverse the array
+ $a[3] ${$aref}[3] An element of the array
+ $a[3] = 17; ${$aref}[3] = 17 Assigning an element
+
+
+ On each line are two expressions that do the same thing. The
+ left-hand versions operate on the array C<@a>, and the right-hand
+ versions operate on the array that is referred to by C<$aref>, but
+ once they find the array they're operating on, they do the same things
+ to the arrays.
+
+ Using a hash reference is I<exactly> the same:
+
+ %h %{$href} A hash
+ keys %h keys %{$href} Get the keys from the hash
+ $h{'red'} ${$href}{'red'} An element of the hash
+ $h{'red'} = 17 ${$href}{'red'} = 17 Assigning an element
+
+
+ B<Use Rule 2>
+
+ C<${$aref}[3]> is too hard to read, so you can write C<$aref-E<gt>[3]>
+ instead.
+
+ C<${$href}{red}> is too hard to read, so you can write
+ C<$href-E<gt>{red}> instead.
+
+ Most often, when you have an array or a hash, you want to get or set a
+ single element from it. C<${$aref}[3]> and C<${$href}{'red'}> have
+ too much punctuation, and Perl lets you abbreviate.
+
+ If C<$aref> holds a reference to an array, then C<$aref-E<gt>[3]> is
+ the fourth element of the array. Don't confuse this with C<$aref[3]>,
+ which is the fourth element of a totally different array, one
+ deceptively named C<@aref>. C<$aref> and C<@aref> are unrelated the
+ same way that C<$item> and C<@item> are.
+
+ Similarly, C<$href-E<gt>{'red'}> is part of the hash referred to by
+ the scalar variable C<$href>, perhaps even one with no name.
+ C<$href{'red'}> is part of the deceptively named C<%href> hash. It's
+ easy to forget to leave out the C<-E<gt>>, and if you do, you'll get
+ bizarre results when your program gets array and hash elements out of
+ totally unexpected hashes and arrays that weren't the ones you wanted
+ to use.
+
+
+ =head1 An Example
+
+ Let's see a quick example of how all this is useful.
+
+ First, remember that C<[1, 2, 3]> makes an anonymous array containing
+ C<(1, 2, 3)>, and gives you a reference to that array.
+
+ Now think about
+
+ @a = ( [1, 2, 3],
+ [4, 5, 6],
+ [7, 8, 9]
+ );
+
+ @a is an array with three elements, and each one is a reference to
+ another array.
+
+ C<$a[1]> is one of these references. It refers to an array, the array
+ containing C<(4, 5, 6)>, and because it is a reference to an array,
+ B<USE RULE 2> says that we can write C<$a[1]-E<gt>[2]> to get the
+ third element from that array. C<$a[1]-E<gt>[2]> is the 6.
+ Similarly, C<$a[0]-E<gt>[1]> is the 2. What we have here is like a
+ two-dimensional array; you can write C<$a[ROW]-E<gt>[COLUMN]> to get
+ or set the element in any row and any column of the array.
+
+ The notation still looks a little cumbersome, so there's one more
+ abbreviation:
+
+ =head1 Arrow Rule
+
+ In between two B<subscripts>, the arrow is optional.
+
+ Instead of C<$a[1]-E<gt>[2]>, we can write C<$a[1][2]>; it means the
+ same thing. Instead of C<$a[0]-E<gt>[1]>, we can write C<$a[0][1]>;
+ it means the same thing.
+
+ Now it really looks like two-dimensional arrays!
+
+ You can see why the arrows are important. Without them, we would have
+ had to write C<${$a[1]}[2]> instead of C<$a[1][2]>. For
+ three-dimensional arrays, they let us write C<$x[2][3][5]> instead of
+ the unreadable C<${${$x[2]}[3]}[5]>.
+
+
+ =head1 Solution
+
+ Here's the answer to the problem I posed earlier, of reformatting a
+ file of city and country names.
+
+ 1 while (<>) {
+ 2 chomp;
+ 3 my ($city, $country) = split /, /;
+ 4 push @{$table{$country}}, $city;
+ 5 }
+ 6
+ 7 foreach $country (sort keys %table) {
+ 8 print "$country: ";
+ 9 my @cities = @{$table{$country}};
+ 10 print join ', ', sort @cities;
+ 11 print ".\n";
+ 12 }
+
+
+ The program has two pieces: Lines 1--5 read the input and build a
+ data structure, and lines 7--12 analyze the data and print out the
+ report.
+
+ In the first part, line 4 is the important one. We're going to have a
+ hash, C<%table>, whose keys are country names, and whose values are
+ (references to) arrays of city names. After acquiring a city and
+ country name, the program looks up C<$table{$country}>, which holds (a
+ reference to) the list of cities seen in that country so far. Line 4 is
+ totally analogous to
+
+ push @array, $city;
+
+ except that the name C<array> has been replaced by the reference
+ C<{$table{$country}}>. The C<push> adds a city name to the end of the
+ referred-to array.
+
+ In the second part, line 9 is the important one. Again,
+ C<$table{$country}> is (a reference to) the list of cities in the country, so
+ we can recover the original list, and copy it into the array C<@cities>,
+ by using C<@{$table{$country}}>. Line 9 is totally analogous to
+
+ @cities = @array;
+
+ except that the name C<array> has been replaced by the reference
+ C<{$table{$country}}>. The C<@> tells Perl to get the entire array.
+
+ The rest of the program is just familiar uses of C<chomp>, C<split>, C<sort>,
+ C<print>, and doesn't involve references at all.
+
+ There's one fine point I skipped. Suppose the program has just read
+ the first line in its input that happens to mention Greece.
+ Control is at line 4, C<$country> is C<'Greece'>, and C<$city> is
+ C<'Athens'>. Since this is the first city in Greece,
+ C<$table{$country}> is undefined---in fact there isn't an C<'Greece'> key
+ in C<%table> at all. What does line 4 do here?
+
+ 4 push @{$table{$country}}, $city;
+
+
+ This is Perl, so it does the exact right thing. It sees that you want
+ to push C<Athens> onto an array that doesn't exist, so it helpfully
+ makes a new, empty, anonymous array for you, installs it in the table,
+ and then pushes C<Athens> onto it. This is called `autovivification'.
+
+
+ =head1 The Rest
+
+ I promised to give you 90% of the benefit with 10% of the details, and
+ that means I left out 90% of the details. Now that you have an
+ overview of the important parts, it should be easier to read the
+ L<perlref> manual page, which discusses 100% of the details.
+
+ Some of the highlights of L<perlref>:
+
+ =over 4
+
+ =item *
+
+ You can make references to anything, including scalars, functions, and
+ other references.
+
+ =item *
+
+ In B<USE RULE 1>, you can omit the curly brackets whenever the thing
+ inside them is an atomic scalar variable like C<$aref>. For example,
+ C<@$aref> is the same as C<@{$aref}>, and C<$$aref[1]> is the same as
+ C<${$aref}[1]>. If you're just starting out, you may want to adopt
+ the habit of always including the curly brackets.
+
+ =item *
+
+ To see if a variable contains a reference, use the `ref' function.
+ It returns true if its argument is a reference. Actually it's a
+ little better than that: It returns HASH for hash references and
+ ARRAY for array references.
+
+ =item *
+
+ If you try to use a reference like a string, you get strings like
+
+ ARRAY(0x80f5dec) or HASH(0x826afc0)
+
+ If you ever see a string that looks like this, you'll know you
+ printed out a reference by mistake.
+
+ A side effect of this representation is that you can use C<eq> to see
+ if two references refer to the same thing. (But you should usually use
+ C<==> instead because it's much faster.)
+
+ =item *
+
+ You can use a string as if it were a reference. If you use the string
+ C<"foo"> as an array reference, it's taken to be a reference to the
+ array C<@foo>. This is called a I<soft reference> or I<symbolic reference>.
+
+ =back
+
+ You might prefer to go on to L<perllol> instead of L<perlref>; it
+ discusses lists of lists and multidimensional arrays in detail. After
+ that, you should move on to L<perldsc>; it's a Data Structure Cookbook
+ that shows recipes for using and printing out arrays of hashes, hashes
+ of arrays, and other kinds of data.
+
+ =head1 Summary
+
+ Everyone needs compound data structures, and in Perl the way you get
+ them is with references. There are four important rules for managing
+ references: Two for making references and two for using them. Once
+ you know these rules you can do most of the important things you need
+ to do with references.
+
+ =head1 Credits
+
+ Author: Mark-Jason Dominus, Plover Systems (C<mjd-perl-ref@plover.com>)
+
+ This article originally appeared in I<The Perl Journal>
+ (http://tpj.com) volume 3, #2. Reprinted with permission.
+
+ The original title was I<Understand References Today>.
+
+ =head2 Distribution Conditions
+
+ Copyright 1998 The Perl Journal.
+
+ When included as part of the Standard Version of Perl, or as part of
+ its complete documentation whether printed or otherwise, this work may
+ be distributed only under the terms of Perl's Artistic License. Any
+ distribution of this file or derivatives thereof outside of that
+ package require that special arrangements be made with copyright
+ holder.
+
+ Irrespective of its distribution, all code examples in these files are
+ hereby placed into the public domain. You are permitted and
+ encouraged to use this code in your own programs for fun or for profit
+ as you see fit. A simple comment in the code giving credit would be
+ courteous but is not required.
+
+
+
+
+ =cut
diff -c 'perl5.005_02/pod/perlrun.pod' 'perl5.005_03/pod/perlrun.pod'
Index: ./pod/perlrun.pod
*** ./pod/perlrun.pod Sun Aug 2 01:22:45 1998
--- ./pod/perlrun.pod Sat Mar 27 16:26:33 1999
***************
*** 129,134 ****
--- 129,149 ----
Macintosh perl scripts will have the appropriate Creator and
Type, so that double-clicking them will invoke the perl application.
+ =item VMS
+
+ Put
+
+ $ perl -mysw 'f$env("procedure")' 'p1' 'p2' 'p3' 'p4' 'p5' 'p6' 'p7' 'p8' !
+ $ exit++ + ++$status != 0 and $exit = $status = undef;
+
+ at the top of your script, where C<-mysw> are any command line switches you
+ want to pass to Perl. You can now invoke the script directly, by saying
+ C<perl script>, or as a DCL procedure, by saying C<@script> (or implicitly
+ via F<DCL$PATH> by just using the name of the script).
+
+ This incantation is a bit much to remember, but Perl will display it for
+ you if you say C<perl "-V:startperl">.
+
=back
Command-interpreters on non-Unix systems have rather different ideas
***************
*** 492,498 ****
If a file named by an argument cannot be opened for some reason, Perl
warns you about it, and moves on to the next file. Note that the
! lines are printed automatically. An error occuring during printing is
treated as fatal. To suppress printing use the B<-n> switch. A B<-p>
overrides a B<-n> switch.
--- 507,513 ----
If a file named by an argument cannot be opened for some reason, Perl
warns you about it, and moves on to the next file. Note that the
! lines are printed automatically. An error occurring during printing is
treated as fatal. To suppress printing use the B<-n> switch. A B<-p>
overrides a B<-n> switch.
***************
*** 671,677 ****
as if they were on every Perl command line. Only the B<-[DIMUdmw]>
switches are allowed. When running taint checks (because the script
was running setuid or setgid, or the B<-T> switch was used), this
! variable is ignored.
=item PERLLIB
--- 686,693 ----
as if they were on every Perl command line. Only the B<-[DIMUdmw]>
switches are allowed. When running taint checks (because the script
was running setuid or setgid, or the B<-T> switch was used), this
! variable is ignored. If PERL5OPT begins with B<-T>, tainting will be
! enabled, and any subsequent options ignored.
=item PERLLIB
diff -c 'perl5.005_02/pod/perlstyle.pod' 'perl5.005_03/pod/perlstyle.pod'
Index: ./pod/perlstyle.pod
*** ./pod/perlstyle.pod Thu Jul 23 23:01:47 1998
--- ./pod/perlstyle.pod Sat Mar 27 16:26:43 1999
***************
*** 16,22 ****
useful.
Regarding aesthetics of code lay out, about the only thing Larry
! cares strongly about is that the closing curly brace of
a multi-line BLOCK should line up with the keyword that started the construct.
Beyond that, he has other preferences that aren't so strong:
--- 16,22 ----
useful.
Regarding aesthetics of code lay out, about the only thing Larry
! cares strongly about is that the closing curly bracket of
a multi-line BLOCK should line up with the keyword that started the construct.
Beyond that, he has other preferences that aren't so strong:
diff -c 'perl5.005_02/pod/perlsub.pod' 'perl5.005_03/pod/perlsub.pod'
Index: ./pod/perlsub.pod
*** ./pod/perlsub.pod Thu Jul 23 23:01:48 1998
--- ./pod/perlsub.pod Sat Mar 27 16:26:58 1999
***************
*** 199,205 ****
functions mentioned in L<perltie>. The 5.005 release adds C<INIT>
to this list.
! =head2 Private Variables via C<my()>
Synopsis:
--- 199,205 ----
functions mentioned in L<perltie>. The 5.005 release adds C<INIT>
to this list.
! =head2 Private Variables via my()
Synopsis:
***************
*** 381,387 ****
This does not work with object methods, however; all object methods have
to be in the symbol table of some package to be found.
! =head2 Peristent Private Variables
Just because a lexical variable is lexically (also called statically)
scoped to its enclosing block, C<eval>, or C<do> FILE, this doesn't mean that
--- 381,387 ----
This does not work with object methods, however; all object methods have
to be in the symbol table of some package to be found.
! =head2 Persistent Private Variables
Just because a lexical variable is lexically (also called statically)
scoped to its enclosing block, C<eval>, or C<do> FILE, this doesn't mean that
***************
*** 581,586 ****
--- 581,608 ----
This is a test only a test.
The array has 6 elements: 0, 1, 2, undef, undef, 5
+ Note also that when you C<local>ize a member of a composite type that
+ B<does not exist previously>, the value is treated as though it were
+ in an lvalue context, i.e., it is first created and then C<local>ized.
+ The consequence of this is that the hash or array is in fact permanently
+ modified. For instance, if you say
+
+ %hash = ( 'This' => 'is', 'a' => 'test' );
+ @ary = ( 0..5 );
+ {
+ local($ary[8]) = 0;
+ local($hash{'b'}) = 'whatever';
+ }
+ printf "%%hash has now %d keys, \@ary %d elements.\n",
+ scalar(keys(%hash)), scalar(@ary);
+
+ Perl will print
+
+ %hash has now 3 keys, @ary 9 elements.
+
+ The above behavior of local() on non-existent members of composite
+ types is subject to change in future.
+
=head2 Passing Symbol Table Entries (typeglobs)
[Note: The mechanism described in this section was originally the only
***************
*** 825,831 ****
function. If you call it like an old-fashioned subroutine, then it
behaves like an old-fashioned subroutine. It naturally falls out from
this rule that prototypes have no influence on subroutine references
! like C<\&foo> or on indirect subroutine calls like C<&{$subref}>.
Method calls are not influenced by prototypes either, because the
function to be called is indeterminate at compile time, because it depends
--- 847,854 ----
function. If you call it like an old-fashioned subroutine, then it
behaves like an old-fashioned subroutine. It naturally falls out from
this rule that prototypes have no influence on subroutine references
! like C<\&foo> or on indirect subroutine calls like C<&{$subref}> or
! C<$subref-E<gt>()>.
Method calls are not influenced by prototypes either, because the
function to be called is indeterminate at compile time, because it depends
***************
*** 863,870 ****
list context. An argument represented by C<$> forces scalar context. An
C<&> requires an anonymous subroutine, which, if passed as the first
argument, does not require the "C<sub>" keyword or a subsequent comma. A
! C<*> does whatever it has to do to turn the argument into a reference to a
! symbol table entry.
A semicolon separates mandatory arguments from optional arguments.
(It is redundant before C<@> or C<%>.)
--- 886,895 ----
list context. An argument represented by C<$> forces scalar context. An
C<&> requires an anonymous subroutine, which, if passed as the first
argument, does not require the "C<sub>" keyword or a subsequent comma. A
! C<*> allows the subroutine to accept a bareword, constant, scalar expression,
! typeglob, or a reference to a typeglob in that slot. The value will be
! available to the subroutine either as a simple scalar, or (in the latter
! two cases) as a reference to the typeglob.
A semicolon separates mandatory arguments from optional arguments.
(It is redundant before C<@> or C<%>.)
diff -c 'perl5.005_02/pod/perlsyn.pod' 'perl5.005_03/pod/perlsyn.pod'
Index: ./pod/perlsyn.pod
*** ./pod/perlsyn.pod Thu Jul 23 23:01:49 1998
--- ./pod/perlsyn.pod Sat Mar 27 16:27:12 1999
***************
*** 21,33 ****
=head2 Declarations
! Perl is, for the most part, a free-form language. (The only
! exception to this is format declarations, for obvious reasons.) Comments
! are indicated by the C<"#"> character, and extend to the end of the line. If
! you attempt to use C</* */> C-style comments, it will be interpreted
! either as division or pattern matching, depending on the context, and C++
! C<//> comments just look like a null regular expression, so don't do
! that.
A declaration can be put anywhere a statement can, but has no effect on
the execution of the primary sequence of statements--declarations all
--- 21,33 ----
=head2 Declarations
! Perl is, for the most part, a free-form language. (The only exception
! to this is format declarations, for obvious reasons.) Text from a
! C<"#"> character until the end of the line is a comment, and is
! ignored. If you attempt to use C</* */> C-style comments, it will be
! interpreted either as division or pattern matching, depending on the
! context, and C++ C<//> comments just look like a null regular
! expression, so don't do that.
A declaration can be put anywhere a statement can, but has no effect on
the execution of the primary sequence of statements--declarations all
diff -c /dev/null 'perl5.005_03/pod/perlthrtut.pod'
Index: pod/perlthrtut.pod
*** pod/perlthrtut.pod Wed Dec 31 18:00:00 1969
--- pod/perlthrtut.pod Sat Mar 27 19:48:31 1999
***************
*** 0 ****
--- 1,1063 ----
+ =head1 NAME
+
+ perlthrtut - tutorial on threads in Perl
+
+ =head1 DESCRIPTION
+
+ One of the most prominent new features of Perl 5.005 is the inclusion
+ of threads. Threads make a number of things a lot easier, and are a
+ very useful addition to your bag of programming tricks.
+
+ =head1 What Is A Thread Anyway?
+
+ A thread is a flow of control through a program with a single
+ execution point.
+
+ Sounds an awful lot like a process, doesn't it? Well, it should.
+ Threads are one of the pieces of a process. Every process has at least
+ one thread and, up until now, every process running Perl had only one
+ thread. With 5.005, though, you can create extra threads. We're going
+ to show you how, when, and why.
+
+ =head1 Threaded Program Models
+
+ There are three basic ways that you can structure a threaded
+ program. Which model you choose depends on what you need your program
+ to do. For many non-trivial threaded programs you'll need to choose
+ different models for different pieces of your program.
+
+ =head2 Boss/Worker
+
+ The boss/worker model usually has one `boss' thread and one or more
+ `worker' threads. The boss thread gathers or generates tasks that need
+ to be done, then parcels those tasks out to the appropriate worker
+ thread.
+
+ This model is common in GUI and server programs, where a main thread
+ waits for some event and then passes that event to the appropriate
+ worker threads for processing. Once the event has been passed on, the
+ boss thread goes back to waiting for another event.
+
+ The boss thread does relatively little work. While tasks aren't
+ necessarily performed faster than with any other method, it tends to
+ have the best user-response times.
+
+ =head2 Work Crew
+
+ In the work crew model, several threads are created that do
+ essentially the same thing to different pieces of data. It closely
+ mirrors classical parallel processing and vector processors, where a
+ large array of processors do the exact same thing to many pieces of
+ data.
+
+ This model is particularly useful if the system running the program
+ will distribute multiple threads across different processors. It can
+ also be useful in ray tracing or rendering engines, where the
+ individual threads can pass on interim results to give the user visual
+ feedback.
+
+ =head2 Pipeline
+
+ The pipeline model divides up a task into a series of steps, and
+ passes the results of one step on to the thread processing the
+ next. Each thread does one thing to each piece of data and passes the
+ results to the next thread in line.
+
+ This model makes the most sense if you have multiple processors so two
+ or more threads will be executing in parallel, though it can often
+ make sense in other contexts as well. It tends to keep the individual
+ tasks small and simple, as well as allowing some parts of the pipeline
+ to block (on I/O or system calls, for example) while other parts keep
+ going. If you're running different parts of the pipeline on different
+ processors you may also take advantage of the caches on each
+ processor.
+
+ This model is also handy for a form of recursive programming where,
+ rather than having a subroutine call itself, it instead creates
+ another thread. Prime and Fibonacci generators both map well to this
+ form of the pipeline model. (A version of a prime number generator is
+ presented later on.)
+
+ =head1 Native threads
+
+ There are several different ways to implement threads on a system. How
+ threads are implemented depends both on the vendor and, in some cases,
+ the version of the operating system. Often the first implementation
+ will be relatively simple, but later versions of the OS will be more
+ sophisticated.
+
+ While the information in this section is useful, it's not necessary,
+ so you can skip it if you don't feel up to it.
+
+ There are three basic categories of threads-user-mode threads, kernel
+ threads, and multiprocessor kernel threads.
+
+ User-mode threads are threads that live entirely within a program and
+ its libraries. In this model, the OS knows nothing about threads. As
+ far as it's concerned, your process is just a process.
+
+ This is the easiest way to implement threads, and the way most OSes
+ start. The big disadvantage is that, since the OS knows nothing about
+ threads, if one thread blocks they all do. Typical blocking activities
+ include most system calls, most I/O, and things like sleep().
+
+ Kernel threads are the next step in thread evolution. The OS knows
+ about kernel threads, and makes allowances for them. The main
+ difference between a kernel thread and a user-mode thread is
+ blocking. With kernel threads, things that block a single thread don't
+ block other threads. This is not the case with user-mode threads,
+ where the kernel blocks at the process level and not the thread level.
+
+ This is a big step forward, and can give a threaded program quite a
+ performance boost over non-threaded programs. Threads that block
+ performing I/O, for example, won't block threads that are doing other
+ things. Each process still has only one thread running at once,
+ though, regardless of how many CPUs a system might have.
+
+ Since kernel threading can interrupt a thread at any time, they will
+ uncover some of the implicit locking assumptions you may make in your
+ program. For example, something as simple as C<$a = $a + 2> can behave
+ unpredictably with kernel threads if C<$a> is visible to other
+ threads, as another thread may have changed C<$a> between the time it
+ was fetched on the right hand side and the time the new value is
+ stored.
+
+ Multiprocessor Kernel Threads are the final step in thread
+ support. With multiprocessor kernel threads on a machine with multiple
+ CPUs, the OS may schedule two or more threads to run simultaneously on
+ different CPUs.
+
+ This can give a serious performance boost to your threaded program,
+ since more than one thread will be executing at the same time. As a
+ tradeoff, though, any of those nagging synchronization issues that
+ might not have shown with basic kernel threads will appear with a
+ vengeance.
+
+ In addition to the different levels of OS involvement in threads,
+ different OSes (and different thread implementations for a particular
+ OS) allocate CPU cycles to threads in different ways.
+
+ Cooperative multitasking systems have running threads give up control
+ if one of two things happen. If a thread calls a yield function, it
+ gives up control. It also gives up control if the thread does
+ something that would cause it to block, such as perform I/O. In a
+ cooperative multitasking implementation, one thread can starve all the
+ others for CPU time if it so chooses.
+
+ Preemptive multitasking systems interrupt threads at regular intervals
+ while the system decides which thread should run next. In a preemptive
+ multitasking system, one thread usually won't monopolize the CPU.
+
+ On some systems, there can be cooperative and preemptive threads
+ running simultaneously. (Threads running with realtime priorities
+ often behave cooperatively, for example, while threads running at
+ normal priorities behave preemptively.)
+
+ =head1 What kind of threads are perl threads?
+
+ If you have experience with other thread implementations, you might
+ find that things aren't quite what you expect. It's very important to
+ remember when dealing with Perl threads that Perl Threads Are Not X
+ Threads, for all values of X. They aren't POSIX threads, or
+ DecThreads, or Java's Green threads, or Win32 threads. There are
+ similarities, and the broad concepts are the same, but if you start
+ looking for implementation details you're going to be either
+ disappointed or confused. Possibly both.
+
+ This is not to say that Perl threads are completely different from
+ everything that's ever come before--they're not. Perl's threading
+ model owes a lot to other thread models, especially POSIX. Just as
+ Perl is not C, though, Perl threads are not POSIX threads. So if you
+ find yourself looking for mutexes, or thread priorities, it's time to
+ step back a bit and think about what you want to do and how Perl can
+ do it.
+
+ =head1 Threadsafe Modules
+
+ The addition of threads has changed Perl's internals
+ substantially. There are implications for people who write
+ modules--especially modules with XS code or external libraries. While
+ most modules won't encounter any problems, modules that aren't
+ explicitly tagged as thread-safe should be tested before being used in
+ production code.
+
+ Not all modules that you might use are thread-safe, and you should
+ always assume a module is unsafe unless the documentation says
+ otherwise. This includes modules that are distributed as part of the
+ core. Threads are a beta feature, and even some of the standard
+ modules aren't thread-safe.
+
+ If you're using a module that's not thread-safe for some reason, you
+ can protect yourself by using semaphores and lots of programming
+ discipline to control access to the module. Semaphores are covered
+ later in the article. Perl Threads Are Different
+
+ =head1 Thread Basics
+
+ The core Thread module provides the basic functions you need to write
+ threaded programs. In the following sections we'll cover the basics,
+ showing you what you need to do to create a threaded program. After
+ that, we'll go over some of the features of the Thread module that
+ make threaded programming easier.
+
+ =head2 Basic Thread Support
+
+ Thread support is a Perl compile-time option-it's something that's
+ turned on or off when Perl is built at your site, rather than when
+ your programs are compiled. If your Perl wasn't compiled with thread
+ support enabled, then any attempt to use threads will fail.
+
+ Remember that the threading support in 5.005 is in beta release, and
+ should be treated as such. You should expect that it may not function
+ entirely properly, and the thread interface may well change some
+ before it is a fully supported, production release. The beta version
+ shouldn't be used for mission-critical projects. Having said that,
+ threaded Perl is pretty nifty, and worth a look.
+
+ Your programs can use the Config module to check whether threads are
+ enabled. If your program can't run without them, you can say something
+ like:
+
+ $Config{usethreads} or die "Recompile Perl with threads to run this program.";
+
+ A possibly-threaded program using a possibly-threaded module might
+ have code like this:
+
+ use Config;
+ use MyMod;
+
+ if ($Config{usethreads}) {
+ # We have threads
+ require MyMod_threaded;
+ import MyMod_threaded;
+ } else {
+ require MyMod_unthreaded;
+ import MyMod_unthreaded;
+ }
+
+ Since code that runs both with and without threads is usually pretty
+ messy, it's best to isolate the thread-specific code in its own
+ module. In our example above, that's what MyMod_threaded is, and it's
+ only imported if we're running on a threaded Perl.
+
+ =head2 Creating Threads
+
+ The Thread package provides the tools you need to create new
+ threads. Like any other module, you need to tell Perl you want to use
+ it; use Thread imports all the pieces you need to create basic
+ threads.
+
+ The simplest, straightforward way to create a thread is with new():
+
+ use Thread;
+
+ $thr = new Thread \&sub1;
+
+ sub sub1 {
+ print "In the thread\n";
+ }
+
+ The new() method takes a reference to a subroutine and creates a new
+ thread, which starts executing in the referenced subroutine. Control
+ then passes both to the subroutine and the caller.
+
+ If you need to, your program can pass parameters to the subroutine as
+ part of the thread startup. Just include the list of parameters as
+ part of the C<Thread::new> call, like this:
+
+ use Thread;
+ $Param3 = "foo";
+ $thr = new Thread \&sub1, "Param 1", "Param 2", $Param3;
+ $thr = new Thread \&sub1, @ParamList;
+ $thr = new Thread \&sub1, qw(Param1 Param2 $Param3);
+
+ sub sub1 {
+ my @InboundParameters = @_;
+ print "In the thread\n";
+ print "got parameters >", join("<>", @InboundParameters), "<\n";
+ }
+
+
+ The subroutine runs like a normal Perl subroutine, and the call to new
+ Thread returns whatever the subroutine returns.
+
+ The last example illustrates another feature of threads. You can spawn
+ off several threads using the same subroutine. Each thread executes
+ the same subroutine, but in a separate thread with a separate
+ environment and potentially separate arguments.
+
+ The other way to spawn a new thread is with async(), which is a way to
+ spin off a chunk of code like eval(), but into its own thread:
+
+ use Thread qw(async);
+
+ $LineCount = 0;
+
+ $thr = async {
+ while(<>) {$LineCount++}
+ print "Got $LineCount lines\n";
+ };
+
+ print "Waiting for the linecount to end\n";
+ $thr->join;
+ print "All done\n";
+
+ You'll notice we did a use Thread qw(async) in that example. async is
+ not exported by default, so if you want it, you'll either need to
+ import it before you use it or fully qualify it as
+ Thread::async. You'll also note that there's a semicolon after the
+ closing brace. That's because async() treats the following block as an
+ anonymous subroutine, so the semicolon is necessary.
+
+ Like eval(), the code executes in the same context as it would if it
+ weren't spun off. Since both the code inside and after the async start
+ executing, you need to be careful with any shared resources. Locking
+ and other synchronization techniques are covered later.
+
+ =head2 Giving up control
+
+ There are times when you may find it useful to have a thread
+ explicitly give up the CPU to another thread. Your threading package
+ might not support preemptive multitasking for threads, for example, or
+ you may be doing something compute-intensive and want to make sure
+ that the user-interface thread gets called frequently. Regardless,
+ there are times that you might want a thread to give up the processor.
+
+ Perl's threading package provides the yield() function that does
+ this. yield() is pretty straightforward, and works like this:
+
+ use Thread qw(yield async);
+ async {
+ my $foo = 50;
+ while ($foo--) { print "first async\n" }
+ yield;
+ $foo = 50;
+ while ($foo--) { print "first async\n" }
+ };
+ async {
+ my $foo = 50;
+ while ($foo--) { print "second async\n" }
+ yield;
+ $foo = 50;
+ while ($foo--) { print "second async\n" }
+ };
+
+ =head2 Waiting For A Thread To Exit
+
+ Since threads are also subroutines, they can return values. To wait
+ for a thread to exit and extract any scalars it might return, you can
+ use the join() method.
+
+ use Thread;
+ $thr = new Thread \&sub1;
+
+ @ReturnData = $thr->join;
+ print "Thread returned @ReturnData";
+
+ sub sub1 { return "Fifty-six", "foo", 2; }
+
+ In the example above, the join() method returns as soon as the thread
+ ends. In addition to waiting for a thread to finish and gathering up
+ any values that the thread might have returned, join() also performs
+ any OS cleanup necessary for the thread. That cleanup might be
+ important, especially for long-running programs that spawn lots of
+ threads. If you don't want the return values and don't want to wait
+ for the thread to finish, you should call the detach() method
+ instead. detach() is covered later in the article.
+
+ =head2 Errors In Threads
+
+ So what happens when an error occurs in a thread? Any errors that
+ could be caught with eval() are postponed until the thread is
+ joined. If your program never joins, the errors appear when your
+ program exits.
+
+ Errors deferred until a join() can be caught with eval():
+
+ use Thread qw(async);
+ $thr = async {$b = 3/0}; # Divide by zero error
+ $foo = eval {$thr->join};
+ if ($@) {
+ print "died with error $@\n";
+ } else {
+ print "Hey, why aren't you dead?\n";
+ }
+
+ eval() passes any results from the joined thread back unmodified, so
+ if you want the return value of the thread, this is your only chance
+ to get them.
+
+ =head2 Ignoring A Thread
+
+ join() does three things:it waits for a thread to exit, cleans up
+ after it, and returns any data the thread may have produced. But what
+ if you're not interested in the thread's return values, and you don't
+ really care when the thread finishes? All you want is for the thread
+ to get cleaned up after when it's done.
+
+ In this case, you use the detach() method. Once a thread is detached,
+ it'll run until it's finished, then Perl will clean up after it
+ automatically.
+
+ use Thread;
+ $thr = new Thread \&sub1; # Spawn the thread
+
+ $thr->detach; # Now we officially don't care any more
+
+ sub sub1 {
+ $a = 0;
+ while (1) {
+ $a++;
+ print "\$a is $a\n";
+ sleep 1;
+ }
+ }
+
+
+ Once a thread is detached, it may not be joined, and any output that
+ it might have produced (if it was done and waiting for a join) is
+ lost.
+
+ =head1 Threads And Data
+
+ Now that we've covered the basics of threads, it's time for our next
+ topic: data. Threading introduces a couple of complications to data
+ access that non-threaded programs never need to worry about.
+
+ =head2 Shared And Unshared Data
+
+ The single most important thing to remember when using threads is that
+ all threads potentially have access to all the data anywhere in your
+ program. While this is true with a nonthreaded Perl program as well,
+ it's especially important to remember with a threaded program, since
+ more than one thread can be accessing this data at once.
+
+ Perl's scoping rules don't change because you're using threads. If a
+ subroutine (or block, in the case of async()) could see a variable if
+ you weren't running with threads, it can see it if you are. This is
+ especially important for the subroutines that create, and makes my
+ variables even more important. Remember--if your variables aren't
+ lexically scoped (declared with C<my>) you're probably sharing it between
+ threads.
+
+ =head2 Thread Pitfall: Races
+
+ While threads bring a new set of useful tools, they also bring a
+ number of pitfalls. One pitfall is the race condition:
+
+ use Thread;
+ $a = 1;
+ $thr1 = Thread->new(\&sub1);
+ $thr2 = Thread->new(\&sub2);
+
+ sleep 10;
+ print "$a\n";
+
+ sub sub1 { $foo = $a; $a = $foo + 1; }
+ sub sub2 { $bar = $a; $a = $bar + 1; }
+
+ What do you think $a will be? The answer, unfortunately, is "it
+ depends." Both sub1() and sub2() access the global variable $a, once
+ to read and once to write. Depending on factors ranging from your
+ thread implementation's scheduling algorithm to the phase of the moon,
+ $a can be 2 or 3.
+
+ Race conditions are caused by unsynchronized access to shared
+ data. Without explicit synchronization, there's no way to be sure that
+ nothing has happened to the shared data between the time you access it
+ and the time you update it. Even this simple code fragment has the
+ possibility of error:
+
+ use Thread qw(async);
+ $a = 2;
+ async{ $b = $a; $a = $b + 1; };
+ async{ $c = $a; $a = $c + 1; };
+
+ Two threads both access $a. Each thread can potentially be interrupted
+ at any point, or be executed in any order. At the end, $a could be 3
+ or 4, and both $b and $c could be 2 or 3.
+
+ Whenever your program accesses data or resources that can be accessed
+ by other threads, you must take steps to coordinate access or risk
+ data corruption and race conditions.
+
+ =head2 Controlling access: lock()
+
+ The lock() function takes a variable (or subroutine, but we'll get to
+ that later) and puts a lock on it. No other thread may lock the
+ variable until the locking thread exits the innermost block containing
+ the lock. Using lock() is straightforward:
+
+ use Thread qw(async);
+ $a = 4;
+ $thr1 = async {
+ $foo = 12;
+ {
+ lock ($a); # Block until we get access to $a
+ $b = $a;
+ $a = $b * $foo;
+ }
+ print "\$foo was $foo\n";
+ };
+ $thr2 = async {
+ $bar = 7;
+ {
+ lock ($a); # Block until we can get access to $a
+ $c = $a;
+ $a = $c * $bar;
+ }
+ print "\$bar was $bar\n";
+ };
+ $thr1->join;
+ $thr2->join;
+ print "\$a is $a\n";
+
+ lock() blocks the thread until the variable being locked is
+ available. When lock() returns, your thread can be sure that no other
+ thread can lock that variable until the innermost block containing the
+ lock exits.
+
+ It's important to note that locks don't prevent access to the variable
+ in question, only lock attempts. This is in keeping with Perl's
+ longstanding tradition of courteous programming, and the advisory file
+ locking that flock() gives you. Locked subroutines behave differently,
+ however. We'll cover that later in the article.
+
+ You may lock arrays and hashes as well as scalars. Locking an array,
+ though, will not block subsequent locks on array elements, just lock
+ attempts on the array itself.
+
+ Finally, locks are recursive, which means it's okay for a thread to
+ lock a variable more than once. The lock will last until the outermost
+ lock() on the variable goes out of scope.
+
+ =head2 Thread Pitfall: Deadlocks
+
+ Locks are a handy tool to synchronize access to data. Using them
+ properly is the key to safe shared data. Unfortunately, locks aren't
+ without their dangers. Consider the following code:
+
+ use Thread qw(async yield);
+ $a = 4;
+ $b = "foo";
+ async {
+ lock($a);
+ yield;
+ sleep 20;
+ lock ($b);
+ };
+ async {
+ lock($b);
+ yield;
+ sleep 20;
+ lock ($a);
+ };
+
+ This program will probably hang until you kill it. The only way it
+ won't hang is if one of the two async() routines acquires both locks
+ first. A guaranteed-to-hang version is more complicated, but the
+ principle is the same.
+
+ The first thread spawned by async() will grab a lock on $a then, a
+ second or two later, try to grab a lock on $b. Meanwhile, the second
+ thread grabs a lock on $b, then later tries to grab a lock on $a. The
+ second lock attempt for both threads will block, each waiting for the
+ other to release its lock.
+
+ This condition is called a deadlock, and it occurs whenever two or
+ more threads are trying to get locks on resources that the others
+ own. Each thread will block, waiting for the other to release a lock
+ on a resource. That never happens, though, since the thread with the
+ resource is itself waiting for a lock to be released.
+
+ There are a number of ways to handle this sort of problem. The best
+ way is to always have all threads acquire locks in the exact same
+ order. If, for example, you lock variables $a, $b, and $c, always lock
+ $a before $b, and $b before $c. It's also best to hold on to locks for
+ as short a period of time to minimize the risks of deadlock.
+
+ =head2 Queues: Passing Data Around
+
+ A queue is a special thread-safe object that lets you put data in one
+ end and take it out the other without having to worry about
+ synchronization issues. They're pretty straightforward, and look like
+ this:
+
+ use Thread qw(async);
+ use Thread::Queue;
+
+ my $DataQueue = new Thread::Queue;
+ $thr = async {
+ while ($DataElement = $DataQueue->dequeue) {
+ print "Popped $DataElement off the queue\n";
+ }
+ };
+
+ $DataQueue->enqueue(12);
+ $DataQueue->enqueue("A", "B", "C");
+ $DataQueue->enqueue(\$thr);
+ sleep 10;
+ $DataQueue->enqueue(undef);
+
+ You create the queue with new Thread::Queue. Then you can add lists of
+ scalars onto the end with enqueue(), and pop scalars off the front of
+ it with dequeue(). A queue has no fixed size, and can grow as needed
+ to hold everything pushed on to it.
+
+ If a queue is empty, dequeue() blocks until another thread enqueues
+ something. This makes queues ideal for event loops and other
+ communications between threads.
+
+ =head1 Threads And Code
+
+ In addition to providing thread-safe access to data via locks and
+ queues, threaded Perl also provides general-purpose semaphores for
+ coarser synchronization than locks provide and thread-safe access to
+ entire subroutines.
+
+ =head2 Semaphores: Synchronizing Data Access
+
+ Semaphores are a kind of generic locking mechanism. Unlike lock, which
+ gets a lock on a particular scalar, Perl doesn't associate any
+ particular thing with a semaphore so you can use them to control
+ access to anything you like. In addition, semaphores can allow more
+ than one thread to access a resource at once, though by default
+ semaphores only allow one thread access at a time.
+
+ =over 4
+
+ =item Basic semaphores
+
+ Semaphores have two methods, down and up. down decrements the resource
+ count, while up increments it. down calls will block if the
+ semaphore's current count would decrement below zero. This program
+ gives a quick demonstration:
+
+ use Thread qw(yield);
+ use Thread::Semaphore;
+ my $semaphore = new Thread::Semaphore;
+ $GlobalVariable = 0;
+
+ $thr1 = new Thread \&sample_sub, 1;
+ $thr2 = new Thread \&sample_sub, 2;
+ $thr3 = new Thread \&sample_sub, 3;
+
+ sub sample_sub {
+ my $SubNumber = shift @_;
+ my $TryCount = 10;
+ my $LocalCopy;
+ sleep 1;
+ while ($TryCount--) {
+ $semaphore->down;
+ $LocalCopy = $GlobalVariable;
+ print "$TryCount tries left for sub $SubNumber (\$GlobalVariable is $GlobalVariable)\n";
+ yield;
+ sleep 2;
+ $LocalCopy++;
+ $GlobalVariable = $LocalCopy;
+ $semaphore->up;
+ }
+ }
+
+ The three invocations of the subroutine all operate in sync. The
+ semaphore, though, makes sure that only one thread is accessing the
+ global variable at once.
+
+ =item Advanced Semaphores
+
+ By default, semaphores behave like locks, letting only one thread
+ down() them at a time. However, there are other uses for semaphores.
+
+ Each semaphore has a counter attached to it. down() decrements the
+ counter and up() increments the counter. By default, semaphores are
+ created with the counter set to one, down() decrements by one, and
+ up() increments by one. If down() attempts to decrement the counter
+ below zero, it blocks until the counter is large enough. Note that
+ while a semaphore can be created with a starting count of zero, any
+ up() or down() always changes the counter by at least
+ one. $semaphore->down(0) is the same as $semaphore->down(1).
+
+ The question, of course, is why would you do something like this? Why
+ create a semaphore with a starting count that's not one, or why
+ decrement/increment it by more than one? The answer is resource
+ availability. Many resources that you want to manage access for can be
+ safely used by more than one thread at once.
+
+ For example, let's take a GUI driven program. It has a semaphore that
+ it uses to synchronize access to the display, so only one thread is
+ ever drawing at once. Handy, but of course you don't want any thread
+ to start drawing until things are properly set up. In this case, you
+ can create a semaphore with a counter set to zero, and up it when
+ things are ready for drawing.
+
+ Semaphores with counters greater than one are also useful for
+ establishing quotas. Say, for example, that you have a number of
+ threads that can do I/O at once. You don't want all the threads
+ reading or writing at once though, since that can potentially swamp
+ your I/O channels, or deplete your process' quota of filehandles. You
+ can use a semaphore initialized to the number of concurrent I/O
+ requests (or open files) that you want at any one time, and have your
+ threads quietly block and unblock themselves.
+
+ Larger increments or decrements are handy in those cases where a
+ thread needs to check out or return a number of resources at once.
+
+ =back
+
+ =head2 Attributes: Restricting Access To Subroutines
+
+ In addition to synchronizing access to data or resources, you might
+ find it useful to synchronize access to subroutines. You may be
+ accessing a singular machine resource (perhaps a vector processor), or
+ find it easier to serialize calls to a particular subroutine than to
+ have a set of locks and sempahores.
+
+ One of the additions to Perl 5.005 is subroutine attributes. The
+ Thread package uses these to provide several flavors of
+ serialization. It's important to remember that these attributes are
+ used in the compilation phase of your program so you can't change a
+ subroutine's behavior while your program is actually running.
+
+ =head2 Subroutine Locks
+
+ The basic subroutine lock looks like this:
+
+ sub test_sub {
+ use attrs qw(locked);
+ }
+
+ This ensures that only one thread will be executing this subroutine at
+ any one time. Once a thread calls this subroutine, any other thread
+ that calls it will block until the thread in the subroutine exits
+ it. A more elaborate example looks like this:
+
+ use Thread qw(yield);
+
+ new Thread \&thread_sub, 1;
+ new Thread \&thread_sub, 2;
+ new Thread \&thread_sub, 3;
+ new Thread \&thread_sub, 4;
+
+ sub sync_sub {
+ use attrs qw(locked);
+ my $CallingThread = shift @_;
+ print "In sync_sub for thread $CallingThread\n";
+ yield;
+ sleep 3;
+ print "Leaving sync_sub for thread $CallingThread\n";
+ }
+
+ sub thread_sub {
+ my $ThreadID = shift @_;
+ print "Thread $ThreadID calling sync_sub\n";
+ sync_sub($ThreadID);
+ print "$ThreadID is done with sync_sub\n";
+ }
+
+ The use attrs qw(locked) locks sync_sub(), and if you run this, you
+ can see that only one thread is in it at any one time.
+
+ =head2 Methods
+
+ Locking an entire subroutine can sometimes be overkill, especially
+ when dealing with Perl objects. When calling a method for an object,
+ for example, you want to serialize calls to a method, so that only one
+ thread will be in the subroutine for a particular object, but threads
+ calling that subroutine for a different object aren't blocked. The
+ method attribute indicates whether the subroutine is really a method.
+
+ use Thread;
+
+ sub tester {
+ my $thrnum = shift @_;
+ my $bar = new Foo;
+ foreach (1..10) {
+ print "$thrnum calling per_object\n";
+ $bar->per_object($thrnum);
+ print "$thrnum out of per_object\n";
+ yield;
+ print "$thrnum calling one_at_a_time\n";
+ $bar->one_at_a_time($thrnum);
+ print "$thrnum out of one_at_a_time\n";
+ yield;
+ }
+ }
+
+ foreach my $thrnum (1..10) {
+ new Thread \&tester, $thrnum;
+ }
+
+ package Foo;
+ sub new {
+ my $class = shift @_;
+ return bless [@_], $class;
+ }
+
+ sub per_object {
+ use attrs qw(locked method);
+ my ($class, $thrnum) = @_;
+ print "In per_object for thread $thrnum\n";
+ yield;
+ sleep 2;
+ print "Exiting per_object for thread $thrnum\n";
+ }
+
+ sub one_at_a_time {
+ use attrs qw(locked);
+ my ($class, $thrnum) = @_;
+ print "In one_at_a_time for thread $thrnum\n";
+ yield;
+ sleep 2;
+ print "Exiting one_at_a_time for thread $thrnum\n";
+ }
+
+ As you can see from the output (omitted for brevity; it's 800 lines)
+ all the threads can be in per_object() simultaneously, but only one
+ thread is ever in one_at_a_time() at once.
+
+ =head2 Locking A Subroutine
+
+ You can lock a subroutine as you would lock a variable. Subroutine
+ locks work the same as a C<use attrs qw(locked)> in the subroutine,
+ and block all access to the subroutine for other threads until the
+ lock goes out of scope. When the subroutine isn't locked, any number
+ of threads can be in it at once, and getting a lock on a subroutine
+ doesn't affect threads already in the subroutine. Getting a lock on a
+ subroutine looks like this:
+
+ lock(\&sub_to_lock);
+
+ Simple enough. Unlike use attrs, which is a compile time option,
+ locking and unlocking a subroutine can be done at runtime at your
+ discretion. There is some runtime penalty to using lock(\&sub) instead
+ of use attrs qw(locked), so make sure you're choosing the proper
+ method to do the locking.
+
+ You'd choose lock(\&sub) when writing modules and code to run on both
+ threaded and unthreaded Perl, especially for code that will run on
+ 5.004 or earlier Perls. In that case, it's useful to have subroutines
+ that should be serialized lock themselves if they're running threaded,
+ like so:
+
+ package Foo;
+ use Config;
+ $Running_Threaded = 0;
+
+ BEGIN { $Running_Threaded = $Config{'usethreads'} }
+
+ sub sub1 { lock(\&sub1) if $Running_Threaded }
+
+
+ This way you can ensure single-threadedness regardless of which
+ version of Perl you're running.
+
+ =head1 General Thread Utility Routines
+
+ We've covered the workhorse parts of Perl's threading package, and
+ with these tools you should be well on your way to writing threaded
+ code and packages. There are a few useful little pieces that didn't
+ really fit in anyplace else.
+
+ =head2 What Thread Am I In?
+
+ The Thread->self method provides your program with a way to get an
+ object representing the thread it's currently in. You can use this
+ object in the same way as the ones returned from the thread creation.
+
+ =head2 Thread IDs
+
+ tid() is a thread object method that returns the thread ID of the
+ thread the object represents. Thread IDs are integers, with the main
+ thread in a program being 0. Currently Perl assigns a unique tid to
+ every thread ever created in your program, assigning the first thread
+ to be created a tid of 1, and increasing the tid by 1 for each new
+ thread that's created.
+
+ =head2 Are These Threads The Same?
+
+ The equal() method takes two thread objects and returns true
+ if the objects represent the same thread, and false if they don't.
+
+ =head2 What Threads Are Running?
+
+ Thread->list returns a list of thread objects, one for each thread
+ that's currently running. Handy for a number of things, including
+ cleaning up at the end of your program:
+
+ # Loop through all the threads
+ foreach $thr (Thread->list) {
+ # Don't join the main thread or ourselves
+ if ($thr->tid && !Thread::equal($thr, Thread->self)) {
+ $thr->join;
+ }
+ }
+
+ The example above is just for illustration. It isn't strictly
+ necessary to join all the threads you create, since Perl detaches all
+ the threads before it exits.
+
+ =head1 A Complete Example
+
+ Confused yet? It's time for an example program to show some of the
+ things we've covered. This program finds prime numbers using threads.
+
+ 1 #!/usr/bin/perl -w
+ 2 # prime-pthread, courtesy of Tom Christiansen
+ 3
+ 4 use strict;
+ 5
+ 6 use Thread;
+ 7 use Thread::Queue;
+ 8
+ 9 my $stream = new Thread::Queue;
+ 10 my $kid = new Thread(\&check_num, $stream, 2);
+ 11
+ 12 for my $i ( 3 .. 1000 ) {
+ 13 $stream->enqueue($i);
+ 14 }
+ 15
+ 16 $stream->enqueue(undef);
+ 17 $kid->join();
+ 18
+ 19 sub check_num {
+ 20 my ($upstream, $cur_prime) = @_;
+ 21 my $kid;
+ 22 my $downstream = new Thread::Queue;
+ 23 while (my $num = $upstream->dequeue) {
+ 24 next unless $num % $cur_prime;
+ 25 if ($kid) {
+ 26 $downstream->enqueue($num);
+ 27 } else {
+ 28 print "Found prime $num\n";
+ 29 $kid = new Thread(\&check_num, $downstream, $num);
+ 30 }
+ 31 }
+ 32 $downstream->enqueue(undef) if $kid;
+ 33 $kid->join() if $kid;
+ 34 }
+
+ This program uses the pipeline model to generate prime numbers. Each
+ thread in the pipeline has an input queue that feeds numbers to be
+ checked, a prime number that it's responsible for, and an output queue
+ that it funnels numbers that have failed the check into. If the thread
+ has a number that's failed its check and there's no child thread, then
+ the thread must have found a new prime number. In that case, a new
+ child thread is created for that prime and stuck on the end of the
+ pipeline.
+
+ This probably sounds a bit more confusing than it really is, so lets
+ go through this program piece by piece and see what it does. (For
+ those of you who might be trying to remember exactly what a prime
+ number is, it's a number that's only evenly divisible by itself and 1)
+
+ The bulk of the work is done by the check_num() subroutine, which
+ takes a reference to its input queue and a prime number that it's
+ responsible for. After pulling in the input queue and the prime that
+ the subroutine's checking (line 20), we create a new queue (line 22)
+ and reserve a scalar for the thread that we're likely to create later
+ (line 21).
+
+ The while loop from lines 23 to line 31 grabs a scalar off the input
+ queue and checks against the prime this thread is responsible
+ for. Line 24 checks to see if there's a remainder when we modulo the
+ number to be checked against our prime. If there is one, the number
+ must not be evenly divisible by our prime, so we need to either pass
+ it on to the next thread if we've created one (line 26) or create a
+ new thread if we haven't.
+
+ The new thread creation is line 29. We pass on to it a reference to
+ the queue we've created, and the prime number we've found.
+
+ Finally, once the loop terminates (because we got a 0 or undef in the
+ queue, which serves as a note to die), we pass on the notice to our
+ child and wait for it to exit if we've created a child (Lines 32 and
+ 37).
+
+ Meanwhile, back in the main thread, we create a queue (line 9) and the
+ initial child thread (line 10), and pre-seed it with the first prime:
+ 2. Then we queue all the numbers from 3 to 1000 for checking (lines
+ 12-14), then queue a die notice (line 16) and wait for the first child
+ thread to terminate (line 17). Because a child won't die until its
+ child has died, we know that we're done once we return from the join.
+
+ That's how it works. It's pretty simple; as with many Perl programs,
+ the explanation is much longer than the program.
+
+ =head1 Conclusion
+
+ A complete thread tutorial could fill a book (and has, many times),
+ but this should get you well on your way. The final authority on how
+ Perl's threads behave is the documention bundled with the Perl
+ distribution, but with what we've covered in this article, you should
+ be well on your way to becoming a threaded Perl expert.
+
+ =head1 Bibliography
+
+ Here's a short bibliography courtesy of J�rgen Christoffel:
+
+ =head2 Introductory Texts
+
+ Birrell, Andrew D. An Introduction to Programming with
+ Threads. Digital Equipment Corporation, 1989, DEC-SRC Research Report
+ #35 online as
+ http://www.research.digital.com/SRC/staff/birrell/bib.html (highly
+ recommended)
+
+ Robbins, Kay. A., and Steven Robbins. Practical Unix Programming: A
+ Guide to Concurrency, Communication, and
+ Multithreading. Prentice-Hall, 1996.
+
+ Lewis, Bill, and Daniel J. Berg. Multithreaded Programming with
+ Pthreads. Prentice Hall, 1997, ISBN 0-13-443698-9 (a well-written
+ introduction to threads).
+
+ Nelson, Greg (editor). Systems Programming with Modula-3. Prentice
+ Hall, 1991, ISBN 0-13-590464-1.
+
+ Nichols, Bradford, Dick Buttlar, and Jacqueline Proulx Farrell.
+ Pthreads Programming. O'Reilly & Associates, 1996, ISBN 156592-115-1
+ (covers POSIX threads).
+
+ =head2 OS-Related References
+
+ Boykin, Joseph, David Kirschen, Alan Langerman, and Susan
+ LoVerso. Programming under Mach. Addison-Wesley, 1994, ISBN
+ 0-201-52739-1.
+
+ Tanenbaum, Andrew S. Distributed Operating Systems. Prentice Hall,
+ 1995, ISBN 0-13-143934-0 (great textbook).
+
+ Silberschatz, Abraham, and Peter B. Galvin. Operating System Concepts,
+ 4th ed. Addison-Wesley, 1995, ISBN 0-201-59292-4
+
+ =head2 Other References
+
+ Arnold, Ken and James Gosling. The Java Programming Language, 2nd
+ ed. Addison-Wesley, 1998, ISBN 0-201-31006-6.
+
+ Le Sergent, T. and B. Berthomieu. "Incremental MultiThreaded Garbage
+ Collection on Virtually Shared Memory Architectures" in Memory
+ Management: Proc. of the International Workshop IWMM 92, St. Malo,
+ France, September 1992, Yves Bekkers and Jacques Cohen, eds. Springer,
+ 1992, ISBN 3540-55940-X (real-life thread applications).
+
+ =head1 Acknowledgements
+
+ Thanks (in no particular order) to Chaim Frenkel, Steve Fink, Gurusamy
+ Sarathy, Ilya Zakharevich, Benjamin Sugars, J�rgen Christoffel, Joshua
+ Pritikin, and Alan Burlison, for their help in reality-checking and
+ polishing this article. Big thanks to Tom Christiansen for his rewrite
+ of the prime number generator.
+
+ =head1 AUTHOR
+
+ Dan Sugalski E<lt>sugalskd@ous.eduE<gt>
+
+ =head1 Copyrights
+
+ This article originally appeared in The Perl Journal #10, and is
+ copyright 1998 The Perl Journal. It appears courtesy of Jon Orwant and
+ The Perl Journal. This document may be distributed under the same terms
+ as Perl itself.
+
+
diff -c 'perl5.005_02/pod/perltie.pod' 'perl5.005_03/pod/perltie.pod'
Index: ./pod/perltie.pod
*** ./pod/perltie.pod Thu Jul 23 23:01:49 1998
--- ./pod/perltie.pod Thu Mar 4 18:34:52 1999
***************
*** 680,688 ****
or C<sysread> functions.
sub READ {
! $r = shift;
! my($buf,$len,$offset) = @_;
! print "READ called, \$buf=$buf, \$len=$len, \$offset=$offset";
}
=item READLINE this
--- 680,691 ----
or C<sysread> functions.
sub READ {
! my $self = shift;
! my $$bufref = \$_[0];
! my(undef,$len,$offset) = @_;
! print "READ called, \$buf=$bufref, \$len=$len, \$offset=$offset";
! # add to $$bufref, set $len to number of characters read
! $len;
}
=item READLINE this
***************
*** 690,696 ****
This method will be called when the handle is read from via <HANDLE>.
The method should return undef when there is no more data.
! sub READLINE { $r = shift; "PRINT called $$r times\n"; }
=item GETC this
--- 693,699 ----
This method will be called when the handle is read from via <HANDLE>.
The method should return undef when there is no more data.
! sub READLINE { $r = shift; "READLINE called $$r times\n"; }
=item GETC this
diff -c 'perl5.005_02/pod/perltoc.pod' 'perl5.005_03/pod/perltoc.pod'
Index: ./pod/perltoc.pod
*** ./pod/perltoc.pod Sat Jul 25 21:14:35 1998
--- ./pod/perltoc.pod Sat Mar 27 16:27:41 1999
***************
*** 1353,1359 ****
=item Private Variables via C<my()>
! =item Peristent Private Variables
=item Temporary Values via local()
--- 1353,1359 ----
=item Private Variables via C<my()>
! =item Persistent Private Variables
=item Temporary Values via local()
***************
*** 2263,2269 ****
The djgpp environment for DOS, C<http://www.delorie.com/djgpp/>, The EMX
environment for DOS, OS/2, etc.
! C<emx@iaehv.nl>,C<http://www.juge.com/bbs/Hobb.19.html>, Build instructions
for Win32, L<perlwin32>, The ActiveState Pages,
C<http://www.activestate.com/>
--- 2263,2270 ----
The djgpp environment for DOS, C<http://www.delorie.com/djgpp/>, The EMX
environment for DOS, OS/2, etc.
! C<emx@iaehv.nl>,C<http://www.leo.org/pub/comp/os/os2/leo/gnu/emx+gcc/index.html>,
! C<ftp://hobbes.nmsu.edu/pub/os2/dev/emx>. Build instructions
for Win32, L<perlwin32>, The ActiveState Pages,
C<http://www.activestate.com/>
diff -c 'perl5.005_02/pod/perlvar.pod' 'perl5.005_03/pod/perlvar.pod'
Index: ./pod/perlvar.pod
*** ./pod/perlvar.pod Thu Jul 23 23:01:54 1998
--- ./pod/perlvar.pod Sat Mar 27 12:22:17 1999
***************
*** 17,22 ****
--- 17,31 ----
long names in the current package. Some even have medium names,
generally borrowed from B<awk>.
+ Due to an unfortunate accident of Perl's implementation, "C<use English>"
+ imposes a considerable performance penalty on all regular expression
+ matches in a program, regardless of whether they occur in the scope of
+ "C<use English>". For that reason, saying "C<use English>" in
+ libraries is strongly discouraged. See the Devel::SawAmpersand module
+ documentation from CPAN
+ (http://www.perl.com/CPAN/modules/by-module/Devel/Devel-SawAmpersand-0.10.readme)
+ for more information.
+
To go a step further, those variables that depend on the currently
selected filehandle may instead (and preferably) be set by calling an
object method on the FileHandle object. (Summary lines below for this
***************
*** 127,132 ****
--- 136,145 ----
any matches hidden within a BLOCK or eval() enclosed by the current
BLOCK). (Mnemonic: like & in some editors.) This variable is read-only.
+ The use of this variable anywhere in a program imposes a considerable
+ performance penalty on all regular expression matches. See the
+ Devel::SawAmpersand module from CPAN for more information.
+
=item $PREMATCH
=item $`
***************
*** 136,141 ****
--- 149,158 ----
enclosed by the current BLOCK). (Mnemonic: C<`> often precedes a quoted
string.) This variable is read-only.
+ The use of this variable anywhere in a program imposes a considerable
+ performance penalty on all regular expression matches. See the
+ Devel::SawAmpersand module from CPAN for more information.
+
=item $POSTMATCH
=item $'
***************
*** 151,156 ****
--- 168,177 ----
This variable is read-only.
+ The use of this variable anywhere in a program imposes a considerable
+ performance penalty on all regular expression matches. See the
+ Devel::SawAmpersand module from CPAN for more information.
+
=item $LAST_PAREN_MATCH
=item $+
***************
*** 188,194 ****
=item $.
The current input line number for the last file handle from
! which you read (or performed a C<seek> or C<tell> on). An
explicit close on a filehandle resets the line number. Because
"C<E<lt>E<gt>>" never does an explicit close, line numbers increase
across ARGV files (but see examples under eof()). Localizing C<$.> has
--- 209,218 ----
=item $.
The current input line number for the last file handle from
! which you read (or performed a C<seek> or C<tell> on). The value
! may be different from the actual physical line number in the file,
! depending on what notion of "line" is in effect--see L<$/> on how
! to affect that. An
explicit close on a filehandle resets the line number. Because
"C<E<lt>E<gt>>" never does an explicit close, line numbers increase
across ARGV files (but see examples under eof()). Localizing C<$.> has
***************
*** 204,210 ****
=item $/
! The input record separator, newline by default. Works like B<awk>'s RS
variable, including treating empty lines as delimiters if set to the
null string. (Note: An empty line cannot contain any spaces or tabs.)
You may set it to a multi-character string to match a multi-character
--- 228,235 ----
=item $/
! The input record separator, newline by default. This is used to
! influence Perl's idea of what a "line" is. Works like B<awk>'s RS
variable, including treating empty lines as delimiters if set to the
null string. (Note: An empty line cannot contain any spaces or tabs.)
You may set it to a multi-character string to match a multi-character
***************
*** 216,223 ****
character belongs to the next paragraph, even if it's a newline.
(Mnemonic: / is used to delimit line boundaries when quoting poetry.)
! undef $/;
! $_ = <FH>; # whole file now here
s/\n[ \t]+/ /g;
Remember: the value of $/ is a string, not a regexp. AWK has to be
--- 241,248 ----
character belongs to the next paragraph, even if it's a newline.
(Mnemonic: / is used to delimit line boundaries when quoting poetry.)
! undef $/; # enable "slurp" mode
! $_ = <FH>; # whole file now here
s/\n[ \t]+/ /g;
Remember: the value of $/ is a string, not a regexp. AWK has to be
***************
*** 241,249 ****
On VMS, record reads are done with the equivalent of C<sysread>, so it's
best not to mix record and non-record reads on the same file. (This is
likely not a problem, as any file you'd want to read in record mode is
! proably usable in line mode) Non-VMS systems perform normal I/O, so
it's safe to mix record and non-record reads of a file.
=item autoflush HANDLE EXPR
=item $OUTPUT_AUTOFLUSH
--- 266,276 ----
On VMS, record reads are done with the equivalent of C<sysread>, so it's
best not to mix record and non-record reads on the same file. (This is
likely not a problem, as any file you'd want to read in record mode is
! probably usable in line mode) Non-VMS systems perform normal I/O, so
it's safe to mix record and non-record reads of a file.
+ Also see L<$.>.
+
=item autoflush HANDLE EXPR
=item $OUTPUT_AUTOFLUSH
***************
*** 626,631 ****
--- 653,667 ----
See also the documentation of C<use VERSION> and C<require VERSION>
for a convenient way to fail if the Perl interpreter is too old.
+ =item $COMPILING
+
+ =item $^C
+
+ The current value of the flag associated with the B<-c> switch. Mainly
+ of use with B<-MO=...> to allow code to alter its behaviour when being compiled.
+ (For example to automatically AUTOLOADing at compile time rather than normal
+ deferred loading.) Setting C<$^C = 1> is similar to calling C<B::minus_c>.
+
=item $DEBUGGING
=item $^D
***************
*** 643,649 ****
preserved even if the open() fails. (Ordinary file descriptors are
closed before the open() is attempted.) Note that the close-on-exec
status of a file descriptor will be decided according to the value of
! C<$^F> at the time of the open, not the time of the exec.
=item $^H
--- 679,685 ----
preserved even if the open() fails. (Ordinary file descriptors are
closed before the open() is attempted.) Note that the close-on-exec
status of a file descriptor will be decided according to the value of
! C<$^F> when the open() or pipe() was called, not the time of the exec().
=item $^H
***************
*** 714,720 ****
=back
! Note that some bits may be relevent at compile-time only, some at
run-time only. This is a new mechanism and the details may change.
=item $^R
--- 750,756 ----
=back
! Note that some bits may be relevant at compile-time only, some at
run-time only. This is a new mechanism and the details may change.
=item $^R
***************
*** 788,799 ****
The C<require> command uses this array to determine whether a given file
has already been included.
! =item %ENV $ENV{expr}
The hash %ENV contains your current environment. Setting a
value in C<ENV> changes the environment for child processes.
! =item %SIG $SIG{expr}
The hash %SIG is used to set signal handlers for various
signals. Example:
--- 824,839 ----
The C<require> command uses this array to determine whether a given file
has already been included.
! =item %ENV
!
! =item $ENV{expr}
The hash %ENV contains your current environment. Setting a
value in C<ENV> changes the environment for child processes.
! =item %SIG
!
! =item $SIG{expr}
The hash %SIG is used to set signal handlers for various
signals. Example:
***************
*** 811,816 ****
--- 851,860 ----
$SIG{'INT'} = 'DEFAULT'; # restore default action
$SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT
+ Using a value of C<'IGNORE'> usually has the effect of ignoring the
+ signal, except for the C<CHLD> signal. See L<perlipc> for more about
+ this special case.
+
The %SIG array contains values for only the signals actually set within
the Perl script. Here are some other examples:
***************
*** 867,873 ****
parser. In such a case the parser may be in inconsistent state, so
any attempt to evaluate Perl code from such a handler will probably
result in a segfault. This means that calls which result/may-result
! in parsing Perl should be used with extreme causion, like this:
require Carp if defined $^S;
Carp::confess("Something wrong") if defined &Carp::confess;
--- 911,917 ----
parser. In such a case the parser may be in inconsistent state, so
any attempt to evaluate Perl code from such a handler will probably
result in a segfault. This means that calls which result/may-result
! in parsing Perl should be used with extreme caution, like this:
require Carp if defined $^S;
Carp::confess("Something wrong") if defined &Carp::confess;
***************
*** 934,936 ****
--- 978,1012 ----
For more details, see the individual descriptions at L<$@>, L<$!>, L<$^E>,
and L<$?>.
+
+
+ =head2 Technical Note on the Syntax of Variable Names
+
+ Variable names in Perl can have several formats. Usually, they must
+ begin with a letter or underscore, in which case they can be
+ arbitrarily long (up to an internal limit of 256 characters) and may
+ contain letters, digits, underscores, or the special sequence C<::>.
+ In this case the part before the last C<::> is taken to be a I<package
+ qualifier>; see L<perlmod>.
+
+ Perl variable names may also be a sequence of digits or a single
+ punctuation or control character. These names are all reserved for
+ special uses by Perl; for example, the all-digits names are used to
+ hold backreferences after a regular expression match. Perl has a
+ special syntax for the single-control-character names: It understands
+ C<^X> (caret C<X>) to mean the control-C<X> character. For example,
+ the notation C<$^W> (dollar-sign caret C<W>) is the scalar variable
+ whose name is the single character control-C<W>. This is better than
+ typing a literal control-C<W> into your program.
+
+ All Perl variables that begin with digits, control characters, or
+ punctuation characters are exempt from the effects of the C<package>
+ declaration and are always forced to be in package C<main>. A few
+ other names are also exempt:
+
+ ENV STDIN
+ INC STDOUT
+ ARGV STDERR
+ ARGVOUT
+ SIG
+
diff -c 'perl5.005_02/pod/perlxs.pod' 'perl5.005_03/pod/perlxs.pod'
Index: ./pod/perlxs.pod
*** ./pod/perlxs.pod Thu Jul 23 23:01:55 1998
--- ./pod/perlxs.pod Sat Mar 27 18:06:52 1999
***************
*** 181,190 ****
Older versions of this document recommended to use C<void> return
value in such cases. It was discovered that this could lead to
! segfaults in cases when XSUB was I<truely> C<void>. This practice is
now deprecated, and may be not supported at some future version. Use
the return value C<SV *> in such cases. (Currently C<xsubpp> contains
! some heuristic code which tries to disambiguate between "truely-void"
and "old-practice-declared-as-void" functions. Hence your code is at
mercy of this heuristics unless you use C<SV *> as return value.)
--- 181,190 ----
Older versions of this document recommended to use C<void> return
value in such cases. It was discovered that this could lead to
! segfaults in cases when XSUB was I<truly> C<void>. This practice is
now deprecated, and may be not supported at some future version. Use
the return value C<SV *> in such cases. (Currently C<xsubpp> contains
! some heuristic code which tries to disambiguate between "truly-void"
and "old-practice-declared-as-void" functions. Hence your code is at
mercy of this heuristics unless you use C<SV *> as return value.)
***************
*** 387,395 ****
initialization begins with C<;> or C<+>, then it is output after
all of the input variables have been declared. The C<=> and C<;>
cases replace the initialization normally supplied from the typemap.
! For the C<+> case, the initialization from the typemap will preceed
the initialization code included after the C<+>. A global
! variable, C<%v>, is available for the truely rare case where
information from one initialization is needed in another
initialization.
--- 387,395 ----
initialization begins with C<;> or C<+>, then it is output after
all of the input variables have been declared. The C<=> and C<;>
cases replace the initialization normally supplied from the typemap.
! For the C<+> case, the initialization from the typemap will precede
the initialization code included after the C<+>. A global
! variable, C<%v>, is available for the truly rare case where
information from one initialization is needed in another
initialization.
***************
*** 553,561 ****
time_t timep = NO_INIT
PREINIT:
char *host = "localhost";
CODE:
if( items > 1 )
! host = (char *)SvPV(ST(1), PL_na);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
--- 553,562 ----
time_t timep = NO_INIT
PREINIT:
char *host = "localhost";
+ STRLEN n_a;
CODE:
if( items > 1 )
! host = (char *)SvPV(ST(1), n_a);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
***************
*** 786,794 ****
PROTOTYPE: $;$
PREINIT:
char *host = "localhost";
CODE:
if( items > 1 )
! host = (char *)SvPV(ST(1), PL_na);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
--- 787,796 ----
PROTOTYPE: $;$
PREINIT:
char *host = "localhost";
+ STRLEN n_a;
CODE:
if( items > 1 )
! host = (char *)SvPV(ST(1), n_a);
RETVAL = rpcb_gettime( host, &timep );
OUTPUT:
timep
***************
*** 1212,1224 ****
The typemap is a collection of code fragments which are used by the B<xsubpp>
compiler to map C function parameters and values to Perl values. The
typemap file may consist of three sections labeled C<TYPEMAP>, C<INPUT>, and
! C<OUTPUT>. The INPUT section tells the compiler how to translate Perl values
into variables of certain C types. The OUTPUT section tells the compiler
how to translate the values from certain C types into values Perl can
understand. The TYPEMAP section tells the compiler which of the INPUT and
OUTPUT code fragments should be used to map a given C type to a Perl value.
! Each of the sections of the typemap must be preceded by one of the TYPEMAP,
! INPUT, or OUTPUT keywords.
The default typemap in the C<ext> directory of the Perl source contains many
useful types which can be used by Perl extensions. Some extensions define
--- 1214,1228 ----
The typemap is a collection of code fragments which are used by the B<xsubpp>
compiler to map C function parameters and values to Perl values. The
typemap file may consist of three sections labeled C<TYPEMAP>, C<INPUT>, and
! C<OUTPUT>. Any unlabelled initial section is assumed to be a C<TYPEMAP>
! section if a name is not explicitly specified. The INPUT section tells
! the compiler how to translate Perl values
into variables of certain C types. The OUTPUT section tells the compiler
how to translate the values from certain C types into values Perl can
understand. The TYPEMAP section tells the compiler which of the INPUT and
OUTPUT code fragments should be used to map a given C type to a Perl value.
! The section labels C<TYPEMAP>, C<INPUT>, or C<OUTPUT> must begin
! in the first column on a line by themselves, and must be in uppercase.
The default typemap in the C<ext> directory of the Perl source contains many
useful types which can be used by Perl extensions. Some extensions define
diff -c 'perl5.005_02/pod/perlxstut.pod' 'perl5.005_03/pod/perlxstut.pod'
Index: ./pod/perlxstut.pod
*** ./pod/perlxstut.pod Thu Jul 23 23:01:56 1998
--- ./pod/perlxstut.pod Sat Jan 16 13:04:31 1999
***************
*** 465,471 ****
in this directory. Then we'll make sure that running make at the Mytest2
level will automatically run this Makefile.PL file and the resulting Makefile.
! In the testlib directory, create a file mylib.h that looks like this:
#define TESTVAL 4
--- 465,471 ----
in this directory. Then we'll make sure that running make at the Mytest2
level will automatically run this Makefile.PL file and the resulting Makefile.
! In the mylib directory, create a file mylib.h that looks like this:
#define TESTVAL 4
diff -c 'perl5.005_02/pod/pod2html.PL' 'perl5.005_03/pod/pod2html.PL'
Index: ./pod/pod2html.PL
*** ./pod/pod2html.PL Thu Jul 23 23:01:56 1998
--- ./pod/pod2html.PL Wed Dec 30 08:59:20 1998
***************
*** 164,170 ****
=head1 SEE ALSO
! L<perlpod>, L<Pod::HTML>
=head1 COPYRIGHT
--- 164,170 ----
=head1 SEE ALSO
! L<perlpod>, L<Pod::Html>
=head1 COPYRIGHT
diff -c 'perl5.005_02/pod/pod2man.PL' 'perl5.005_03/pod/pod2man.PL'
Index: ./pod/pod2man.PL
Prereq: 1.5
*** ./pod/pod2man.PL Thu Jul 23 23:01:57 1998
--- ./pod/pod2man.PL Sat Jan 2 09:43:49 1999
***************
*** 318,325 ****
# running an installed version of Perl to produce documentation from an
# uninstalled newer version's pod files.
if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
! ($version,$patch) =
! `\PATH=.:..:\$PATH; perl -v` =~ /version (\d\.\d{3})(?:_(\d{2}))?/;
}
# No luck; we'll just go with the running Perl's version
($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
--- 318,329 ----
# running an installed version of Perl to produce documentation from an
# uninstalled newer version's pod files.
if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') {
! my $perl = (-x './perl' && -f './perl' ) ?
! './perl' :
! ((-x '../perl' && -f '../perl') ?
! '../perl' :
! '');
! ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl;
}
# No luck; we'll just go with the running Perl's version
($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version;
***************
*** 331,336 ****
--- 335,341 ----
my $secs = shift;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon];
+ $year += 1900;
return "$mday/$mname/$year";
}
diff -c 'perl5.005_02/pod/roffitall' 'perl5.005_03/pod/roffitall'
Index: ./pod/roffitall
*** ./pod/roffitall Mon Aug 3 14:02:45 1998
--- ./pod/roffitall Thu Feb 11 18:06:13 1999
***************
*** 36,41 ****
--- 36,42 ----
$mandir/perlre.1 \
$mandir/perlrun.1 \
$mandir/perlfunc.1 \
+ $mandir/perlopentut.1 \
$mandir/perlvar.1 \
$mandir/perlsub.1 \
$mandir/perlmod.1 \
***************
*** 44,49 ****
--- 45,51 ----
$mandir/perlform.1 \
$mandir/perllocale.1 \
$mandir/perlref.1 \
+ $mandir/perlreftut.1 \
$mandir/perldsc.1 \
$mandir/perllol.1 \
$mandir/perltoot.1 \
***************
*** 65,70 ****
--- 67,73 ----
$mandir/perlxstut.1 \
$mandir/perlguts.1 \
$mandir/perlcall.1 \
+ $mandir/perlthrtut.1 \
$mandir/perlhist.1 \
$mandir/perldelta.1 \
$mandir/perl5004delta.1 \
***************
*** 149,154 ****
--- 152,158 ----
$libdir/Devel::SelfStubber.3 \
$libdir/DirHandle.3 \
$libdir/DynaLoader.3 \
+ $libdir/Dumpvalue.3 \
$libdir/English.3 \
$libdir/Env.3 \
$libdir/Errno.3 \
diff -c 'perl5.005_02/pp.c' 'perl5.005_03/pp.c'
Index: ./pp.c
*** ./pp.c Tue Aug 4 16:58:01 1998
--- ./pp.c Sat Mar 27 22:05:12 1999
***************
*** 1,6 ****
/* pp.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* pp.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 105,113 ****
static void doencodes _((SV* sv, char* s, I32 len));
static SV* refto _((SV* sv));
static U32 seed _((void));
#endif
- static bool srand_called = FALSE;
/* variations on pp_null */
--- 105,113 ----
static void doencodes _((SV* sv, char* s, I32 len));
static SV* refto _((SV* sv));
static U32 seed _((void));
+ static bool srand_called = FALSE;
#endif
/* variations on pp_null */
***************
*** 224,229 ****
--- 224,230 ----
else {
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
***************
*** 238,244 ****
warn(warn_uninit);
RETSETUNDEF;
}
! sym = SvPV(sv, PL_na);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a symbol");
sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
--- 239,245 ----
warn(warn_uninit);
RETSETUNDEF;
}
! sym = SvPV(sv, n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a symbol");
sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
***************
*** 267,272 ****
--- 268,274 ----
else {
GV *gv = (GV*)sv;
char *sym;
+ STRLEN n_a;
if (SvTYPE(gv) != SVt_PVGV) {
if (SvGMAGICAL(sv)) {
***************
*** 282,288 ****
warn(warn_uninit);
RETSETUNDEF;
}
! sym = SvPV(sv, PL_na);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a SCALAR");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
--- 284,290 ----
warn(warn_uninit);
RETSETUNDEF;
}
! sym = SvPV(sv, n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a SCALAR");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
***************
*** 533,541 ****
SV *tmpRef;
char *elem;
djSP;
sv = POPs;
! elem = SvPV(sv, PL_na);
gv = (GV*)POPs;
tmpRef = Nullsv;
sv = Nullsv;
--- 535,544 ----
SV *tmpRef;
char *elem;
djSP;
+ STRLEN n_a;
sv = POPs;
! elem = SvPV(sv, n_a);
gv = (GV*)POPs;
tmpRef = Nullsv;
sv = Nullsv;
***************
*** 716,726 ****
RETPUSHNO;
switch (SvTYPE(sv)) {
case SVt_PVAV:
! if (AvMAX(sv) >= 0 || SvGMAGICAL(sv))
RETPUSHYES;
break;
case SVt_PVHV:
! if (HvARRAY(sv) || SvGMAGICAL(sv))
RETPUSHYES;
break;
case SVt_PVCV:
--- 719,729 ----
RETPUSHNO;
switch (SvTYPE(sv)) {
case SVt_PVAV:
! if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
RETPUSHYES;
break;
case SVt_PVHV:
! if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
RETPUSHYES;
break;
case SVt_PVCV:
***************
*** 751,758 ****
RETPUSHUNDEF;
if (SvTHINKFIRST(sv)) {
! if (SvREADONLY(sv))
! RETPUSHUNDEF;
if (SvROK(sv))
sv_unref(sv);
}
--- 754,764 ----
RETPUSHUNDEF;
if (SvTHINKFIRST(sv)) {
! if (SvREADONLY(sv)) {
! dTHR;
! if (PL_curcop != &PL_compiling)
! croak(no_modify);
! }
if (SvROK(sv))
sv_unref(sv);
}
***************
*** 1634,1654 ****
#define SEED_C5 26107
dTHR;
U32 u;
#ifdef VMS
# include <starlet.h>
/* when[] = (low 32 bits, high 32 bits) of time since epoch
* in 100-ns units, typically incremented ever 10 ms. */
unsigned int when[2];
_ckvmssts(sys$gettim(when));
u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
#else
# ifdef HAS_GETTIMEOFDAY
- struct timeval when;
gettimeofday(&when,(struct timezone *) 0);
u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
# else
- Time_t when;
(void)time(&when);
u = (U32)SEED_C1 * when;
# endif
--- 1640,1689 ----
#define SEED_C5 26107
dTHR;
+ #ifndef PERL_NO_DEV_RANDOM
+ int fd;
+ #endif
U32 u;
#ifdef VMS
# include <starlet.h>
/* when[] = (low 32 bits, high 32 bits) of time since epoch
* in 100-ns units, typically incremented ever 10 ms. */
unsigned int when[2];
+ #else
+ # ifdef HAS_GETTIMEOFDAY
+ struct timeval when;
+ # else
+ Time_t when;
+ # endif
+ #endif
+
+ /* This test is an escape hatch, this symbol isn't set by Configure. */
+ #ifndef PERL_NO_DEV_RANDOM
+ #ifndef PERL_RANDOM_DEVICE
+ /* /dev/random isn't used by default because reads from it will block
+ * if there isn't enough entropy available. You can compile with
+ * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
+ * is enough real entropy to fill the seed. */
+ # define PERL_RANDOM_DEVICE "/dev/urandom"
+ #endif
+ fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
+ if (fd != -1) {
+ if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+ u = 0;
+ PerlLIO_close(fd);
+ if (u)
+ return u;
+ }
+ #endif
+
+ #ifdef VMS
_ckvmssts(sys$gettim(when));
u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
#else
# ifdef HAS_GETTIMEOFDAY
gettimeofday(&when,(struct timezone *) 0);
u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
# else
(void)time(&when);
u = (U32)SEED_C1 * when;
# endif
***************
*** 1760,1767 ****
djSP; dTARGET;
char *tmps;
I32 argtype;
! tmps = POPp;
XPUSHu(scan_hex(tmps, 99, &argtype));
RETURN;
}
--- 1795,1803 ----
djSP; dTARGET;
char *tmps;
I32 argtype;
+ STRLEN n_a;
! tmps = POPpx;
XPUSHu(scan_hex(tmps, 99, &argtype));
RETURN;
}
***************
*** 1772,1779 ****
UV value;
I32 argtype;
char *tmps;
! tmps = POPp;
while (*tmps && isSPACE(*tmps))
tmps++;
if (*tmps == '0')
--- 1808,1816 ----
UV value;
I32 argtype;
char *tmps;
+ STRLEN n_a;
! tmps = POPpx;
while (*tmps && isSPACE(*tmps))
tmps++;
if (*tmps == '0')
***************
*** 1866,1872 ****
if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
! SvPV_force(sv,PL_na);
if (PL_dowarn)
warn("Attempt to use reference as lvalue in substr");
}
--- 1903,1910 ----
if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
! STRLEN n_a;
! SvPV_force(sv,n_a);
if (PL_dowarn)
warn("Attempt to use reference as lvalue in substr");
}
***************
*** 2067,2079 ****
djSP; dTARGET;
I32 value;
char *tmps;
#ifndef I286
! tmps = POPp;
value = (I32) (*tmps & 255);
#else
I32 anum;
! tmps = POPp;
anum = (I32) *tmps;
value = (I32) (anum & 255);
#endif
--- 2105,2118 ----
djSP; dTARGET;
I32 value;
char *tmps;
+ STRLEN n_a;
#ifndef I286
! tmps = POPpx;
value = (I32) (*tmps & 255);
#else
I32 anum;
! tmps = POPpx;
anum = (I32) *tmps;
value = (I32) (anum & 255);
#endif
***************
*** 2100,2111 ****
PP(pp_crypt)
{
djSP; dTARGET; dPOPTOPssrl;
#ifdef HAS_CRYPT
! char *tmps = SvPV(left, PL_na);
#ifdef FCRYPT
! sv_setpv(TARG, fcrypt(tmps, SvPV(right, PL_na)));
#else
! sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, PL_na)));
#endif
#else
DIE(
--- 2139,2151 ----
PP(pp_crypt)
{
djSP; dTARGET; dPOPTOPssrl;
+ STRLEN n_a;
#ifdef HAS_CRYPT
! char *tmps = SvPV(left, n_a);
#ifdef FCRYPT
! sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
#else
! sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
#else
DIE(
***************
*** 2120,2125 ****
--- 2160,2166 ----
djSP;
SV *sv = TOPs;
register char *s;
+ STRLEN n_a;
if (!SvPADTMP(sv)) {
dTARGET;
***************
*** 2127,2133 ****
sv = TARG;
SETs(sv);
}
! s = SvPV_force(sv, PL_na);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
--- 2168,2174 ----
sv = TARG;
SETs(sv);
}
! s = SvPV_force(sv, n_a);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
***************
*** 2146,2151 ****
--- 2187,2193 ----
djSP;
SV *sv = TOPs;
register char *s;
+ STRLEN n_a;
if (!SvPADTMP(sv)) {
dTARGET;
***************
*** 2153,2159 ****
sv = TARG;
SETs(sv);
}
! s = SvPV_force(sv, PL_na);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
--- 2195,2201 ----
sv = TARG;
SETs(sv);
}
! s = SvPV_force(sv, n_a);
if (*s) {
if (PL_op->op_private & OPpLOCALE) {
TAINT;
***************
*** 2428,2435 ****
svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
}
if (lval) {
! if (!svp || *svp == &PL_sv_undef)
! DIE(no_helem, SvPV(keysv, PL_na));
if (PL_op->op_private & OPpLVAL_INTRO)
save_helem(hv, keysv, svp);
}
--- 2470,2479 ----
svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
}
if (lval) {
! if (!svp || *svp == &PL_sv_undef) {
! STRLEN n_a;
! DIE(no_helem, SvPV(keysv, n_a));
! }
if (PL_op->op_private & OPpLVAL_INTRO)
save_helem(hv, keysv, svp);
}
***************
*** 2561,2568 ****
SV **tmparyval = 0;
MAGIC *mg;
! if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
! *MARK-- = mg->mg_obj;
PUSHMARK(MARK);
PUTBACK;
ENTER;
--- 2605,2612 ----
SV **tmparyval = 0;
MAGIC *mg;
! if (mg = SvTIED_mg((SV*)ary, 'P')) {
! *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
***************
*** 2759,2766 ****
register SV *sv = &PL_sv_undef;
MAGIC *mg;
! if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
! *MARK-- = mg->mg_obj;
PUSHMARK(MARK);
PUTBACK;
ENTER;
--- 2803,2810 ----
register SV *sv = &PL_sv_undef;
MAGIC *mg;
! if (mg = SvTIED_mg((SV*)ary, 'P')) {
! *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
***************
*** 2815,2822 ****
register I32 i = 0;
MAGIC *mg;
! if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
! *MARK-- = mg->mg_obj;
PUSHMARK(MARK);
PUTBACK;
ENTER;
--- 2859,2866 ----
register I32 i = 0;
MAGIC *mg;
! if (mg = SvTIED_mg((SV*)ary, 'P')) {
! *MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
***************
*** 2910,2916 ****
--- 2954,2962 ----
static const char uuemap[] =
"`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
+ #ifndef PERL_OBJECT
static char uudmap[256]; /* Initialised on first use */
+ #endif
#if 'I' == 73 && 'J' == 74
/* On an ASCII/ISO kind of system */
#define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a')
***************
*** 2959,2971 ****
I32 checksum = 0;
register U32 culong;
double cdouble;
static char* bitcount = 0;
int commas = 0;
if (gimme != G_ARRAY) { /* arrange to do first one only */
/*SUPPRESS 530*/
for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
! if (strchr("aAbBhHP", *patend) || *pat == '%') {
patend++;
while (isDIGIT(*patend) || *patend == '*')
patend++;
--- 3005,3019 ----
I32 checksum = 0;
register U32 culong;
double cdouble;
+ #ifndef PERL_OBJECT
static char* bitcount = 0;
+ #endif
int commas = 0;
if (gimme != G_ARRAY) { /* arrange to do first one only */
/*SUPPRESS 530*/
for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
! if (strchr("aAZbBhHP", *patend) || *pat == '%') {
patend++;
while (isDIGIT(*patend) || *patend == '*')
patend++;
***************
*** 3023,3028 ****
--- 3071,3077 ----
s += len;
break;
case 'A':
+ case 'Z':
case 'a':
if (len > strend - s)
len = strend - s;
***************
*** 3031,3042 ****
sv = NEWSV(35, len);
sv_setpvn(sv, s, len);
s += len;
! if (datumtype == 'A') {
aptr = s; /* borrow register */
! s = SvPVX(sv) + len - 1;
! while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
! s--;
! *++s = '\0';
SvCUR_set(sv, s - SvPVX(sv));
s = aptr; /* unborrow register */
}
--- 3080,3098 ----
sv = NEWSV(35, len);
sv_setpvn(sv, s, len);
s += len;
! if (datumtype == 'A' || datumtype == 'Z') {
aptr = s; /* borrow register */
! if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
! s = SvPVX(sv);
! while (*s)
! s++;
! }
! else { /* 'A' strips both nulls and spaces */
! s = SvPVX(sv) + len - 1;
! while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
! s--;
! *++s = '\0';
! }
SvCUR_set(sv, s - SvPVX(sv));
s = aptr; /* unborrow register */
}
***************
*** 3195,3200 ****
--- 3251,3260 ----
if (checksum) {
while (len-- > 0) {
COPY16(s, &ashort);
+ #if SHORTSIZE > SIZE16
+ if (ashort > 32767)
+ ashort -= 65536;
+ #endif
s += SIZE16;
culong += ashort;
}
***************
*** 3204,3209 ****
--- 3264,3273 ----
EXTEND_MORTAL(len);
while (len-- > 0) {
COPY16(s, &ashort);
+ #if SHORTSIZE > SIZE16
+ if (ashort > 32767)
+ ashort -= 65536;
+ #endif
s += SIZE16;
sv = NEWSV(38, 0);
sv_setiv(sv, (IV)ashort);
***************
*** 3306,3311 ****
--- 3370,3386 ----
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));
}
***************
*** 3318,3323 ****
--- 3393,3402 ----
if (checksum) {
while (len-- > 0) {
COPY32(s, &along);
+ #if LONGSIZE > SIZE32
+ if (along > 2147483647)
+ along -= 4294967296;
+ #endif
s += SIZE32;
if (checksum > 32)
cdouble += (double)along;
***************
*** 3330,3335 ****
--- 3409,3418 ----
EXTEND_MORTAL(len);
while (len-- > 0) {
COPY32(s, &along);
+ #if LONGSIZE > SIZE32
+ if (along > 2147483647)
+ along -= 4294967296;
+ #endif
s += SIZE32;
sv = NEWSV(42, 0);
sv_setiv(sv, (IV)along);
***************
*** 3419,3424 ****
--- 3502,3508 ----
}
else if (++bytes >= sizeof(UV)) { /* promote to string */
char *t;
+ STRLEN n_a;
sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
***************
*** 3428,3434 ****
break;
}
}
! t = SvPV(sv, PL_na);
while (*t == '0')
t++;
sv_chop(sv, t);
--- 3512,3518 ----
break;
}
}
! t = SvPV(sv, n_a);
while (*t == '0')
t++;
sv_chop(sv, t);
***************
*** 3574,3580 ****
char hunk[4];
hunk[3] = '\0';
! len = (*s++ - ' ') & 077;
while (len > 0) {
if (s < strend && ISUUCHAR(*s))
a = uudmap[*s++] & 077;
--- 3658,3664 ----
char hunk[4];
hunk[3] = '\0';
! len = uudmap[*s++] & 077;
while (len > 0) {
if (s < strend && ISUUCHAR(*s))
a = uudmap[*s++] & 077;
***************
*** 3676,3683 ****
STATIC SV *
is_an_int(char *s, STRLEN l)
{
SV *result = newSVpv("", l);
! char *result_c = SvPV(result, PL_na); /* convenience */
char *out = result_c;
bool skip = 1;
bool ignore = 0;
--- 3760,3768 ----
STATIC SV *
is_an_int(char *s, STRLEN l)
{
+ STRLEN n_a;
SV *result = newSVpv("", l);
! char *result_c = SvPV(result, n_a); /* convenience */
char *out = result_c;
bool skip = 1;
bool ignore = 0;
***************
*** 3833,3838 ****
--- 3918,3924 ----
sv_catpvn(cat, null10, len);
break;
case 'A':
+ case 'Z':
case 'a':
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
***************
*** 4172,4177 ****
--- 4258,4264 ----
if (fromstr == &PL_sv_undef)
aptr = NULL;
else {
+ STRLEN n_a;
/* XXX better yet, could spirit away the string to
* a safe spot and hang on to it until the result
* of pack() (and all copies of the result) are
***************
*** 4180,4188 ****
if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
warn("Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
! aptr = SvPV(fromstr,PL_na);
else
! aptr = SvPV_force(fromstr,PL_na);
}
sv_catpvn(cat, (char*)&aptr, sizeof(char*));
}
--- 4267,4275 ----
if (PL_dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
warn("Attempt to pack pointer to temporary value");
if (SvPOK(fromstr) || SvNIOK(fromstr))
! aptr = SvPV(fromstr,n_a);
else
! aptr = SvPV_force(fromstr,n_a);
}
sv_catpvn(cat, (char*)&aptr, sizeof(char*));
}
***************
*** 4271,4279 ****
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
! if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) {
PUSHMARK(SP);
! XPUSHs(mg->mg_obj);
}
else {
if (!AvREAL(ary)) {
--- 4358,4366 ----
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
! if (mg = SvTIED_mg((SV*)ary, 'P')) {
PUSHMARK(SP);
! XPUSHs(SvTIED_obj((SV*)ary, mg));
}
else {
if (!AvREAL(ary)) {
***************
*** 4522,4528 ****
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
(unsigned long)thr, (unsigned long)sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- SvREFCNT_inc(sv); /* keep alive until magic_mutexfree */
save_destructor(unlock_condpair, sv);
}
#endif /* USE_THREADS */
--- 4609,4614 ----
diff -c 'perl5.005_02/pp.h' 'perl5.005_03/pp.h'
Index: ./pp.h
*** ./pp.h Thu Jul 23 23:01:59 1998
--- ./pp.h Sat Mar 27 11:56:32 1999
***************
*** 1,6 ****
/* pp.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* pp.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 61,74 ****
#define RETURNX(x) return x, PUTBACK, NORMAL
#define POPs (*sp--)
! #define POPp (SvPVx(POPs, PL_na))
#define POPn (SvNVx(POPs))
#define POPi ((IV)SvIVx(POPs))
#define POPu ((UV)SvUVx(POPs))
#define POPl ((long)SvIVx(POPs))
#define TOPs (*sp)
! #define TOPp (SvPV(TOPs, PL_na))
#define TOPn (SvNV(TOPs))
#define TOPi ((IV)SvIV(TOPs))
#define TOPu ((UV)SvUV(TOPs))
--- 61,76 ----
#define RETURNX(x) return x, PUTBACK, NORMAL
#define POPs (*sp--)
! #define POPp (SvPVx(POPs, PL_na)) /* deprecated */
! #define POPpx (SvPVx(POPs, n_a))
#define POPn (SvNVx(POPs))
#define POPi ((IV)SvIVx(POPs))
#define POPu ((UV)SvUVx(POPs))
#define POPl ((long)SvIVx(POPs))
#define TOPs (*sp)
! #define TOPp (SvPV(TOPs, PL_na)) /* deprecated */
! #define TOPpx (SvPV(TOPs, n_a))
#define TOPn (SvNV(TOPs))
#define TOPi ((IV)SvIV(TOPs))
#define TOPu ((UV)SvUV(TOPs))
diff -c 'perl5.005_02/pp_ctl.c' 'perl5.005_03/pp_ctl.c'
Index: ./pp_ctl.c
*** ./pp_ctl.c Sun Aug 2 00:15:08 1998
--- ./pp_ctl.c Sat Mar 27 11:56:24 1999
***************
*** 1,6 ****
/* pp_ctl.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* pp_ctl.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 529,535 ****
break;
case FF_MORE:
! if (itemsize) {
arg = fieldsize - itemsize;
if (arg) {
fieldsize -= arg;
--- 529,541 ----
break;
case FF_MORE:
! s = chophere;
! send = item + len;
! if (chopspace) {
! while (*s && isSPACE(*s) && s < send)
! s++;
! }
! if (s < send) {
arg = fieldsize - itemsize;
if (arg) {
fieldsize -= arg;
***************
*** 661,666 ****
--- 667,727 ----
}
}
+ #define tryCALL_AMAGICbin(left,right,meth,svp) STMT_START { \
+ *svp = Nullsv; \
+ if (PL_amagic_generation) { \
+ if (SvAMAGIC(left)||SvAMAGIC(right))\
+ *svp = amagic_call(left, \
+ right, \
+ CAT2(meth,_amg), \
+ 0); \
+ } \
+ } STMT_END
+
+ STATIC I32
+ amagic_cmp(register SV *str1, register SV *str2)
+ {
+ SV *tmpsv;
+ tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+ if (tmpsv) {
+ double d;
+
+ if (SvIOK(tmpsv)) {
+ I32 i = SvIVX(tmpsv);
+ if (i > 0)
+ return 1;
+ return i? -1 : 0;
+ }
+ d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
+ return sv_cmp(str1, str2);
+ }
+
+ STATIC I32
+ amagic_cmp_locale(register SV *str1, register SV *str2)
+ {
+ SV *tmpsv;
+ tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
+ if (tmpsv) {
+ double d;
+
+ if (SvIOK(tmpsv)) {
+ I32 i = SvIVX(tmpsv);
+ if (i > 0)
+ return 1;
+ return i? -1 : 0;
+ }
+ d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
+ return sv_cmp_locale(str1, str2);
+ }
+
PP(pp_sort)
{
djSP; dMARK; dORIGMARK;
***************
*** 672,677 ****
--- 733,739 ----
CV *cv;
I32 gimme = GIMME;
OP* nextop = PL_op->op_next;
+ I32 overloading = 0;
if (gimme != G_ARRAY) {
SP = MARK;
***************
*** 724,731 ****
/*SUPPRESS 560*/
if (*up = *++MARK) { /* Weed out nulls. */
SvTEMP_off(*up);
! if (!PL_sortcop && !SvPOK(*up))
! (void)sv_2pv(*up, &PL_na);
up++;
}
}
--- 786,799 ----
/*SUPPRESS 560*/
if (*up = *++MARK) { /* Weed out nulls. */
SvTEMP_off(*up);
! if (!PL_sortcop && !SvPOK(*up)) {
! if (SvAMAGIC(*up))
! overloading = 1;
! else {
! STRLEN n_a;
! (void)sv_2pv(*up, &n_a);
! }
! }
up++;
}
}
***************
*** 772,779 ****
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
qsortsv(ORIGMARK+1, max,
(PL_op->op_private & OPpLOCALE)
! ? FUNC_NAME_TO_PTR(sv_cmp_locale)
! : FUNC_NAME_TO_PTR(sv_cmp));
}
}
LEAVE;
--- 840,851 ----
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
qsortsv(ORIGMARK+1, max,
(PL_op->op_private & OPpLOCALE)
! ? ( overloading
! ? FUNC_NAME_TO_PTR(amagic_cmp_locale)
! : FUNC_NAME_TO_PTR(sv_cmp_locale))
! : ( overloading
! ? FUNC_NAME_TO_PTR(amagic_cmp)
! : FUNC_NAME_TO_PTR(sv_cmp) ));
}
}
LEAVE;
***************
*** 828,849 ****
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
! register I32 i;
register SV *sv;
I32 max;
if (SvNIOKp(left) || !SvPOKp(left) ||
(looks_like_number(left) && *SvPVX(left) != '0') )
{
! if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX)
croak("Range iterator outside integer range");
i = SvIV(left);
max = SvIV(right);
if (max >= i) {
! EXTEND_MORTAL(max - i + 1);
! EXTEND(SP, max - i + 1);
}
! while (i <= max) {
sv = sv_2mortal(newSViv(i++));
PUSHs(sv);
}
--- 900,924 ----
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
! register I32 i, j;
register SV *sv;
I32 max;
if (SvNIOKp(left) || !SvPOKp(left) ||
(looks_like_number(left) && *SvPVX(left) != '0') )
{
! if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
croak("Range iterator outside integer range");
i = SvIV(left);
max = SvIV(right);
if (max >= i) {
! j = max - i + 1;
! EXTEND_MORTAL(j);
! EXTEND(SP, j);
}
! else
! j = 0;
! while (j--) {
sv = sv_2mortal(newSViv(i++));
PUSHs(sv);
}
***************
*** 851,860 ****
else {
SV *final = sv_mortalcopy(right);
STRLEN len;
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
! SvPV_force(sv,PL_na);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
if (strEQ(SvPVX(sv),tmps))
--- 926,936 ----
else {
SV *final = sv_mortalcopy(right);
STRLEN len;
+ STRLEN n_a;
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
! SvPV_force(sv,n_a);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
if (strEQ(SvPVX(sv),tmps))
***************
*** 891,897 ****
for (i = cxstack_ix; i >= 0; i--) {
cx = &cxstack[i];
! switch (cx->cx_type) {
case CXt_SUBST:
if (PL_dowarn)
warn("Exiting substitution via %s", op_name[PL_op->op_type]);
--- 967,973 ----
for (i = cxstack_ix; i >= 0; i--) {
cx = &cxstack[i];
! switch (CxTYPE(cx)) {
case CXt_SUBST:
if (PL_dowarn)
warn("Exiting substitution via %s", op_name[PL_op->op_type]);
***************
*** 968,974 ****
register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstk[i];
! switch (cx->cx_type) {
default:
continue;
case CXt_EVAL:
--- 1044,1050 ----
register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstk[i];
! switch (CxTYPE(cx)) {
default:
continue;
case CXt_EVAL:
***************
*** 988,994 ****
register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
! switch (cx->cx_type) {
default:
continue;
case CXt_EVAL:
--- 1064,1070 ----
register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
! switch (CxTYPE(cx)) {
default:
continue;
case CXt_EVAL:
***************
*** 1007,1013 ****
register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
! switch (cx->cx_type) {
case CXt_SUBST:
if (PL_dowarn)
warn("Exiting substitution via %s", op_name[PL_op->op_type]);
--- 1083,1089 ----
register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
cx = &cxstack[i];
! switch (CxTYPE(cx)) {
case CXt_SUBST:
if (PL_dowarn)
warn("Exiting substitution via %s", op_name[PL_op->op_type]);
***************
*** 1043,1051 ****
while (cxstack_ix > cxix) {
cx = &cxstack[cxstack_ix];
DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
! (long) cxstack_ix, block_type[cx->cx_type]));
/* Note: we don't need to restore the base context info till the end. */
! switch (cx->cx_type) {
case CXt_SUBST:
POPSUBST(cx);
continue; /* not break */
--- 1119,1127 ----
while (cxstack_ix > cxix) {
cx = &cxstack[cxstack_ix];
DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
! (long) cxstack_ix, block_type[CxTYPE(cx)]));
/* Note: we don't need to restore the base context info till the end. */
! switch (CxTYPE(cx)) {
case CXt_SUBST:
POPSUBST(cx);
continue; /* not break */
***************
*** 1069,1074 ****
--- 1145,1151 ----
die_where(char *message)
{
dSP;
+ STRLEN n_a;
if (PL_in_eval) {
I32 cxix;
register PERL_CONTEXT *cx;
***************
*** 1100,1106 ****
sv_setpv(ERRSV, message);
}
else
! message = SvPVx(ERRSV, PL_na);
while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
dounwind(-1);
--- 1177,1183 ----
sv_setpv(ERRSV, message);
}
else
! message = SvPVx(ERRSV, n_a);
while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
dounwind(-1);
***************
*** 1114,1120 ****
dounwind(cxix);
POPBLOCK(cx,PL_curpm);
! if (cx->cx_type != CXt_EVAL) {
PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
my_exit(1);
}
--- 1191,1197 ----
dounwind(cxix);
POPBLOCK(cx,PL_curpm);
! if (CxTYPE(cx) != CXt_EVAL) {
PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
my_exit(1);
}
***************
*** 1127,1138 ****
LEAVE;
if (optype == OP_REQUIRE) {
! char* msg = SvPVx(ERRSV, PL_na);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
}
}
PerlIO_printf(PerlIO_stderr(), "%s",message);
PerlIO_flush(PerlIO_stderr());
my_failure_exit();
--- 1204,1217 ----
LEAVE;
if (optype == OP_REQUIRE) {
! char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
}
}
+ if(!message)
+ message = SvPVx(ERRSV, n_a);
PerlIO_printf(PerlIO_stderr(), "%s",message);
PerlIO_flush(PerlIO_stderr());
my_failure_exit();
***************
*** 1204,1210 ****
}
cx = &ccstack[cxix];
! if (ccstack[cxix].cx_type == CXt_SUB) {
dbcxix = dopoptosub_at(ccstack, cxix - 1);
/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
--- 1283,1289 ----
}
cx = &ccstack[cxix];
! if (CxTYPE(cx) == CXt_SUB) {
dbcxix = dopoptosub_at(ccstack, cxix - 1);
/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
***************
*** 1233,1239 ****
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
if (!MAXARG)
RETURN;
! if (cx->cx_type == CXt_SUB) { /* So is ccstack[dbcxix]. */
sv = NEWSV(49, 0);
gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
PUSHs(sv_2mortal(sv));
--- 1312,1318 ----
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
if (!MAXARG)
RETURN;
! if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */
sv = NEWSV(49, 0);
gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
PUSHs(sv_2mortal(sv));
***************
*** 1248,1254 ****
PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
! if (cx->cx_type == CXt_EVAL) {
if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
PUSHs(cx->blk_eval.cur_text);
PUSHs(&PL_sv_no);
--- 1327,1333 ----
PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
! if (CxTYPE(cx) == CXt_EVAL) {
if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
PUSHs(cx->blk_eval.cur_text);
PUSHs(&PL_sv_no);
***************
*** 1259,1265 ****
PUSHs(&PL_sv_yes);
}
}
! else if (cx->cx_type == CXt_SUB &&
cx->blk_sub.hasargs &&
PL_curcop->cop_stash == PL_debstash)
{
--- 1338,1344 ----
PUSHs(&PL_sv_yes);
}
}
! else if (CxTYPE(cx) == CXt_SUB &&
cx->blk_sub.hasargs &&
PL_curcop->cop_stash == PL_debstash)
{
***************
*** 1310,1320 ****
{
djSP;
char *tmps;
if (MAXARG < 1)
tmps = "";
else
! tmps = POPp;
sv_reset(tmps, PL_curcop->cop_stash);
PUSHs(&PL_sv_yes);
RETURN;
--- 1389,1400 ----
{
djSP;
char *tmps;
+ STRLEN n_a;
if (MAXARG < 1)
tmps = "";
else
! tmps = POPpx;
sv_reset(tmps, PL_curcop->cop_stash);
PUSHs(&PL_sv_yes);
RETURN;
***************
*** 1387,1394 ****
SAVETMPS;
#ifdef USE_THREADS
! if (PL_op->op_flags & OPf_SPECIAL)
! svp = save_threadsv(PL_op->op_targ); /* per-thread variable */
else
#endif /* USE_THREADS */
if (PL_op->op_targ) {
--- 1467,1478 ----
SAVETMPS;
#ifdef USE_THREADS
! if (PL_op->op_flags & OPf_SPECIAL) {
! dTHR;
! svp = &THREADSV(PL_op->op_targ); /* per-thread variable */
! SAVEGENERICSV(*svp);
! *svp = NEWSV(0,0);
! }
else
#endif /* USE_THREADS */
if (PL_op->op_targ) {
***************
*** 1396,1404 ****
SAVESPTR(*svp);
}
else {
! GV *gv = (GV*)POPs;
! (void)save_scalar(gv);
! svp = &GvSV(gv); /* symbol table variable */
}
ENTER;
--- 1480,1488 ----
SAVESPTR(*svp);
}
else {
! svp = &GvSV((GV*)POPs); /* symbol table variable */
! SAVEGENERICSV(*svp);
! *svp = NEWSV(0,0);
}
ENTER;
***************
*** 1516,1522 ****
dounwind(cxix);
POPBLOCK(cx,newpm);
! switch (cx->cx_type) {
case CXt_SUB:
POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */
popsub2 = TRUE;
--- 1600,1606 ----
dounwind(cxix);
POPBLOCK(cx,newpm);
! switch (CxTYPE(cx)) {
case CXt_SUB:
POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */
popsub2 = TRUE;
***************
*** 1604,1610 ****
dounwind(cxix);
POPBLOCK(cx,newpm);
! switch (cx->cx_type) {
case CXt_LOOP:
POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */
pop2 = CXt_LOOP;
--- 1688,1694 ----
dounwind(cxix);
POPBLOCK(cx,newpm);
! switch (CxTYPE(cx)) {
case CXt_LOOP:
POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */
pop2 = CXt_LOOP;
***************
*** 1770,1775 ****
--- 1854,1860 ----
label = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *sv = POPs;
+ STRLEN n_a;
/* This egregious kludge implements goto &subroutine */
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
***************
*** 1779,1789 ****
SV** mark;
I32 items = 0;
I32 oldsave;
if (!CvROOT(cv) && !CvXSUB(cv)) {
! if (CvGV(cv)) {
! SV *tmpstr = sv_newmortal();
! gv_efullname3(tmpstr, CvGV(cv), Nullch);
DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
}
DIE("Goto undefined subroutine");
--- 1864,1886 ----
SV** mark;
I32 items = 0;
I32 oldsave;
+ int arg_was_real = 0;
+ retry:
if (!CvROOT(cv) && !CvXSUB(cv)) {
! GV *gv = CvGV(cv);
! GV *autogv;
! if (gv) {
! SV *tmpstr;
! /* autoloaded stub? */
! if (cv != GvCV(gv) && (cv = GvCV(gv)))
! goto retry;
! autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv),
! GvNAMELEN(gv), FALSE);
! if (autogv && (cv = GvCV(autogv)))
! goto retry;
! tmpstr = sv_newmortal();
! gv_efullname3(tmpstr, gv, Nullch);
DIE("Goto undefined subroutine &%s",SvPVX(tmpstr));
}
DIE("Goto undefined subroutine");
***************
*** 1796,1805 ****
if (cxix < cxstack_ix)
dounwind(cxix);
TOPBLOCK(cx);
! if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
DIE("Can't goto subroutine from an eval-string");
mark = PL_stack_sp;
! if (cx->cx_type == CXt_SUB &&
cx->blk_sub.hasargs) { /* put @_ back onto stack */
AV* av = cx->blk_sub.argarray;
--- 1893,1902 ----
if (cxix < cxstack_ix)
dounwind(cxix);
TOPBLOCK(cx);
! if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
DIE("Can't goto subroutine from an eval-string");
mark = PL_stack_sp;
! if (CxTYPE(cx) == CXt_SUB &&
cx->blk_sub.hasargs) { /* put @_ back onto stack */
AV* av = cx->blk_sub.argarray;
***************
*** 1812,1818 ****
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
#endif /* USE_THREADS */
! AvREAL_off(av);
av_clear(av);
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
--- 1909,1918 ----
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
#endif /* USE_THREADS */
! if (AvREAL(av)) {
! arg_was_real = 1;
! AvREAL_off(av); /* so av_clear() won't clobber elts */
! }
av_clear(av);
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
***************
*** 1829,1835 ****
Copy(AvARRAY(av), PL_stack_sp, items, SV*);
PL_stack_sp += items;
}
! if (cx->cx_type == CXt_SUB &&
!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
SvREFCNT_dec(cx->blk_sub.cv);
oldsave = PL_scopestack[PL_scopestack_ix - 1];
--- 1929,1935 ----
Copy(AvARRAY(av), PL_stack_sp, items, SV*);
PL_stack_sp += items;
}
! if (CxTYPE(cx) == CXt_SUB &&
!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
SvREFCNT_dec(cx->blk_sub.cv);
oldsave = PL_scopestack[PL_scopestack_ix - 1];
***************
*** 1868,1874 ****
else {
AV* padlist = CvPADLIST(cv);
SV** svp = AvARRAY(padlist);
! if (cx->cx_type == CXt_EVAL) {
PL_in_eval = cx->blk_eval.old_in_eval;
PL_eval_root = cx->blk_eval.old_eval_root;
cx->cx_type = CXt_SUB;
--- 1968,1974 ----
else {
AV* padlist = CvPADLIST(cv);
SV** svp = AvARRAY(padlist);
! if (CxTYPE(cx) == CXt_EVAL) {
PL_in_eval = cx->blk_eval.old_in_eval;
PL_eval_root = cx->blk_eval.old_eval_root;
cx->cx_type = CXt_SUB;
***************
*** 1968,1974 ****
}
Copy(mark,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;
!
while (items--) {
if (*mark)
SvTEMP_off(*mark);
--- 2068,2078 ----
}
Copy(mark,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;
! /* preserve @_ nature */
! if (arg_was_real) {
! AvREIFY_off(av);
! AvREAL_on(av);
! }
while (items--) {
if (*mark)
SvTEMP_off(*mark);
***************
*** 2000,2006 ****
}
}
else
! label = SvPV(sv,PL_na);
}
else if (PL_op->op_flags & OPf_SPECIAL) {
if (! do_dump)
--- 2104,2110 ----
}
}
else
! label = SvPV(sv,n_a);
}
else if (PL_op->op_flags & OPf_SPECIAL) {
if (! do_dump)
***************
*** 2018,2024 ****
*enterops = 0;
for (ix = cxstack_ix; ix >= 0; ix--) {
cx = &cxstack[ix];
! switch (cx->cx_type) {
case CXt_EVAL:
gotoprobe = PL_eval_root; /* XXX not good for nested eval */
break;
--- 2122,2128 ----
*enterops = 0;
for (ix = cxstack_ix; ix >= 0; ix--) {
cx = &cxstack[ix];
! switch (CxTYPE(cx)) {
case CXt_EVAL:
gotoprobe = PL_eval_root; /* XXX not good for nested eval */
break;
***************
*** 2099,2109 ****
PL_do_undump = FALSE;
}
- if (PL_top_env->je_prev) {
- PL_restartop = retop;
- JMPENV_JUMP(3);
- }
-
RETURNOP(retop);
}
--- 2203,2208 ----
***************
*** 2154,2160 ****
if (PL_multiline)
PL_op = PL_op->op_next; /* can't assume anything */
else {
! match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255;
match -= cCOP->uop.scop.scop_offset;
if (match < 0)
match = 0;
--- 2253,2260 ----
if (PL_multiline)
PL_op = PL_op->op_next; /* can't assume anything */
else {
! STRLEN n_a;
! match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255;
match -= cCOP->uop.scop.scop_offset;
if (match < 0)
match = 0;
***************
*** 2208,2222 ****
JMPENV_PUSH(ret);
switch (ret) {
default: /* topmost level handles it */
JMPENV_POP;
PL_op = oldop;
JMPENV_JUMP(ret);
/* NOTREACHED */
case 3:
! if (!PL_restartop) {
! PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
! break;
! }
PL_op = PL_restartop;
PL_restartop = 0;
/* FALL THROUGH */
--- 2308,2321 ----
JMPENV_PUSH(ret);
switch (ret) {
default: /* topmost level handles it */
+ pass_the_buck:
JMPENV_POP;
PL_op = oldop;
JMPENV_JUMP(ret);
/* NOTREACHED */
case 3:
! if (!PL_restartop)
! goto pass_the_buck;
PL_op = PL_restartop;
PL_restartop = 0;
/* FALL THROUGH */
***************
*** 2320,2330 ****
SAVEI32(PL_max_intro_pending);
caller = PL_compcv;
! for (i = cxstack_ix; i >= 0; i--) {
PERL_CONTEXT *cx = &cxstack[i];
! if (cx->cx_type == CXt_EVAL)
break;
! else if (cx->cx_type == CXt_SUB) {
caller = cx->blk_sub.cv;
break;
}
--- 2419,2429 ----
SAVEI32(PL_max_intro_pending);
caller = PL_compcv;
! for (i = cxstack_ix - 1; i >= 0; i--) {
PERL_CONTEXT *cx = &cxstack[i];
! if (CxTYPE(cx) == CXt_EVAL)
break;
! else if (CxTYPE(cx) == CXt_SUB) {
caller = cx->blk_sub.cv;
break;
}
***************
*** 2333,2339 ****
SAVESPTR(PL_compcv);
PL_compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)PL_compcv, SVt_PVCV);
! CvUNIQUE_on(PL_compcv);
#ifdef USE_THREADS
CvOWNER(PL_compcv) = 0;
New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
--- 2432,2438 ----
SAVESPTR(PL_compcv);
PL_compcv = (CV*)NEWSV(1104,0);
sv_upgrade((SV *)PL_compcv, SVt_PVCV);
! CvEVAL_on(PL_compcv);
#ifdef USE_THREADS
CvOWNER(PL_compcv) = 0;
New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
***************
*** 2392,2397 ****
--- 2491,2497 ----
I32 gimme;
PERL_CONTEXT *cx;
I32 optype = 0; /* Might be reset by POPEVAL. */
+ STRLEN n_a;
PL_op = saveop;
if (PL_eval_root) {
***************
*** 2407,2416 ****
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
! char* msg = SvPVx(ERRSV, PL_na);
DIE("%s", *msg ? msg : "Compilation failed in require");
} else if (startop) {
! char* msg = SvPVx(ERRSV, PL_na);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
--- 2507,2516 ----
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
! char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
} else if (startop) {
! char* msg = SvPVx(ERRSV, n_a);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
***************
*** 2483,2495 ****
SV** svp;
I32 gimme = G_SCALAR;
PerlIO *tryrsfp = 0;
sv = POPs;
if (SvNIOKp(sv) && !SvPOKp(sv)) {
SET_NUMERIC_STANDARD();
if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
DIE("Perl %s required--this is only version %s, stopped",
! SvPV(sv,PL_na),PL_patchlevel);
RETPUSHYES;
}
name = SvPV(sv, len);
--- 2583,2596 ----
SV** svp;
I32 gimme = G_SCALAR;
PerlIO *tryrsfp = 0;
+ STRLEN n_a;
sv = POPs;
if (SvNIOKp(sv) && !SvPOKp(sv)) {
SET_NUMERIC_STANDARD();
if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
DIE("Perl %s required--this is only version %s, stopped",
! SvPV(sv,n_a),PL_patchlevel);
RETPUSHYES;
}
name = SvPV(sv, len);
***************
*** 2532,2538 ****
{
namesv = NEWSV(806, 0);
for (i = 0; i <= AvFILL(ar); i++) {
! char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
#ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
--- 2633,2639 ----
{
namesv = NEWSV(806, 0);
for (i = 0; i <= AvFILL(ar); i++) {
! char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
#ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
***************
*** 2542,2547 ****
--- 2643,2649 ----
#else
sv_setpvf(namesv, "%s/%s", dir, name);
#endif
+ TAINT_PROPER("require");
tryname = SvPVX(namesv);
tryrsfp = PerlIO_open(tryname, PERL_SCRIPT_MODE);
if (tryrsfp) {
***************
*** 2567,2573 ****
sv_catpv(msg, " (did you run h2ph?)");
sv_catpv(msg, " (@INC contains:");
for (i = 0; i <= AvFILL(ar); i++) {
! char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
sv_setpvf(dirmsgsv, " %s", dir);
sv_catsv(msg, dirmsgsv);
}
--- 2669,2675 ----
sv_catpv(msg, " (did you run h2ph?)");
sv_catpv(msg, " (@INC contains:");
for (i = 0; i <= AvFILL(ar); i++) {
! char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
sv_setpvf(dirmsgsv, " %s", dir);
sv_catsv(msg, dirmsgsv);
}
***************
*** 2578,2583 ****
--- 2680,2687 ----
RETPUSHUNDEF;
}
+ else
+ SETERRNO(0, SS$_NORMAL);
/* Assume success here to prevent recursive requirement. */
(void)hv_store(GvHVn(PL_incgv), name, strlen(name),
***************
*** 2586,2595 ****
ENTER;
SAVETMPS;
lex_start(sv_2mortal(newSVpv("",0)));
! if (PL_rsfp_filters){
! save_aptr(&PL_rsfp_filters);
! PL_rsfp_filters = NULL;
! }
PL_rsfp = tryrsfp;
name = savepv(name);
--- 2690,2697 ----
ENTER;
SAVETMPS;
lex_start(sv_2mortal(newSVpv("",0)));
! SAVEGENERICSV(PL_rsfp_filters);
! PL_rsfp_filters = Nullav;
PL_rsfp = tryrsfp;
name = savepv(name);
***************
*** 2603,2608 ****
--- 2705,2711 ----
PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, name, PL_compiling.cop_filegv);
+ SAVEI16(PL_compiling.cop_line);
PL_compiling.cop_line = 0;
PUTBACK;
***************
*** 2658,2664 ****
PL_hints = PL_op->op_targ;
push_return(PL_op->op_next);
! PUSHBLOCK(cx, CXt_EVAL, SP);
PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
/* prepare to compile string */
--- 2761,2767 ----
PL_hints = PL_op->op_targ;
push_return(PL_op->op_next);
! PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
/* prepare to compile string */
diff -c 'perl5.005_02/pp_hot.c' 'perl5.005_03/pp_hot.c'
Index: ./pp_hot.c
*** ./pp_hot.c Sun Aug 2 01:08:11 1998
--- ./pp_hot.c Sat Mar 27 18:12:49 1999
***************
*** 1,6 ****
/* pp_hot.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* pp_hot.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 304,315 ****
IO *io;
register PerlIO *fp;
MAGIC *mg;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
! if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
if (MARK == ORIGMARK) {
/* If using default handle then we need to make space to
* pass object as 1st arg, so move other args up ...
--- 304,316 ----
IO *io;
register PerlIO *fp;
MAGIC *mg;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
! if (mg = SvTIED_mg((SV*)gv, 'q')) {
if (MARK == ORIGMARK) {
/* If using default handle then we need to make space to
* pass object as 1st arg, so move other args up ...
***************
*** 320,326 ****
++SP;
}
PUSHMARK(MARK - 1);
! *MARK = mg->mg_obj;
PUTBACK;
ENTER;
perl_call_method("PRINT", G_SCALAR);
--- 321,327 ----
++SP;
}
PUSHMARK(MARK - 1);
! *MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
perl_call_method("PRINT", G_SCALAR);
***************
*** 335,341 ****
if (PL_dowarn) {
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
! warn("Filehandle %s never opened", SvPV(sv,PL_na));
}
SETERRNO(EBADF,RMS$_IFI);
--- 336,342 ----
if (PL_dowarn) {
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
! warn("Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
***************
*** 346,354 ****
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
! warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
else
! warn("print on closed filehandle %s", SvPV(sv,PL_na));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
--- 347,355 ----
SV* sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
! warn("Filehandle %s opened only for input", SvPV(sv,n_a));
else
! warn("print on closed filehandle %s", SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
***************
*** 425,430 ****
--- 426,432 ----
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
***************
*** 441,447 ****
RETURN;
RETPUSHUNDEF;
}
! sym = SvPV(sv,PL_na);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "an ARRAY");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
--- 443,449 ----
RETURN;
RETPUSHUNDEF;
}
! sym = SvPV(sv,n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "an ARRAY");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
***************
*** 509,514 ****
--- 511,517 ----
if (SvTYPE(sv) != SVt_PVGV) {
char *sym;
+ STRLEN n_a;
if (SvGMAGICAL(sv)) {
mg_get(sv);
***************
*** 527,533 ****
}
RETSETUNDEF;
}
! sym = SvPV(sv,PL_na);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a HASH");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
--- 530,536 ----
}
RETSETUNDEF;
}
! sym = SvPV(sv,n_a);
if (PL_op->op_private & HINT_STRICT_REFS)
DIE(no_symref, sym, "a HASH");
gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
***************
*** 859,867 ****
}
}
}
! safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
! && !PL_sawampersand);
! safebase = safebase ? 0 : REXEC_COPY_STR ;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
--- 862,870 ----
}
}
}
! safebase = ((gimme != G_ARRAY && !global && rx->nparens)
! || SvTEMP(TARG) || PL_sawampersand)
! ? REXEC_COPY_STR : 0;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
***************
*** 1048,1056 ****
I32 gimme = GIMME_V;
MAGIC *mg;
! if (SvRMAGICAL(PL_last_in_gv) && (mg = mg_find((SV*)PL_last_in_gv, 'q'))) {
PUSHMARK(SP);
! XPUSHs(mg->mg_obj);
PUTBACK;
ENTER;
perl_call_method("READLINE", gimme);
--- 1051,1059 ----
I32 gimme = GIMME_V;
MAGIC *mg;
! if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
PUSHMARK(SP);
! XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
PUTBACK;
ENTER;
perl_call_method("READLINE", gimme);
***************
*** 1239,1246 ****
sv = sv_2mortal(NEWSV(57, 80));
offset = 0;
}
for (;;) {
! if (!sv_gets(sv, fp, offset)) {
PerlIO_clearerr(fp);
if (IoFLAGS(io) & IOf_ARGV) {
fp = nextargv(PL_last_in_gv);
--- 1242,1259 ----
sv = sv_2mortal(NEWSV(57, 80));
offset = 0;
}
+
+ /* flip-flop EOF state for a snarfed empty file */
+ #define SNARF_EOF(gimme,rs,io,sv) \
+ ((gimme != G_SCALAR || SvCUR(sv) \
+ || (IoFLAGS(io) & IOf_NOLINE) || IoLINES(io) || !RsSNARF(rs)) \
+ ? ((IoFLAGS(io) &= ~IOf_NOLINE), TRUE) \
+ : ((IoFLAGS(io) |= IOf_NOLINE), FALSE))
+
for (;;) {
! if (!sv_gets(sv, fp, offset)
! && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv)))
! {
PerlIO_clearerr(fp);
if (IoFLAGS(io) & IOf_ARGV) {
fp = nextargv(PL_last_in_gv);
***************
*** 1250,1257 ****
IoFLAGS(io) |= IOf_START;
}
else if (type == OP_GLOB) {
! if (!do_close(PL_last_in_gv, FALSE))
! warn("internal error: glob failed");
}
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
--- 1263,1273 ----
IoFLAGS(io) |= IOf_START;
}
else if (type == OP_GLOB) {
! if (!do_close(PL_last_in_gv, FALSE)) {
! warn("glob failed (child exited with status %d%s)",
! STATUS_CURRENT >> 8,
! (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
! }
}
if (gimme == G_SCALAR) {
(void)SvOK_off(TARG);
***************
*** 1354,1361 ****
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
SV* key2;
! if (!defer)
! DIE(no_helem, SvPV(keysv, PL_na));
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
--- 1370,1379 ----
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
SV* key2;
! if (!defer) {
! STRLEN n_a;
! DIE(no_helem, SvPV(keysv, n_a));
! }
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
***************
*** 1453,1459 ****
EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
! if (cx->cx_type != CXt_LOOP)
DIE("panic: pp_iter");
av = cx->blk_loop.iterary;
--- 1471,1477 ----
EXTEND(SP, 1);
cx = &cxstack[cxstack_ix];
! if (CxTYPE(cx) != CXt_LOOP)
DIE("panic: pp_iter");
av = cx->blk_loop.iterary;
***************
*** 1614,1620 ****
&& SvTYPE(rx->check_substr) == SVt_PVBM
&& SvVALID(rx->check_substr))
? TARG : Nullsv);
! safebase = (!rx->nparens && !PL_sawampersand) ? 0 : REXEC_COPY_STR;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
--- 1632,1639 ----
&& SvTYPE(rx->check_substr) == SVt_PVBM
&& SvVALID(rx->check_substr))
? TARG : Nullsv);
! safebase = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
! ? REXEC_COPY_STR : 0;
if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
SAVEINT(PL_multiline);
PL_multiline = pm->op_pmflags & PMf_MULTILINE;
***************
*** 1980,1985 ****
--- 1999,2005 ----
default:
if (!SvROK(sv)) {
char *sym;
+ STRLEN n_a;
if (sv == &PL_sv_yes) { /* unfound import, ignore */
if (hasargs)
***************
*** 1991,1997 ****
sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
}
else
! sym = SvPV(sv, PL_na);
if (!sym)
DIE(no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
--- 2011,2017 ----
sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
}
else
! sym = SvPV(sv, n_a);
if (!sym)
DIE(no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
***************
*** 2094,2100 ****
DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n",
thr, sv);)
MUTEX_UNLOCK(MgMUTEXP(mg));
- SvREFCNT_inc(sv); /* Keep alive until magic_mutexfree */
save_destructor(unlock_condpair, sv);
}
MUTEX_LOCK(CvMUTEXP(cv));
--- 2114,2119 ----
***************
*** 2129,2136 ****
* (3) instead of (2) so we'd have to clone. Would the fact
* that we released the mutex more quickly make up for this?
*/
! if (PL_threadnum &&
! (svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
{
/* We already have a clone to use */
MUTEX_UNLOCK(CvMUTEXP(cv));
--- 2148,2154 ----
* (3) instead of (2) so we'd have to clone. Would the fact
* that we released the mutex more quickly make up for this?
*/
! if ((svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE)))
{
/* We already have a clone to use */
MUTEX_UNLOCK(CvMUTEXP(cv));
***************
*** 2257,2268 ****
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
CvDEPTH(cv)++;
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
- if (CvDEPTH(cv) == 100 && PL_dowarn
- && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
- sub_crush_depth(cv);
if (CvDEPTH(cv) > AvFILLp(padlist)) {
AV *av;
AV *newpad = newAV();
--- 2275,2288 ----
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
CvDEPTH(cv)++;
+ /* XXX This would be a natural place to set C<PL_compcv = cv> so
+ * that eval'' ops within this sub know the correct lexical space.
+ * Owing the speed considerations, we choose to search for the cv
+ * in doeval() instead.
+ */
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
else { /* save temporaries on recursion? */
if (CvDEPTH(cv) > AvFILLp(padlist)) {
AV *av;
AV *newpad = newAV();
***************
*** 2362,2367 ****
--- 2382,2394 ----
MARK++;
}
}
+ /* warning must come *after* we fully set up the context
+ * stuff so that __WARN__ handlers can safely dounwind()
+ * if they want to
+ */
+ if (CvDEPTH(cv) == 100 && PL_dowarn
+ && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
+ sub_crush_depth(cv);
#if 0
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p entersub returning %p\n", thr, CvSTART(cv)));
***************
*** 2474,2480 ****
}
}
! name = SvPV(TOPs, PL_na);
sv = *(PL_stack_base + TOPMARK + 1);
if (SvGMAGICAL(sv))
--- 2501,2507 ----
}
}
! name = SvPV(TOPs, packlen);
sv = *(PL_stack_base + TOPMARK + 1);
if (SvGMAGICAL(sv))
diff -c 'perl5.005_02/pp_sys.c' 'perl5.005_03/pp_sys.c'
Index: ./pp_sys.c
*** ./pp_sys.c Sun Aug 2 00:15:08 1998
--- ./pp_sys.c Sat Mar 27 11:56:16 1999
***************
*** 1,6 ****
/* pp_sys.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* pp_sys.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 56,62 ****
/* XXX Configure test needed.
h_errno might not be a simple 'int', especially for multi-threaded
! applications. HOST_NOT_FOUND is typically defined in <netdb.h>.
*/
#if defined(HOST_NOT_FOUND) && !defined(h_errno)
extern int h_errno;
--- 56,65 ----
/* XXX Configure test needed.
h_errno might not be a simple 'int', especially for multi-threaded
! applications, see "extern int errno in perl.h". Creating such
! a test requires taking into account the differences between
! compiling multithreaded and singlethreaded ($ccflags et al).
! HOST_NOT_FOUND is typically defined in <netdb.h>.
*/
#if defined(HOST_NOT_FOUND) && !defined(h_errno)
extern int h_errno;
***************
*** 187,193 ****
{
djSP; dTARGET;
PerlIO *fp;
! char *tmps = POPp;
I32 gimme = GIMME_V;
TAINT_PROPER("``");
--- 190,197 ----
{
djSP; dTARGET;
PerlIO *fp;
! STRLEN n_a;
! char *tmps = POPpx;
I32 gimme = GIMME_V;
TAINT_PROPER("``");
***************
*** 271,277 ****
#if 0 /* XXX never used! */
PP(pp_indread)
{
! PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), PL_na), TRUE,SVt_PVIO);
return do_readline();
}
#endif
--- 275,282 ----
#if 0 /* XXX never used! */
PP(pp_indread)
{
! STRLEN n_a;
! PL_last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*PL_stack_sp--)), n_a), TRUE,SVt_PVIO);
return do_readline();
}
#endif
***************
*** 286,306 ****
{
djSP; dMARK;
char *tmps;
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
! tmps = SvPV(TARG, PL_na);
SP = MARK + 1;
}
else {
! tmps = SvPV(TOPs, PL_na);
}
if (!tmps || !*tmps) {
SV *error = ERRSV;
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
! tmps = SvPV(error, PL_na);
}
if (!tmps || !*tmps)
tmps = "Warning: something's wrong";
--- 291,312 ----
{
djSP; dMARK;
char *tmps;
+ STRLEN n_a;
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
! tmps = SvPV(TARG, n_a);
SP = MARK + 1;
}
else {
! tmps = SvPV(TOPs, n_a);
}
if (!tmps || !*tmps) {
SV *error = ERRSV;
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
! tmps = SvPV(error, n_a);
}
if (!tmps || !*tmps)
tmps = "Warning: something's wrong";
***************
*** 314,328 ****
char *tmps;
SV *tmpsv = Nullsv;
char *pat = "%s";
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
! tmps = SvPV(TARG, PL_na);
SP = MARK + 1;
}
else {
tmpsv = TOPs;
! tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, PL_na);
}
if (!tmps || !*tmps) {
SV *error = ERRSV;
--- 320,335 ----
char *tmps;
SV *tmpsv = Nullsv;
char *pat = "%s";
+ STRLEN n_a;
if (SP - MARK != 1) {
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
! tmps = SvPV(TARG, n_a);
SP = MARK + 1;
}
else {
tmpsv = TOPs;
! tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, n_a);
}
if (!tmps || !*tmps) {
SV *error = ERRSV;
***************
*** 352,358 ****
else {
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
! tmps = SvPV(error, PL_na);
}
}
if (!tmps || !*tmps)
--- 359,365 ----
else {
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
! tmps = SvPV(error, n_a);
}
}
if (!tmps || !*tmps)
***************
*** 402,410 ****
else
gv = (GV*)POPs;
! if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
PUSHMARK(SP);
! XPUSHs(mg->mg_obj);
PUTBACK;
ENTER;
perl_call_method("CLOSE", G_SCALAR);
--- 409,417 ----
else
gv = (GV*)POPs;
! if (mg = SvTIED_mg((SV*)gv, 'q')) {
PUSHMARK(SP);
! XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
perl_call_method("CLOSE", G_SCALAR);
***************
*** 459,465 ****
else PerlLIO_close(fd[1]);
goto badexit;
}
!
RETPUSHYES;
badexit:
--- 466,475 ----
else PerlLIO_close(fd[1]);
goto badexit;
}
! #if defined(HAS_FCNTL) && defined(F_SETFD)
! fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */
! fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */
! #endif
RETPUSHYES;
badexit:
***************
*** 579,586 ****
*/
stash = gv_stashsv(*MARK, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
DIE("Can't locate object method \"%s\" via package \"%s\"",
! methname, SvPV(*MARK,PL_na));
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
--- 589,597 ----
*/
stash = gv_stashsv(*MARK, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
+ STRLEN n_a;
DIE("Can't locate object method \"%s\" via package \"%s\"",
! methname, SvPV(*MARK,n_a));
}
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
***************
*** 596,603 ****
sv = TOPs;
POPSTACK;
if (sv_isobject(sv)) {
! sv_unmagic(varsv, how);
! sv_magic(varsv, sv, how, Nullch, 0);
}
LEAVE;
SP = PL_stack_base + markoff;
--- 607,614 ----
sv = TOPs;
POPSTACK;
if (sv_isobject(sv)) {
! sv_unmagic(varsv, how);
! sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
}
LEAVE;
SP = PL_stack_base + markoff;
***************
*** 608,655 ****
PP(pp_untie)
{
djSP;
! SV * sv ;
!
! sv = POPs;
if (PL_dowarn) {
! MAGIC * mg ;
! if (SvMAGICAL(sv)) {
! if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
! mg = mg_find(sv, 'P') ;
! else
! mg = mg_find(sv, 'q') ;
!
! if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)
warn("untie attempted while %lu inner references still exist",
(unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
}
}
! if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
! sv_unmagic(sv, 'P');
! else
! sv_unmagic(sv, 'q');
RETPUSHYES;
}
PP(pp_tied)
{
djSP;
! SV * sv ;
! MAGIC * mg ;
! sv = POPs;
! if (SvMAGICAL(sv)) {
! if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
! mg = mg_find(sv, 'P') ;
! else
! mg = mg_find(sv, 'q') ;
!
! if (mg) {
! PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ;
! RETURN ;
! }
}
RETPUSHUNDEF;
}
--- 619,653 ----
PP(pp_untie)
{
djSP;
! SV *sv = POPs;
! char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
if (PL_dowarn) {
! MAGIC *mg;
! if (mg = SvTIED_mg(sv, how)) {
! if (mg->mg_obj && SvREFCNT(SvRV(mg->mg_obj)) > 1)
warn("untie attempted while %lu inner references still exist",
(unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
}
}
! sv_unmagic(sv, how);
RETPUSHYES;
}
PP(pp_tied)
{
djSP;
! SV *sv = POPs;
! char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
! MAGIC *mg;
! if (mg = SvTIED_mg(sv, how)) {
! SV *osv = SvTIED_obj(sv, mg);
! if (osv == mg->mg_obj)
! osv = sv_mortalcopy(osv);
! PUSHs(osv);
! RETURN;
}
RETPUSHUNDEF;
}
***************
*** 731,736 ****
--- 729,735 ----
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
+ STRLEN n_a;
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
***************
*** 753,764 ****
maxlen = j;
}
#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
! /* XXX Configure test needed. */
! #if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun)
! growsize = sizeof(fd_set);
#else
! growsize = maxlen; /* little endians can use vecs directly */
#endif
#else
#ifdef NFDBITS
--- 752,768 ----
maxlen = j;
}
+ /* little endians can use vecs directly */
#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
! # if SELECT_MIN_BITS > 1
! /* If SELECT_MIN_BITS is greater than one we most probably will want
! * to align the sizes with SELECT_MIN_BITS/8 because for example
! * in many little-endian (Intel, Alpha) systems (Linux, OS/2, Digital
! * UNIX, Solaris, NeXT) the smallest quantum select() operates on
! * (sets bit) is 32 bits. */
! growsize = maxlen + (SELECT_MIN_BITS/8 - (maxlen % (SELECT_MIN_BITS/8)));
#else
! growsize = sizeof(fd_set);
#endif
#else
#ifdef NFDBITS
***************
*** 794,800 ****
continue;
}
else if (!SvPOK(sv))
! SvPV_force(sv,PL_na); /* force string conversion */
j = SvLEN(sv);
if (j < growsize) {
Sv_Grow(sv, growsize);
--- 798,804 ----
continue;
}
else if (!SvPOK(sv))
! SvPV_force(sv,n_a); /* force string conversion */
j = SvLEN(sv);
if (j < growsize) {
Sv_Grow(sv, growsize);
***************
*** 909,918 ****
if (!gv)
gv = PL_argvgv;
! if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
I32 gimme = GIMME_V;
PUSHMARK(SP);
! XPUSHs(mg->mg_obj);
PUTBACK;
ENTER;
perl_call_method("GETC", gimme);
--- 913,922 ----
if (!gv)
gv = PL_argvgv;
! if (mg = SvTIED_mg((SV*)gv, 'q')) {
I32 gimme = GIMME_V;
PUSHMARK(SP);
! XPUSHs(SvTIED_obj((SV*)gv, mg));
PUTBACK;
ENTER;
perl_call_method("GETC", gimme);
***************
*** 1121,1133 ****
PerlIO *fp;
SV *sv;
MAGIC *mg;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
! if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
if (MARK == ORIGMARK) {
MEXTEND(SP, 1);
++MARK;
--- 1125,1138 ----
PerlIO *fp;
SV *sv;
MAGIC *mg;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED)
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
! if (mg = SvTIED_mg((SV*)gv, 'q')) {
if (MARK == ORIGMARK) {
MEXTEND(SP, 1);
++MARK;
***************
*** 1135,1141 ****
++SP;
}
PUSHMARK(MARK - 1);
! *MARK = mg->mg_obj;
PUTBACK;
ENTER;
perl_call_method("PRINTF", G_SCALAR);
--- 1140,1146 ----
++SP;
}
PUSHMARK(MARK - 1);
! *MARK = SvTIED_obj((SV*)gv, mg);
PUTBACK;
ENTER;
perl_call_method("PRINTF", G_SCALAR);
***************
*** 1151,1157 ****
if (!(io = GvIO(gv))) {
if (PL_dowarn) {
gv_fullname3(sv, gv, Nullch);
! warn("Filehandle %s never opened", SvPV(sv,PL_na));
}
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
--- 1156,1162 ----
if (!(io = GvIO(gv))) {
if (PL_dowarn) {
gv_fullname3(sv, gv, Nullch);
! warn("Filehandle %s never opened", SvPV(sv,n_a));
}
SETERRNO(EBADF,RMS$_IFI);
goto just_say_no;
***************
*** 1160,1168 ****
if (PL_dowarn) {
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
! warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
else
! warn("printf on closed filehandle %s", SvPV(sv,PL_na));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
--- 1165,1173 ----
if (PL_dowarn) {
gv_fullname3(sv, gv, Nullch);
if (IoIFP(io))
! warn("Filehandle %s opened only for input", SvPV(sv,n_a));
else
! warn("printf on closed filehandle %s", SvPV(sv,n_a));
}
SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
goto just_say_no;
***************
*** 1237,1248 ****
gv = (GV*)*++MARK;
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
! SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
{
SV *sv;
PUSHMARK(MARK-1);
! *MARK = mg->mg_obj;
ENTER;
perl_call_method("READ", G_SCALAR);
LEAVE;
--- 1242,1253 ----
gv = (GV*)*++MARK;
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
! (mg = SvTIED_mg((SV*)gv, 'q')))
{
SV *sv;
PUSHMARK(MARK-1);
! *MARK = SvTIED_obj((SV*)gv, mg);
ENTER;
perl_call_method("READ", G_SCALAR);
LEAVE;
***************
*** 1311,1317 ****
Zero(buffer+bufsize, offset-bufsize, char);
}
if (PL_op->op_type == OP_SYSREAD) {
! length = PerlLIO_read(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
}
else
#ifdef HAS_SOCKET__bad_code_maybe
--- 1316,1332 ----
Zero(buffer+bufsize, offset-bufsize, char);
}
if (PL_op->op_type == OP_SYSREAD) {
! #ifdef PERL_SOCK_SYSREAD_IS_RECV
! if (IoTYPE(io) == 's') {
! length = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
! buffer+offset, length, 0);
! }
! else
! #endif
! {
! length = PerlLIO_read(PerlIO_fileno(IoIFP(io)),
! buffer+offset, length);
! }
}
else
#ifdef HAS_SOCKET__bad_code_maybe
***************
*** 1353,1358 ****
--- 1368,1382 ----
PP(pp_syswrite)
{
+ djSP;
+ int items = (SP - PL_stack_base) - TOPMARK;
+ if (items == 2) {
+ SV *sv;
+ EXTEND(SP, 1);
+ sv = sv_2mortal(newSViv(sv_len(*SP)));
+ PUSHs(sv);
+ PUTBACK;
+ }
return pp_send(ARGS);
}
***************
*** 1369,1381 ****
MAGIC *mg;
gv = (GV*)*++MARK;
! if (PL_op->op_type == OP_SYSWRITE &&
! SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
! {
SV *sv;
PUSHMARK(MARK-1);
! *MARK = mg->mg_obj;
ENTER;
perl_call_method("WRITE", G_SCALAR);
LEAVE;
--- 1393,1403 ----
MAGIC *mg;
gv = (GV*)*++MARK;
! if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
SV *sv;
PUSHMARK(MARK-1);
! *MARK = SvTIED_obj((SV*)gv, mg);
ENTER;
perl_call_method("WRITE", G_SCALAR);
LEAVE;
***************
*** 1416,1422 ****
offset = 0;
if (length > blen - offset)
length = blen - offset;
! length = PerlLIO_write(PerlIO_fileno(IoIFP(io)), buffer+offset, length);
}
#ifdef HAS_SOCKET
else if (SP > MARK) {
--- 1438,1454 ----
offset = 0;
if (length > blen - offset)
length = blen - offset;
! #ifdef PERL_SOCK_SYSWRITE_IS_SEND
! if (IoTYPE(io) == 's') {
! length = PerlSock_send(PerlIO_fileno(IoIFP(io)),
! buffer+offset, length, 0);
! }
! else
! #endif
! {
! length = PerlLIO_write(PerlIO_fileno(IoIFP(io)),
! buffer+offset, length);
! }
}
#ifdef HAS_SOCKET
else if (SP > MARK) {
***************
*** 1505,1515 ****
Off_t len = (Off_t)POPn;
int result = 1;
GV *tmpgv;
SETERRNO(0,0);
#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
if (PL_op->op_flags & OPf_SPECIAL) {
! tmpgv = gv_fetchpv(POPp, FALSE, SVt_PVIO);
do_ftruncate:
TAINT_PROPER("truncate");
if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
--- 1537,1548 ----
Off_t len = (Off_t)POPn;
int result = 1;
GV *tmpgv;
+ STRLEN n_a;
SETERRNO(0,0);
#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
if (PL_op->op_flags & OPf_SPECIAL) {
! tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO);
do_ftruncate:
TAINT_PROPER("truncate");
if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
***************
*** 1533,1539 ****
goto do_ftruncate;
}
! name = SvPV(sv, PL_na);
TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
if (truncate(name, len) < 0)
--- 1566,1572 ----
goto do_ftruncate;
}
! name = SvPV(sv, n_a);
TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
if (truncate(name, len) < 0)
***************
*** 2011,2018 ****
char *buf;
int aint;
if (SvPOKp(sv)) {
! buf = SvPV(sv, PL_na);
! len = PL_na;
}
else {
aint = (int)SvIV(sv);
--- 2044,2052 ----
char *buf;
int aint;
if (SvPOKp(sv)) {
! STRLEN l;
! buf = SvPV(sv, l);
! len = l;
}
else {
aint = (int)SvIV(sv);
***************
*** 2125,2130 ****
--- 2159,2165 ----
GV *tmpgv;
I32 gimme;
I32 max = 13;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
tmpgv = cGVOP->op_gv;
***************
*** 2149,2165 ****
tmpgv = (GV*)SvRV(sv);
goto do_fstat;
}
! sv_setpv(PL_statname, SvPV(sv,PL_na));
PL_statgv = Nullgv;
#ifdef HAS_LSTAT
PL_laststype = PL_op->op_type;
if (PL_op->op_type == OP_LSTAT)
! PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, PL_na), &PL_statcache);
else
#endif
! PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
if (PL_laststatval < 0) {
! if (PL_dowarn && strchr(SvPV(PL_statname, PL_na), '\n'))
warn(warn_nl, "stat");
max = 0;
}
--- 2184,2200 ----
tmpgv = (GV*)SvRV(sv);
goto do_fstat;
}
! sv_setpv(PL_statname, SvPV(sv,n_a));
PL_statgv = Nullgv;
#ifdef HAS_LSTAT
PL_laststype = PL_op->op_type;
if (PL_op->op_type == OP_LSTAT)
! PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
else
#endif
! PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
if (PL_laststatval < 0) {
! if (PL_dowarn && strchr(SvPV(PL_statname, n_a), '\n'))
warn(warn_nl, "stat");
max = 0;
}
***************
*** 2473,2478 ****
--- 2508,2514 ----
int fd;
GV *gv;
char *tmps = Nullch;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
***************
*** 2481,2487 ****
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = (GV*)SvRV(POPs);
else
! gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
--- 2517,2523 ----
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = (GV*)SvRV(POPs);
else
! gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO);
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
***************
*** 2513,2518 ****
--- 2549,2555 ----
register IO *io;
register SV *sv;
GV *gv;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP->op_gv;
***************
*** 2576,2589 ****
really_filename:
PL_statgv = Nullgv;
PL_laststatval = -1;
! sv_setpv(PL_statname, SvPV(sv, PL_na));
#ifdef HAS_OPEN3
! i = PerlLIO_open3(SvPV(sv, PL_na), O_RDONLY, 0);
#else
! i = PerlLIO_open(SvPV(sv, PL_na), 0);
#endif
if (i < 0) {
! if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
warn(warn_nl, "open");
RETPUSHUNDEF;
}
--- 2613,2626 ----
really_filename:
PL_statgv = Nullgv;
PL_laststatval = -1;
! sv_setpv(PL_statname, SvPV(sv, n_a));
#ifdef HAS_OPEN3
! i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0);
#else
! i = PerlLIO_open(SvPV(sv, n_a), 0);
#endif
if (i < 0) {
! if (PL_dowarn && strchr(SvPV(sv, n_a), '\n'))
warn(warn_nl, "open");
RETPUSHUNDEF;
}
***************
*** 2639,2664 ****
djSP; dTARGET;
char *tmps;
SV **svp;
if (MAXARG < 1)
tmps = Nullch;
else
! tmps = POPp;
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
if (svp)
! tmps = SvPV(*svp, PL_na);
}
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
if (svp)
! tmps = SvPV(*svp, PL_na);
}
#ifdef VMS
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
if (svp)
! tmps = SvPV(*svp, PL_na);
}
#endif
TAINT_PROPER("chdir");
--- 2676,2702 ----
djSP; dTARGET;
char *tmps;
SV **svp;
+ STRLEN n_a;
if (MAXARG < 1)
tmps = Nullch;
else
! tmps = POPpx;
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE);
if (svp)
! tmps = SvPV(*svp, n_a);
}
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE);
if (svp)
! tmps = SvPV(*svp, n_a);
}
#ifdef VMS
if (!tmps || !*tmps) {
svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE);
if (svp)
! tmps = SvPV(*svp, n_a);
}
#endif
TAINT_PROPER("chdir");
***************
*** 2689,2696 ****
{
djSP; dTARGET;
char *tmps;
#ifdef HAS_CHROOT
! tmps = POPp;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
--- 2727,2735 ----
{
djSP; dTARGET;
char *tmps;
+ STRLEN n_a;
#ifdef HAS_CHROOT
! tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
RETURN;
***************
*** 2733,2741 ****
{
djSP; dTARGET;
int anum;
! char *tmps2 = POPp;
! char *tmps = SvPV(TOPs, PL_na);
TAINT_PROPER("rename");
#ifdef HAS_RENAME
anum = PerlLIO_rename(tmps, tmps2);
--- 2772,2781 ----
{
djSP; dTARGET;
int anum;
+ STRLEN n_a;
! char *tmps2 = POPpx;
! char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("rename");
#ifdef HAS_RENAME
anum = PerlLIO_rename(tmps, tmps2);
***************
*** 2759,2766 ****
{
djSP; dTARGET;
#ifdef HAS_LINK
! char *tmps2 = POPp;
! char *tmps = SvPV(TOPs, PL_na);
TAINT_PROPER("link");
SETi( link(tmps, tmps2) >= 0 );
#else
--- 2799,2807 ----
{
djSP; dTARGET;
#ifdef HAS_LINK
! STRLEN n_a;
! char *tmps2 = POPpx;
! char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("link");
SETi( link(tmps, tmps2) >= 0 );
#else
***************
*** 2773,2780 ****
{
djSP; dTARGET;
#ifdef HAS_SYMLINK
! char *tmps2 = POPp;
! char *tmps = SvPV(TOPs, PL_na);
TAINT_PROPER("symlink");
SETi( symlink(tmps, tmps2) >= 0 );
RETURN;
--- 2814,2822 ----
{
djSP; dTARGET;
#ifdef HAS_SYMLINK
! STRLEN n_a;
! char *tmps2 = POPpx;
! char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("symlink");
SETi( symlink(tmps, tmps2) >= 0 );
RETURN;
***************
*** 2790,2800 ****
char *tmps;
char buf[MAXPATHLEN];
int len;
#ifndef INCOMPLETE_TAINTS
TAINT;
#endif
! tmps = POPp;
len = readlink(tmps, buf, sizeof buf);
EXTEND(SP, 1);
if (len < 0)
--- 2832,2843 ----
char *tmps;
char buf[MAXPATHLEN];
int len;
+ STRLEN n_a;
#ifndef INCOMPLETE_TAINTS
TAINT;
#endif
! tmps = POPpx;
len = readlink(tmps, buf, sizeof buf);
EXTEND(SP, 1);
if (len < 0)
***************
*** 2903,2909 ****
#ifndef HAS_MKDIR
int oldumask;
#endif
! char *tmps = SvPV(TOPs, PL_na);
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
--- 2946,2953 ----
#ifndef HAS_MKDIR
int oldumask;
#endif
! STRLEN n_a;
! char *tmps = SvPV(TOPs, n_a);
TAINT_PROPER("mkdir");
#ifdef HAS_MKDIR
***************
*** 2921,2928 ****
{
djSP; dTARGET;
char *tmps;
! tmps = POPp;
TAINT_PROPER("rmdir");
#ifdef HAS_RMDIR
XPUSHi( PerlDir_rmdir(tmps) >= 0 );
--- 2965,2973 ----
{
djSP; dTARGET;
char *tmps;
+ STRLEN n_a;
! tmps = POPpx;
TAINT_PROPER("rmdir");
#ifdef HAS_RMDIR
XPUSHi( PerlDir_rmdir(tmps) >= 0 );
***************
*** 2938,2944 ****
{
djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
! char *dirname = POPp;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
--- 2983,2990 ----
{
djSP;
#if defined(Direntry_t) && defined(HAS_READDIR)
! STRLEN n_a;
! char *dirname = POPpx;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
***************
*** 3183,3192 ****
int result;
int status;
Sigsave_t ihand,qhand; /* place to save signals during system() */
if (SP - MARK == 1) {
if (PL_tainting) {
! char *junk = SvPV(TOPs, PL_na);
TAINT_ENV();
TAINT_PROPER("system");
}
--- 3229,3239 ----
int result;
int status;
Sigsave_t ihand,qhand; /* place to save signals during system() */
+ STRLEN n_a;
if (SP - MARK == 1) {
if (PL_tainting) {
! char *junk = SvPV(TOPs, n_a);
TAINT_ENV();
TAINT_PROPER("system");
}
***************
*** 3222,3228 ****
else if (SP - MARK != 1)
value = (I32)do_aexec(Nullsv, MARK, SP);
else {
! value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
}
PerlProc__exit(-1);
#else /* ! FORK or VMS or OS/2 */
--- 3269,3275 ----
else if (SP - MARK != 1)
value = (I32)do_aexec(Nullsv, MARK, SP);
else {
! value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
}
PerlProc__exit(-1);
#else /* ! FORK or VMS or OS/2 */
***************
*** 3233,3239 ****
else if (SP - MARK != 1)
value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
else {
! value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), PL_na));
}
STATUS_NATIVE_SET(value);
do_execfree();
--- 3280,3286 ----
else if (SP - MARK != 1)
value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
else {
! value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
}
STATUS_NATIVE_SET(value);
do_execfree();
***************
*** 3247,3252 ****
--- 3294,3300 ----
{
djSP; dMARK; dORIGMARK; dTARGET;
I32 value;
+ STRLEN n_a;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
***************
*** 3260,3273 ****
#endif
else {
if (PL_tainting) {
! char *junk = SvPV(*SP, PL_na);
TAINT_ENV();
TAINT_PROPER("exec");
}
#ifdef VMS
! value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
#else
! value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), PL_na));
#endif
}
SP = ORIGMARK;
--- 3308,3321 ----
#endif
else {
if (PL_tainting) {
! char *junk = SvPV(*SP, n_a);
TAINT_ENV();
TAINT_PROPER("exec");
}
#ifdef VMS
! value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
#else
! value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
#endif
}
SP = ORIGMARK;
***************
*** 3692,3703 ****
unsigned long len;
EXTEND(SP, 10);
! if (which == OP_GHBYNAME)
#ifdef HAS_GETHOSTBYNAME
! hent = PerlSock_gethostbyname(POPp);
#else
DIE(no_sock_func, "gethostbyname");
#endif
else if (which == OP_GHBYADDR) {
#ifdef HAS_GETHOSTBYADDR
int addrtype = POPi;
--- 3740,3753 ----
unsigned long len;
EXTEND(SP, 10);
! if (which == OP_GHBYNAME) {
#ifdef HAS_GETHOSTBYNAME
! STRLEN n_a;
! hent = PerlSock_gethostbyname(POPpx);
#else
DIE(no_sock_func, "gethostbyname");
#endif
+ }
else if (which == OP_GHBYADDR) {
#ifdef HAS_GETHOSTBYADDR
int addrtype = POPi;
***************
*** 3798,3809 ****
#endif
struct netent *nent;
! if (which == OP_GNBYNAME)
#ifdef HAS_GETNETBYNAME
! nent = PerlSock_getnetbyname(POPp);
#else
DIE(no_sock_func, "getnetbyname");
#endif
else if (which == OP_GNBYADDR) {
#ifdef HAS_GETNETBYADDR
int addrtype = POPi;
--- 3848,3861 ----
#endif
struct netent *nent;
! if (which == OP_GNBYNAME) {
#ifdef HAS_GETNETBYNAME
! STRLEN n_a;
! nent = PerlSock_getnetbyname(POPpx);
#else
DIE(no_sock_func, "getnetbyname");
#endif
+ }
else if (which == OP_GNBYADDR) {
#ifdef HAS_GETNETBYADDR
int addrtype = POPi;
***************
*** 3885,3896 ****
#endif
struct protoent *pent;
! if (which == OP_GPBYNAME)
#ifdef HAS_GETPROTOBYNAME
! pent = PerlSock_getprotobyname(POPp);
#else
DIE(no_sock_func, "getprotobyname");
#endif
else if (which == OP_GPBYNUMBER)
#ifdef HAS_GETPROTOBYNUMBER
pent = PerlSock_getprotobynumber(POPi);
--- 3937,3950 ----
#endif
struct protoent *pent;
! if (which == OP_GPBYNAME) {
#ifdef HAS_GETPROTOBYNAME
! STRLEN n_a;
! pent = PerlSock_getprotobyname(POPpx);
#else
DIE(no_sock_func, "getprotobyname");
#endif
+ }
else if (which == OP_GPBYNUMBER)
#ifdef HAS_GETPROTOBYNUMBER
pent = PerlSock_getprotobynumber(POPi);
***************
*** 3969,3976 ****
if (which == OP_GSBYNAME) {
#ifdef HAS_GETSERVBYNAME
! char *proto = POPp;
! char *name = POPp;
if (proto && !*proto)
proto = Nullch;
--- 4023,4031 ----
if (which == OP_GSBYNAME) {
#ifdef HAS_GETSERVBYNAME
! STRLEN n_a;
! char *proto = POPpx;
! char *name = POPpx;
if (proto && !*proto)
proto = Nullch;
***************
*** 3982,3988 ****
}
else if (which == OP_GSBYPORT) {
#ifdef HAS_GETSERVBYPORT
! char *proto = POPp;
unsigned short port = POPu;
#ifdef HAS_HTONS
--- 4037,4044 ----
}
else if (which == OP_GSBYPORT) {
#ifdef HAS_GETSERVBYPORT
! STRLEN n_a;
! char *proto = POPpx;
unsigned short port = POPu;
#ifdef HAS_HTONS
***************
*** 4159,4167 ****
I32 which = PL_op->op_type;
register SV *sv;
struct passwd *pwent;
if (which == OP_GPWNAM)
! pwent = getpwnam(POPp);
else if (which == OP_GPWUID)
pwent = getpwuid(POPi);
else
--- 4215,4224 ----
I32 which = PL_op->op_type;
register SV *sv;
struct passwd *pwent;
+ STRLEN n_a;
if (which == OP_GPWNAM)
! pwent = getpwnam(POPpx);
else if (which == OP_GPWUID)
pwent = getpwuid(POPi);
else
***************
*** 4292,4300 ****
register char **elem;
register SV *sv;
struct group *grent;
if (which == OP_GGRNAM)
! grent = (struct group *)getgrnam(POPp);
else if (which == OP_GGRGID)
grent = (struct group *)getgrgid(POPi);
else
--- 4349,4358 ----
register char **elem;
register SV *sv;
struct group *grent;
+ STRLEN n_a;
if (which == OP_GGRNAM)
! grent = (struct group *)getgrnam(POPpx);
else if (which == OP_GGRGID)
grent = (struct group *)getgrgid(POPi);
else
***************
*** 4407,4414 ****
a[i++] = SvIV(*MARK);
else if (*MARK == &PL_sv_undef)
a[i++] = 0;
! else
! a[i++] = (unsigned long)SvPV_force(*MARK, PL_na);
if (i > 15)
break;
}
--- 4465,4474 ----
a[i++] = SvIV(*MARK);
else if (*MARK == &PL_sv_undef)
a[i++] = 0;
! else {
! STRLEN n_a;
! a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
! }
if (i > 15)
break;
}
diff -c 'perl5.005_02/proto.h' 'perl5.005_03/proto.h'
Index: ./proto.h
*** ./proto.h Sun Aug 2 01:28:28 1998
--- ./proto.h Thu Mar 4 18:34:58 1999
***************
*** 645,651 ****
protected:
void hsplit _((HV *hv));
void hfreeentries _((HV *hv));
! HE* more_he _((void));
HE* new_he _((void));
void del_he _((HE *p));
HEK *save_hek _((char *str, I32 len, U32 hash));
--- 645,651 ----
protected:
void hsplit _((HV *hv));
void hfreeentries _((HV *hv));
! void more_he _((void));
HE* new_he _((void));
void del_he _((HE *p));
HEK *save_hek _((char *str, I32 len, U32 hash));
***************
*** 655,664 ****
IV asIV _((SV* sv));
UV asUV _((SV* sv));
SV *more_sv _((void));
! XPVIV *more_xiv _((void));
! XPVNV *more_xnv _((void));
! XPV *more_xpv _((void));
! XRV *more_xrv _((void));
XPVIV *new_xiv _((void));
XPVNV *new_xnv _((void));
XPV *new_xpv _((void));
--- 655,664 ----
IV asIV _((SV* sv));
UV asUV _((SV* sv));
SV *more_sv _((void));
! void more_xiv _((void));
! void more_xnv _((void));
! void more_xpv _((void));
! void more_xrv _((void));
XPVIV *new_xiv _((void));
XPVNV *new_xnv _((void));
XPV *new_xpv _((void));
***************
*** 687,693 ****
I32 sortcv _((SV *a, SV *b));
void save_magic _((MGS *mgs, SV *sv));
int magic_methpack _((SV *sv, MAGIC *mg, char *meth));
! int magic_methcall _((MAGIC *mg, char *meth, I32 flags, int n, SV *val));
OP * doform _((CV *cv, GV *gv, OP *retop));
void doencodes _((SV* sv, char* s, I32 len));
SV* refto _((SV* sv));
--- 687,693 ----
I32 sortcv _((SV *a, SV *b));
void save_magic _((MGS *mgs, SV *sv));
int magic_methpack _((SV *sv, MAGIC *mg, char *meth));
! int magic_methcall _((SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val));
OP * doform _((CV *cv, GV *gv, OP *retop));
void doencodes _((SV* sv, char* s, I32 len));
SV* refto _((SV* sv));
***************
*** 758,764 ****
OP *too_few_arguments _((OP *o, char* name));
OP *too_many_arguments _((OP *o, char* name));
void null _((OP* o));
! PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix));
OP *newDEFSVOP _((void));
char* gv_ename _((GV *gv));
CV *cv_clone2 _((CV *proto, CV *outside));
--- 758,764 ----
OP *too_few_arguments _((OP *o, char* name));
OP *too_many_arguments _((OP *o, char* name));
void null _((OP* o));
! PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags));
OP *newDEFSVOP _((void));
char* gv_ename _((GV *gv));
CV *cv_clone2 _((CV *proto, CV *outside));
***************
*** 822,827 ****
--- 822,829 ----
void *bset_obj_store _((void *obj, I32 ix));
OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+ I32 amagic_cmp _((register SV *str1, register SV *str2));
+ I32 amagic_cmp_locale _((register SV *str1, register SV *str2));
#define PPDEF(s) OP* CPerlObj::s _((ARGSproto));
public:
***************
*** 866,871 ****
--- 868,874 ----
void restore_expect _((void *e));
void restore_lex_expect _((void *e));
void yydestruct _((void *ptr));
+
VIRTUAL int fprintf _((PerlIO *pf, const char *pat, ...));
VIRTUAL SV** get_specialsv_list _((void));
***************
*** 896,901 ****
--- 899,908 ----
VIRTUAL void sv_setsv_mg _((SV *dstr, SV *sstr));
VIRTUAL void sv_usepvn_mg _((SV *sv, char *ptr, STRLEN len));
+ VIRTUAL MGVTBL* get_vtbl _((int vtbl_id));
+ VIRTUAL OP* dofile _((OP* term));
+ VIRTUAL void save_generic_svref _((SV** sptr));
+
/* New virtual functions must be added here to maintain binary
* compatablity with PERL_OBJECT
*/
diff -c 'perl5.005_02/regcomp.c' 'perl5.005_03/regcomp.c'
Index: ./regcomp.c
*** ./regcomp.c Tue Aug 4 21:33:43 1998
--- ./regcomp.c Sat Mar 27 11:56:13 1999
***************
*** 64,70 ****
*
**** Alterations to Henry's code are...
****
! **** Copyright (c) 1991-1997, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
--- 64,70 ----
*
**** Alterations to Henry's code are...
****
! **** Copyright (c) 1991-1999, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
***************
*** 239,244 ****
--- 239,245 ----
regnode *scan = *scanp, *next;
I32 delta = 0;
int is_inf = (flags & SCF_DO_SUBSTR) && (data->flags & SF_IS_INF);
+ int is_inf_internal = 0; /* The studied chunk is infinite */
I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0;
scan_data_t data_fake;
***************
*** 352,358 ****
if (max1 < minnext + deltanext)
max1 = minnext + deltanext;
if (deltanext == I32_MAX)
! is_inf = 1;
scan = next;
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
pars++;
--- 353,359 ----
if (max1 < minnext + deltanext)
max1 = minnext + deltanext;
if (deltanext == I32_MAX)
! is_inf = is_inf_internal = 1;
scan = next;
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
pars++;
***************
*** 423,429 ****
min++;
/* Fall through. */
case STAR:
! is_inf = 1;
scan = regnext(scan);
if (flags & SCF_DO_SUBSTR) {
scan_commit(data);
--- 424,430 ----
min++;
/* Fall through. */
case STAR:
! is_inf = is_inf_internal = 1;
scan = regnext(scan);
if (flags & SCF_DO_SUBSTR) {
scan_commit(data);
***************
*** 457,464 ****
&& maxcount <= 10000) /* Complement check for big count */
warn("Strange *+?{} on zero-length expression");
min += minnext * mincount;
! is_inf |= (maxcount == REG_INFTY && (minnext + deltanext) > 0
! || deltanext == I32_MAX);
delta += (minnext + deltanext) * maxcount - minnext * mincount;
/* Try powerful optimization CURLYX => CURLYN. */
--- 458,467 ----
&& maxcount <= 10000) /* Complement check for big count */
warn("Strange *+?{} on zero-length expression");
min += minnext * mincount;
! is_inf_internal |= (maxcount == REG_INFTY
! && (minnext + deltanext) > 0
! || deltanext == I32_MAX);
! is_inf |= is_inf_internal;
delta += (minnext + deltanext) * maxcount - minnext * mincount;
/* Try powerful optimization CURLYX => CURLYN. */
***************
*** 594,599 ****
--- 597,603 ----
}
data->longest = &(data->longest_float);
}
+ SvREFCNT_dec(last_str);
}
if (data && (fl & SF_HAS_EVAL))
data->flags |= SF_HAS_EVAL;
***************
*** 609,615 ****
scan_commit(data);
data->longest = &(data->longest_float);
}
! is_inf = 1;
break;
}
} else if (strchr(simple,OP(scan))) {
--- 613,619 ----
scan_commit(data);
data->longest = &(data->longest_float);
}
! is_inf = is_inf_internal = 1;
break;
}
} else if (strchr(simple,OP(scan))) {
***************
*** 661,667 ****
finish:
*scanp = scan;
! *deltap = is_inf ? I32_MAX : delta;
if (flags & SCF_DO_SUBSTR && is_inf)
data->pos_delta = I32_MAX - data->pos_min;
if (is_par > U8_MAX)
--- 665,671 ----
finish:
*scanp = scan;
! *deltap = is_inf_internal ? I32_MAX : delta;
if (flags & SCF_DO_SUBSTR && is_inf)
data->pos_delta = I32_MAX - data->pos_min;
if (is_par > U8_MAX)
***************
*** 911,918 ****
&& (!(data.flags & SF_FL_BEFORE_MEOL)
|| (PL_regflags & PMf_MULTILINE)))) {
if (SvCUR(data.longest_fixed)
! && data.offset_fixed == data.offset_float_min)
! goto remove; /* Like in (a)+. */
r->float_substr = data.longest_float;
r->float_min_offset = data.offset_float_min;
--- 915,923 ----
&& (!(data.flags & SF_FL_BEFORE_MEOL)
|| (PL_regflags & PMf_MULTILINE)))) {
if (SvCUR(data.longest_fixed)
! && data.offset_fixed == data.offset_float_min
! && SvCUR(data.longest_fixed) == SvCUR(data.longest_float))
! goto remove_float; /* Like in (a)+. */
r->float_substr = data.longest_float;
r->float_min_offset = data.offset_float_min;
***************
*** 924,930 ****
|| (PL_regflags & PMf_MULTILINE)))
SvTAIL_on(r->float_substr);
} else {
! remove:
r->float_substr = Nullsv;
SvREFCNT_dec(data.longest_float);
longest_float_length = 0;
--- 929,935 ----
|| (PL_regflags & PMf_MULTILINE)))
SvTAIL_on(r->float_substr);
} else {
! remove_float:
r->float_substr = Nullsv;
SvREFCNT_dec(data.longest_float);
longest_float_length = 0;
***************
*** 1119,1128 ****
--- 1124,1137 ----
else
regtail(br, reganode(LONGJMP, 0));
c = *nextchar();
+ if (flags&HASWIDTH)
+ *flagp |= HASWIDTH;
if (c == '|') {
lastbr = reganode(IFTHEN, 0); /* Fake one for optimizer. */
regbranch(&flags, 1);
regtail(ret, lastbr);
+ if (flags&HASWIDTH)
+ *flagp |= HASWIDTH;
c = *nextchar();
} else
lastbr = NULL;
***************
*** 2035,2042 ****
}
}
if (!SIZE_ONLY) {
! for ( ; lastclass <= Class; lastclass++)
! ANYOF_SET(opnd, lastclass);
}
lastclass = Class;
}
--- 2044,2067 ----
}
}
if (!SIZE_ONLY) {
! #ifndef ASCIIish
! register I32 i;
! if ((isLOWER(lastclass) && isLOWER(Class)) ||
! (isUPPER(lastclass) && isUPPER(Class))) {
! if (isLOWER(lastclass)) {
! for (i = lastclass; i <= Class; i++)
! if (isLOWER(i))
! ANYOF_SET(opnd, i);
! } else {
! for (i = lastclass; i <= Class; i++)
! if (isUPPER(i))
! ANYOF_SET(opnd, i);
! }
! }
! else
! #endif
! for ( ; lastclass <= Class; lastclass++)
! ANYOF_SET(opnd, lastclass);
}
lastclass = Class;
}
diff -c 'perl5.005_02/regexec.c' 'perl5.005_03/regexec.c'
Index: ./regexec.c
*** ./regexec.c Tue Aug 4 21:33:43 1998
--- ./regexec.c Sat Mar 27 11:56:09 1999
***************
*** 62,68 ****
*
**** Alterations to Henry's code are...
****
! **** Copyright (c) 1991-1997, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
--- 62,68 ----
*
**** Alterations to Henry's code are...
****
! **** Copyright (c) 1991-1999, Larry Wall
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
***************
*** 1573,1578 ****
--- 1573,1579 ----
sayYES; /* Success! */
case SUSPEND:
n = 1;
+ PL_reginput = locinput;
goto do_ifmatch;
case UNLESSM:
n = 0;
***************
*** 1768,1792 ****
register char *scan;
register char *start;
register char *loceol = PL_regeol;
! I32 l = -1;
start = PL_reginput;
! while (PL_reginput < loceol && (scan = PL_reginput, regmatch(p))) {
! if (l == -1) {
*lp = l = PL_reginput - start;
if (max != REG_INFTY && l*max < loceol - scan)
loceol = scan + l*max;
! if (l == 0) {
return max;
- }
}
}
! if (PL_reginput < loceol)
PL_reginput = scan;
- else
- scan = PL_reginput;
! return (scan - start)/l;
}
/*
--- 1769,1794 ----
register char *scan;
register char *start;
register char *loceol = PL_regeol;
! I32 l = 0;
! I32 count = 0, res = 1;
!
! if (!max)
! return 0;
start = PL_reginput;
! while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
! if (!count++) {
*lp = l = PL_reginput - start;
if (max != REG_INFTY && l*max < loceol - scan)
loceol = scan + l*max;
! if (l == 0)
return max;
}
}
! if (!res)
PL_reginput = scan;
! return count;
}
/*
diff -c 'perl5.005_02/run.c' 'perl5.005_03/run.c'
Index: ./run.c
*** ./run.c Thu Jul 23 23:02:08 1998
--- ./run.c Sat Mar 27 11:55:48 1999
***************
*** 1,6 ****
/* run.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* run.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 77,82 ****
--- 77,83 ----
{
#ifdef DEBUGGING
SV *sv;
+ STRLEN n_a;
deb("%s", op_name[o->op_type]);
switch (o->op_type) {
case OP_CONST:
***************
*** 87,93 ****
if (cGVOPo->op_gv) {
sv = NEWSV(0,0);
gv_fullname3(sv, cGVOPo->op_gv, Nullch);
! PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, PL_na));
SvREFCNT_dec(sv);
}
else
--- 88,94 ----
if (cGVOPo->op_gv) {
sv = NEWSV(0,0);
gv_fullname3(sv, cGVOPo->op_gv, Nullch);
! PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
SvREFCNT_dec(sv);
}
else
diff -c 'perl5.005_02/scope.c' 'perl5.005_03/scope.c'
Index: ./scope.c
*** ./scope.c Sun Aug 2 01:08:11 1998
--- ./scope.c Sat Mar 27 11:55:45 1999
***************
*** 1,6 ****
/* scope.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* scope.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 144,152 ****
SV* sv = PL_tmps_stack[PL_tmps_ix];
PL_tmps_stack[PL_tmps_ix--] = Nullsv;
if (sv) {
- #ifdef DEBUGGING
SvTEMP_off(sv);
- #endif
SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */
}
}
--- 144,150 ----
***************
*** 206,211 ****
--- 204,221 ----
return save_scalar_at(sptr);
}
+ /* Like save_svref(), but doesn't deal with magic. Can be used to
+ * restore a global SV to its prior contents, freeing new value. */
+ void
+ save_generic_svref(SV **sptr)
+ {
+ dTHR;
+ SSCHECK(3);
+ SSPUSHPTR(sptr);
+ SSPUSHPTR(SvREFCNT_inc(*sptr));
+ SSPUSHINT(SAVEt_GENERIC_SVREF);
+ }
+
void
save_gp(GV *gv, I32 empty)
{
***************
*** 562,567 ****
--- 572,587 ----
ptr = &GvSV(gv);
SvREFCNT_dec(gv);
goto restore_sv;
+ case SAVEt_GENERIC_SVREF: /* generic sv */
+ value = (SV*)SSPOPPTR;
+ ptr = SSPOPPTR;
+ if (ptr) {
+ sv = *(SV**)ptr;
+ *(SV**)ptr = value;
+ SvREFCNT_dec(sv);
+ }
+ SvREFCNT_dec(value);
+ break;
case SAVEt_SVREF: /* scalar reference */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
***************
*** 774,780 ****
if (ptr) {
sv = *(SV**)ptr;
if (sv && sv != &PL_sv_undef) {
! if (SvRMAGICAL(av) && mg_find((SV*)av, 'P'))
(void)SvREFCNT_inc(sv);
SvREFCNT_dec(av);
goto restore_sv;
--- 794,800 ----
if (ptr) {
sv = *(SV**)ptr;
if (sv && sv != &PL_sv_undef) {
! if (SvTIED_mg((SV*)av, 'P'))
(void)SvREFCNT_inc(sv);
SvREFCNT_dec(av);
goto restore_sv;
***************
*** 792,798 ****
SV *oval = HeVAL((HE*)ptr);
if (oval && oval != &PL_sv_undef) {
ptr = &HeVAL((HE*)ptr);
! if (SvRMAGICAL(hv) && mg_find((SV*)hv, 'P'))
(void)SvREFCNT_inc(*(SV**)ptr);
SvREFCNT_dec(hv);
SvREFCNT_dec(sv);
--- 812,818 ----
SV *oval = HeVAL((HE*)ptr);
if (oval && oval != &PL_sv_undef) {
ptr = &HeVAL((HE*)ptr);
! if (SvTIED_mg((SV*)hv, 'P'))
(void)SvREFCNT_inc(*(SV**)ptr);
SvREFCNT_dec(hv);
SvREFCNT_dec(sv);
***************
*** 824,831 ****
{
#ifdef DEBUGGING
dTHR;
! PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[cx->cx_type]);
! if (cx->cx_type != CXt_SUBST) {
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
--- 844,851 ----
{
#ifdef DEBUGGING
dTHR;
! PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[CxTYPE(cx)]);
! if (CxTYPE(cx) != CXt_SUBST) {
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp);
***************
*** 834,840 ****
PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
}
! switch (cx->cx_type) {
case CXt_NULL:
case CXt_BLOCK:
break;
--- 854,860 ----
PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm);
PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR");
}
! switch (CxTYPE(cx)) {
case CXt_NULL:
case CXt_BLOCK:
break;
diff -c 'perl5.005_02/scope.h' 'perl5.005_03/scope.h'
Index: ./scope.h
*** ./scope.h Thu Jul 23 23:02:08 1998
--- ./scope.h Sat Nov 7 17:56:32 1998
***************
*** 26,31 ****
--- 26,33 ----
#define SAVEt_HELEM 25
#define SAVEt_OP 26
#define SAVEt_HINTS 27
+ /* #define SAVEt_ALLOC 28 */ /* defined in 5.005_5x */
+ #define SAVEt_GENERIC_SVREF 29
#define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
***************
*** 62,68 ****
#define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)
/*
! * Not using SOFT_CAST on SAVEFREESV and SAVEFREESV
* because these are used for several kinds of pointer values
*/
#define SAVEI16(i) save_I16(SOFT_CAST(I16*)&(i))
--- 64,70 ----
#define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)
/*
! * Not using SOFT_CAST on SAVESPTR, SAVEGENERICSV and SAVEFREESV
* because these are used for several kinds of pointer values
*/
#define SAVEI16(i) save_I16(SOFT_CAST(I16*)&(i))
***************
*** 76,81 ****
--- 78,84 ----
#define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o))
#define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p))
#define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv))
+ #define SAVEGENERICSV(s) save_generic_svref((SV**)&(s))
#define SAVEDELETE(h,k,l) \
save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
#ifdef PERL_OBJECT
diff -c 'perl5.005_02/sv.c' 'perl5.005_03/sv.c'
Index: ./sv.c
*** ./sv.c Sun Aug 2 00:15:08 1998
--- ./sv.c Sat Mar 27 11:55:42 1999
***************
*** 1,6 ****
/* sv.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* sv.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 49,58 ****
static IV asIV _((SV* sv));
static UV asUV _((SV* sv));
static SV *more_sv _((void));
! static XPVIV *more_xiv _((void));
! static XPVNV *more_xnv _((void));
! static XPV *more_xpv _((void));
! static XRV *more_xrv _((void));
static XPVIV *new_xiv _((void));
static XPVNV *new_xnv _((void));
static XPV *new_xpv _((void));
--- 49,58 ----
static IV asIV _((SV* sv));
static UV asUV _((SV* sv));
static SV *more_sv _((void));
! static void more_xiv _((void));
! static void more_xnv _((void));
! static void more_xpv _((void));
! static void more_xrv _((void));
static XPVIV *new_xiv _((void));
static XPVNV *new_xnv _((void));
static XPV *new_xpv _((void));
***************
*** 417,442 ****
new_xiv(void)
{
IV* xiv;
! if (PL_xiv_root) {
! xiv = PL_xiv_root;
! /*
! * See comment in more_xiv() -- RAM.
! */
! PL_xiv_root = *(IV**)xiv;
! return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
! }
! return more_xiv();
}
STATIC void
del_xiv(XPVIV *p)
{
IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
*(IV**)xiv = PL_xiv_root;
PL_xiv_root = xiv;
}
! STATIC XPVIV*
more_xiv(void)
{
register IV* xiv;
--- 417,445 ----
new_xiv(void)
{
IV* xiv;
! LOCK_SV_MUTEX;
! if (!PL_xiv_root)
! more_xiv();
! xiv = PL_xiv_root;
! /*
! * See comment in more_xiv() -- RAM.
! */
! PL_xiv_root = *(IV**)xiv;
! UNLOCK_SV_MUTEX;
! return (XPVIV*)((char*)xiv - STRUCT_OFFSET(XPVIV, xiv_iv));
}
STATIC void
del_xiv(XPVIV *p)
{
IV* xiv = (IV*)((char*)(p) + STRUCT_OFFSET(XPVIV, xiv_iv));
+ LOCK_SV_MUTEX;
*(IV**)xiv = PL_xiv_root;
PL_xiv_root = xiv;
+ UNLOCK_SV_MUTEX;
}
! STATIC void
more_xiv(void)
{
register IV* xiv;
***************
*** 455,484 ****
xiv++;
}
*(IV**)xiv = 0;
- return new_xiv();
}
STATIC XPVNV*
new_xnv(void)
{
double* xnv;
! if (PL_xnv_root) {
! xnv = PL_xnv_root;
! PL_xnv_root = *(double**)xnv;
! return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
! }
! return more_xnv();
}
STATIC void
del_xnv(XPVNV *p)
{
double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
! *(double**)xnv = PL_xnv_root;
! PL_xnv_root = xnv;
}
! STATIC XPVNV*
more_xnv(void)
{
register double* xnv;
--- 458,489 ----
xiv++;
}
*(IV**)xiv = 0;
}
STATIC XPVNV*
new_xnv(void)
{
double* xnv;
! LOCK_SV_MUTEX;
! if (!PL_xnv_root)
! more_xnv();
! xnv = PL_xnv_root;
! PL_xnv_root = *(double**)xnv;
! UNLOCK_SV_MUTEX;
! return (XPVNV*)((char*)xnv - STRUCT_OFFSET(XPVNV, xnv_nv));
}
STATIC void
del_xnv(XPVNV *p)
{
double* xnv = (double*)((char*)(p) + STRUCT_OFFSET(XPVNV, xnv_nv));
! LOCK_SV_MUTEX;
! *(double**)xnv = PL_xnv_root;
! PL_xnv_root = xnv;
! UNLOCK_SV_MUTEX;
}
! STATIC void
more_xnv(void)
{
register double* xnv;
***************
*** 492,520 ****
xnv++;
}
*(double**)xnv = 0;
- return new_xnv();
}
STATIC XRV*
new_xrv(void)
{
XRV* xrv;
! if (PL_xrv_root) {
! xrv = PL_xrv_root;
! PL_xrv_root = (XRV*)xrv->xrv_rv;
! return xrv;
! }
! return more_xrv();
}
STATIC void
del_xrv(XRV *p)
{
! p->xrv_rv = (SV*)PL_xrv_root;
! PL_xrv_root = p;
}
! STATIC XRV*
more_xrv(void)
{
register XRV* xrv;
--- 497,527 ----
xnv++;
}
*(double**)xnv = 0;
}
STATIC XRV*
new_xrv(void)
{
XRV* xrv;
! LOCK_SV_MUTEX;
! if (!PL_xrv_root)
! more_xrv();
! xrv = PL_xrv_root;
! PL_xrv_root = (XRV*)xrv->xrv_rv;
! UNLOCK_SV_MUTEX;
! return xrv;
}
STATIC void
del_xrv(XRV *p)
{
! LOCK_SV_MUTEX;
! p->xrv_rv = (SV*)PL_xrv_root;
! PL_xrv_root = p;
! UNLOCK_SV_MUTEX;
}
! STATIC void
more_xrv(void)
{
register XRV* xrv;
***************
*** 527,555 ****
xrv++;
}
xrv->xrv_rv = 0;
- return new_xrv();
}
STATIC XPV*
new_xpv(void)
{
XPV* xpv;
! if (PL_xpv_root) {
! xpv = PL_xpv_root;
! PL_xpv_root = (XPV*)xpv->xpv_pv;
! return xpv;
! }
! return more_xpv();
}
STATIC void
del_xpv(XPV *p)
{
! p->xpv_pv = (char*)PL_xpv_root;
! PL_xpv_root = p;
}
! STATIC XPV*
more_xpv(void)
{
register XPV* xpv;
--- 534,564 ----
xrv++;
}
xrv->xrv_rv = 0;
}
STATIC XPV*
new_xpv(void)
{
XPV* xpv;
! LOCK_SV_MUTEX;
! if (!PL_xpv_root)
! more_xpv();
! xpv = PL_xpv_root;
! PL_xpv_root = (XPV*)xpv->xpv_pv;
! UNLOCK_SV_MUTEX;
! return xpv;
}
STATIC void
del_xpv(XPV *p)
{
! LOCK_SV_MUTEX;
! p->xpv_pv = (char*)PL_xpv_root;
! PL_xpv_root = p;
! UNLOCK_SV_MUTEX;
}
! STATIC void
more_xpv(void)
{
register XPV* xpv;
***************
*** 562,568 ****
xpv++;
}
xpv->xpv_pv = 0;
- return new_xpv();
}
#ifdef PURIFY
--- 571,576 ----
***************
*** 1062,1068 ****
while (unref--)
sv_catpv(t, ")");
}
! return SvPV(t, PL_na);
#else /* DEBUGGING */
return "";
#endif /* DEBUGGING */
--- 1070,1076 ----
while (unref--)
sv_catpv(t, ")");
}
! return SvPV(t, prevlen);
#else /* DEBUGGING */
return "";
#endif /* DEBUGGING */
***************
*** 3484,3489 ****
--- 3492,3499 ----
if (!sv)
return;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
if (SvTHINKFIRST(sv)) {
if (SvREADONLY(sv)) {
dTHR;
***************
*** 3500,3507 ****
sv_setiv(sv, i);
}
}
- if (SvGMAGICAL(sv))
- mg_get(sv);
flags = SvFLAGS(sv);
if (flags & SVp_NOK) {
(void)SvNOK_only(sv);
--- 3510,3515 ----
***************
*** 3578,3583 ****
--- 3586,3593 ----
if (!sv)
return;
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
if (SvTHINKFIRST(sv)) {
if (SvREADONLY(sv)) {
dTHR;
***************
*** 3594,3601 ****
sv_setiv(sv, i);
}
}
- if (SvGMAGICAL(sv))
- mg_get(sv);
flags = SvFLAGS(sv);
if (flags & SVp_NOK) {
SvNVX(sv) -= 1.0;
--- 3604,3609 ----
***************
*** 3845,3856 ****
}
for (i = 0; i <= (I32) HvMAX(stash); i++) {
for (entry = HvARRAY(stash)[i];
! entry;
! entry = HeNEXT(entry)) {
if (!todo[(U8)*HeKEY(entry)])
continue;
gv = (GV*)HeVAL(entry);
sv = GvSV(gv);
(void)SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
--- 3853,3870 ----
}
for (i = 0; i <= (I32) HvMAX(stash); i++) {
for (entry = HvARRAY(stash)[i];
! entry;
! entry = HeNEXT(entry))
! {
if (!todo[(U8)*HeKEY(entry)])
continue;
gv = (GV*)HeVAL(entry);
sv = GvSV(gv);
+ if (SvTHINKFIRST(sv)) {
+ if (!SvREADONLY(sv) && SvROK(sv))
+ sv_unref(sv);
+ continue;
+ }
(void)SvOK_off(sv);
if (SvTYPE(sv) >= SVt_PV) {
SvCUR_set(sv, 0);
***************
*** 3878,3883 ****
--- 3892,3898 ----
{
IO* io;
GV* gv;
+ STRLEN n_a;
switch (SvTYPE(sv)) {
case SVt_PVIO:
***************
*** 3894,3906 ****
croak(no_usym, "filehandle");
if (SvROK(sv))
return sv_2io(SvRV(sv));
! gv = gv_fetchpv(SvPV(sv,PL_na), FALSE, SVt_PVIO);
if (gv)
io = GvIO(gv);
else
io = 0;
if (!io)
! croak("Bad filehandle: %s", SvPV(sv,PL_na));
break;
}
return io;
--- 3909,3921 ----
croak(no_usym, "filehandle");
if (SvROK(sv))
return sv_2io(SvRV(sv));
! gv = gv_fetchpv(SvPV(sv,n_a), FALSE, SVt_PVIO);
if (gv)
io = GvIO(gv);
else
io = 0;
if (!io)
! croak("Bad filehandle: %s", SvPV(sv,n_a));
break;
}
return io;
***************
*** 3911,3916 ****
--- 3926,3932 ----
{
GV *gv;
CV *cv;
+ STRLEN n_a;
if (!sv)
return *gvp = Nullgv, Nullcv;
***************
*** 3933,3949 ****
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvROK(sv)) {
! cv = (CV*)SvRV(sv);
! if (SvTYPE(cv) != SVt_PVCV)
croak("Not a subroutine reference");
- *gvp = Nullgv;
- *st = CvSTASH(cv);
- return cv;
}
! if (isGV(sv))
gv = (GV*)sv;
else
! gv = gv_fetchpv(SvPV(sv, PL_na), lref, SVt_PVCV);
*gvp = gv;
if (!gv)
return Nullcv;
--- 3949,3970 ----
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvROK(sv)) {
! sv = SvRV(sv);
! if (SvTYPE(sv) == SVt_PVCV) {
! cv = (CV*)sv;
! *gvp = Nullgv;
! *st = CvSTASH(cv);
! return cv;
! }
! else if(isGV(sv))
! gv = (GV*)sv;
! else
croak("Not a subroutine reference");
}
! else if (isGV(sv))
gv = (GV*)sv;
else
! gv = gv_fetchpv(SvPV(sv, n_a), lref, SVt_PVCV);
*gvp = gv;
if (!gv)
return Nullcv;
***************
*** 3960,3966 ****
Nullop);
LEAVE;
if (!GvCVu(gv))
! croak("Unable to create sub named \"%s\"", SvPV(sv,PL_na));
}
return GvCVu(gv);
}
--- 3981,3987 ----
Nullop);
LEAVE;
if (!GvCVu(gv))
! croak("Unable to create sub named \"%s\"", SvPV(sv,n_a));
}
return GvCVu(gv);
}
***************
*** 4437,4444 ****
--- 4458,4467 ----
STRLEN elen = 0;
char ebuf[TYPE_DIGITS(int) * 2 + 16]; /* large enough for "%#.#f" */
+ #ifndef PERL_OBJECT
static char *efloatbuf = Nullch;
static STRLEN efloatsize = 0;
+ #endif
char c;
int i;
***************
*** 5078,5085 ****
PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", HvNAME(sv));
break;
case SVt_PVCV:
! if (SvPOK(sv))
! PerlIO_printf(Perl_debug_log, " PROTOTYPE = \"%s\"\n", SvPV(sv,PL_na));
/* FALL THROUGH */
case SVt_PVFM:
PerlIO_printf(Perl_debug_log, " STASH = 0x%lx\n", (long)CvSTASH(sv));
--- 5101,5110 ----
PerlIO_printf(Perl_debug_log, " NAME = \"%s\"\n", HvNAME(sv));
break;
case SVt_PVCV:
! if (SvPOK(sv)) {
! STRLEN n_a;
! PerlIO_printf(Perl_debug_log, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
! }
/* FALL THROUGH */
case SVt_PVFM:
PerlIO_printf(Perl_debug_log, " STASH = 0x%lx\n", (long)CvSTASH(sv));
diff -c 'perl5.005_02/sv.h' 'perl5.005_03/sv.h'
Index: ./sv.h
*** ./sv.h Thu Jul 23 23:02:11 1998
--- ./sv.h Sat Mar 27 18:13:07 1999
***************
*** 1,6 ****
/* sv.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* sv.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 316,322 ****
#define IOf_START 2 /* check for null ARGV and substitute '-' */
#define IOf_FLUSH 4 /* this fp wants a flush after write op */
#define IOf_DIDTOP 8 /* just did top of form */
! #define IOf_UNTAINT 16 /* consider this fp (and it's data) "safe" */
/* The following macros define implementation-independent predicates on SVs. */
--- 316,323 ----
#define IOf_START 2 /* check for null ARGV and substitute '-' */
#define IOf_FLUSH 4 /* this fp wants a flush after write op */
#define IOf_DIDTOP 8 /* just did top of form */
! #define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
! #define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
/* The following macros define implementation-independent predicates on SVs. */
diff -c 'perl5.005_02/t/base/lex.t' 'perl5.005_03/t/base/lex.t'
Index: ./t/base/lex.t
*** ./t/base/lex.t Thu Jul 23 23:02:11 1998
--- ./t/base/lex.t Sun Mar 28 01:57:16 1999
***************
*** 1,8 ****
#!./perl
! # $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
!
! print "1..30\n";
$x = 'x';
--- 1,6 ----
#!./perl
! print "1..35\n";
$x = 'x';
***************
*** 117,119 ****
--- 115,144 ----
Ignored
EOF
print $foo;
+
+ # see if eval '', s///e, and heredocs mix
+
+ sub T {
+ my ($where, $num) = @_;
+ my ($p,$f,$l) = caller;
+ print "# $p:$f:$l vs /$where/\nnot " unless "$p:$f:$l" =~ /$where/;
+ print "ok $num\n";
+ }
+
+ my $test = 31;
+
+ {
+ # line 42 "plink"
+ local $_ = "not ok ";
+ eval q{
+ s/^not /<<EOT/e and T '^main:\(eval \d+\):2$', $test++;
+ # fuggedaboudit
+ EOT
+ print $_, $test++, "\n";
+ T('^main:\(eval \d+\):6$', $test++);
+ # line 1 "plunk"
+ T('^main:plunk:1$', $test++);
+ };
+ print "# $@\nnot ok $test\n" if $@;
+ T '^main:plink:53$', $test++;
+ }
diff -c 'perl5.005_02/t/cmd/for.t' 'perl5.005_03/t/cmd/for.t'
Index: ./t/cmd/for.t
*** ./t/cmd/for.t Thu Jul 23 23:02:11 1998
--- ./t/cmd/for.t Thu Oct 29 07:32:05 1998
***************
*** 1,8 ****
#!./perl
! # $RCSfile: for.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:09 $
!
! print "1..7\n";
for ($i = 0; $i <= 10; $i++) {
$x[$i] = $i;
--- 1,6 ----
#!./perl
! print "1..10\n";
for ($i = 0; $i <= 10; $i++) {
$x[$i] = $i;
***************
*** 47,49 ****
--- 45,57 ----
foreach $foo (("ok 6\n","ok 7\n")) {
print $foo;
}
+
+ sub foo {
+ for $i (1..5) {
+ return $i if $_[0] == $i;
+ }
+ }
+
+ print foo(1) == 1 ? "ok" : "not ok", " 8\n";
+ print foo(2) == 2 ? "ok" : "not ok", " 9\n";
+ print foo(5) == 5 ? "ok" : "not ok", " 10\n";
diff -c 'perl5.005_02/t/cmd/while.t' 'perl5.005_03/t/cmd/while.t'
Index: ./t/cmd/while.t
*** ./t/cmd/while.t Thu Jul 23 23:02:11 1998
--- ./t/cmd/while.t Sat Oct 24 22:48:11 1998
***************
*** 2,8 ****
# $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $
! print "1..10\n";
open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
print tmp "tvi925\n";
--- 2,8 ----
# $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $
! print "1..15\n";
open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp.";
print tmp "tvi925\n";
***************
*** 108,111 ****
--- 108,130 ----
{
$i++;
}
+ print "ok $i\n";
+
+ # Check curpm is reset when jumping out of a scope
+ 'abc' =~ /b/;
+ WHILE:
+ while (1) {
+ $i++;
+ print "#$`,$&,$',\nnot " unless $` . $& . $' eq "abc";
+ print "ok $i\n";
+ { # Localize changes to $` and friends
+ 'end' =~ /end/;
+ redo WHILE if $i == 11;
+ next WHILE if $i == 12;
+ # 13 do a normal loop
+ last WHILE if $i == 14;
+ }
+ }
+ $i++;
+ print "not " unless $` . $& . $' eq "abc";
print "ok $i\n";
diff -c 'perl5.005_02/t/comp/package.t' 'perl5.005_03/t/comp/package.t'
Index: ./t/comp/package.t
*** ./t/comp/package.t Sun Aug 2 00:15:09 1998
--- ./t/comp/package.t Thu Nov 26 18:29:20 1998
***************
*** 1,6 ****
#!./perl
! print "1..7\n";
$blurfl = 123;
$foo = 3;
--- 1,6 ----
#!./perl
! print "1..8\n";
$blurfl = 123;
$foo = 3;
***************
*** 37,39 ****
--- 37,53 ----
eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
print $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
+
+ package main;
+
+ sub c { caller(0) }
+
+ sub foo {
+ my $s = shift;
+ if ($s) {
+ package PQR;
+ main::c();
+ }
+ }
+
+ print((foo(1))[0] eq 'PQR' ? "ok 8\n" : "not ok 8\n");
diff -c 'perl5.005_02/t/comp/proto.t' 'perl5.005_03/t/comp/proto.t'
Index: ./t/comp/proto.t
*** ./t/comp/proto.t Thu Jul 23 23:02:12 1998
--- ./t/comp/proto.t Thu Mar 4 18:34:58 1999
***************
*** 16,22 ****
use strict;
! print "1..82\n";
my $i = 1;
--- 16,22 ----
use strict;
! print "1..87\n";
my $i = 1;
***************
*** 413,415 ****
--- 413,425 ----
*X::foo4 = sub ($) {'ok'};
print "not " unless X->foo4 eq 'ok';
print "ok ", $i++, "\n";
+
+ # test if the (*) prototype allows barewords, constants, scalar expressions,
+ # globs and globrefs (just as CORE::open() does), all under stricture
+ sub star (*&) { &{$_[1]} }
+ my $star = 'FOO';
+ star FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+ star "FOO", sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+ star $star, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++;
+ star *FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++;
+ star \*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++;
diff -c 'perl5.005_02/t/comp/require.t' 'perl5.005_03/t/comp/require.t'
Index: ./t/comp/require.t
*** ./t/comp/require.t Tue Aug 4 19:53:13 1998
--- ./t/comp/require.t Mon Nov 23 19:27:00 1998
***************
*** 2,8 ****
BEGIN {
chdir 't' if -d 't';
! @INC = ('.');
}
# don't make this lexical
--- 2,8 ----
BEGIN {
chdir 't' if -d 't';
! @INC = ('.', '../lib');
}
# don't make this lexical
***************
*** 35,41 ****
# compile-time failure in require
do_require "1)\n";
! print "# $@\nnot " unless $@ =~ /syntax error/i;
print "ok ",$i++,"\n";
# successful require
--- 35,43 ----
# compile-time failure in require
do_require "1)\n";
! # bison says 'parse error' instead of 'syntax error',
! # various yaccs may or may not capitalize 'syntax'.
! print "# $@\nnot " unless $@ =~ /(syntax|parse) error/mi;
print "ok ",$i++,"\n";
# successful require
diff -c 'perl5.005_02/t/io/argv.t' 'perl5.005_03/t/io/argv.t'
Index: ./t/io/argv.t
*** ./t/io/argv.t Thu Jul 23 23:02:12 1998
--- ./t/io/argv.t Sat Mar 27 18:11:04 1999
***************
*** 1,10 ****
#!./perl
! # $RCSfile: argv.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:25 $
! print "1..5\n";
!
! open(try, '>Io.argv.tmp') || (die "Can't open temp file.");
print try "a line\n";
close try;
--- 1,8 ----
#!./perl
! print "1..6\n";
! open(try, '>Io.argv.tmp') || (die "Can't open temp file: $!");
print try "a line\n";
close try;
***************
*** 45,48 ****
else
{print "not ok 5\n";}
! unlink 'Io.argv.tmp';
--- 43,59 ----
else
{print "not ok 5\n";}
! open(try, '>Io.argv.tmp') or die "Can't open temp file: $!";
! close try;
! @ARGV = 'Io.argv.tmp';
! $^I = '.bak';
! $/ = undef;
! while (<>) {
! s/^/ok 6\n/;
! print;
! }
! open(try, '<Io.argv.tmp') or die "Can't open temp file: $!";
! print while <try>;
! close try;
!
! END { unlink 'Io.argv.tmp', 'Io.argv.tmp.bak' }
diff -c 'perl5.005_02/t/io/fs.t' 'perl5.005_03/t/io/fs.t'
Index: ./t/io/fs.t
*** ./t/io/fs.t Sun Aug 2 00:54:54 1998
--- ./t/io/fs.t Thu Jan 28 19:15:20 1999
***************
*** 9,32 ****
use Config;
! $Is_Dosish = ($^O eq 'dos' or $^O eq 'os2');
! # avoid win32 (for now)
! do { print "1..0\n"; exit(0); } if $^O eq 'MSWin32';
!
! print "1..26\n";
$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`);
chop($wd);
! if ($^O eq 'MSWin32') { `del tmp`; `mkdir tmp`; }
else { `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; }
chdir './tmp';
`/bin/rm -rf a b c x` if -x '/bin/rm';
umask(022);
! if ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
open(fh,'>x') || die "Can't create x";
close(fh);
open(fh,'>a') || die "Can't create a";
--- 9,31 ----
use Config;
! $Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or
! $^O eq 'os2' or $^O eq 'mint');
! print "1..28\n";
$wd = (($^O eq 'MSWin32') ? `cd` : `pwd`);
chop($wd);
! if ($^O eq 'MSWin32') { `del tmp 2>nul`; `mkdir tmp`; }
else { `rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`; }
chdir './tmp';
`/bin/rm -rf a b c x` if -x '/bin/rm';
umask(022);
! if ($^O eq 'MSWin32') { print "ok 1 # skipped: bogus umask()\n"; }
! elsif ((umask(0)&0777) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
open(fh,'>x') || die "Can't create x";
close(fh);
open(fh,'>a') || die "Can't create a";
***************
*** 98,105 ****
if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('b');
! if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
! if ($wd =~ m#/afs/# || $^O eq 'amigaos')
{print "ok 18 # skipped: granularity of the filetime\n";}
elsif ($atime == 500000000 && $mtime == 500000000 + $delta)
{print "ok 18\n";}
--- 97,105 ----
if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
$blksize,$blocks) = stat('b');
! if ($^O eq 'MSWin32') { print "ok 17 # skipped: bogus (stat)[1]\n"; }
! elsif ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
! if ($wd =~ m#/afs/# || $^O eq 'amigaos' || $^O eq 'dos' || $^O eq 'MSWin32')
{print "ok 18 # skipped: granularity of the filetime\n";}
elsif ($atime == 500000000 && $mtime == 500000000 + $delta)
{print "ok 18\n";}
***************
*** 113,119 ****
unlink 'c';
chdir $wd || die "Can't cd back to $wd";
- rmdir 'tmp';
unlink 'c';
if ($^O ne 'MSWin32' and `ls -l perl 2>/dev/null` =~ /^l.*->/) {
--- 113,118 ----
***************
*** 156,159 ****
if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"}
close FH;
}
! unlink "Iofs.tmp";
--- 155,165 ----
if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"}
close FH;
}
!
! # check if rename() works on directories
! rename 'tmp', 'tmp1' or print "not ";
! print "ok 27\n";
! -d 'tmp1' or print "not ";
! print "ok 28\n";
!
! END { rmdir 'tmp1'; unlink "Iofs.tmp"; }
diff -c 'perl5.005_02/t/lib/cgi-html.t' 'perl5.005_03/t/lib/cgi-html.t'
Index: ./t/lib/cgi-html.t
*** ./t/lib/cgi-html.t Sun Aug 2 00:15:09 1998
--- ./t/lib/cgi-html.t Sat Jan 23 18:18:10 1999
***************
*** 8,18 ****
@INC = '../lib' if -d '../lib';
}
! BEGIN {$| = 1; print "1..17\n"; }
BEGIN {$eol = $^O eq 'VMS' ? "\n" : "\cM\cJ";
$eol = "\r\n" if $^O eq 'os390'; }
END {print "not ok 1\n" unless $loaded;}
! use CGI (':standard','-no_debug');
$loaded = 1;
print "ok 1\n";
--- 8,18 ----
@INC = '../lib' if -d '../lib';
}
! BEGIN {$| = 1; print "1..20\n"; }
BEGIN {$eol = $^O eq 'VMS' ? "\n" : "\cM\cJ";
$eol = "\r\n" if $^O eq 'os390'; }
END {print "not ok 1\n" unless $loaded;}
! use CGI (':standard','-no_debug','*h3','start_table');
$loaded = 1;
print "ok 1\n";
***************
*** 64,66 ****
--- 64,69 ----
'fred=chocolate&chip; path=/',"cookie()");
test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/${eol}Date:.*${eol}Content-Type: text/html${eol}${eol}!s,
"header(-cookie)");
+ test(18,start_h3 eq '<H3>');
+ test(19,end_h3 eq '</H3>');
+ test(20,start_table({-border=>undef}) eq '<TABLE BORDER>');
diff -c 'perl5.005_02/t/lib/complex.t' 'perl5.005_03/t/lib/complex.t'
Index: ./t/lib/complex.t
Prereq: 1.8
*** ./t/lib/complex.t Thu Jul 23 23:02:13 1998
--- ./t/lib/complex.t Thu Nov 26 08:55:21 1998
***************
*** 14,20 ****
use Math::Complex;
! $VERSION = sprintf("%s", q$Id: complex.t,v 1.8 1998/02/05 16:03:39 jhi Exp $ =~ /(\d+\.d+)/);
my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
--- 14,20 ----
use Math::Complex;
! my $VERSION = sprintf("%s", q$Id: complex.t,v 1.9 1998/11/01 00:00:00 dsl Exp $ =~ /(\d+\.d+)/);
my ($args, $op, $target, $test, $test_set, $try, $val, $zvalue, @set, @val);
***************
*** 173,192 ****
'acoth(-1)',
);
- # test the 0**0
-
- sub test_ztz {
- $test++;
-
- push(@script, <<'EOT');
- eval 'cplx(0)**cplx(0)';
- print 'not ' unless ($@ =~ /zero raised to the zeroth/);
- EOT
- push(@script, qq(print "ok $test\\n";\n));
- }
-
- test_ztz;
-
# test the bad roots
sub test_broot {
--- 173,178 ----
***************
*** 387,392 ****
--- 373,379 ----
(1,0):(2,3):(1,0)
(2,3):(0,0):(1,0)
(2,3):(1,0):(2,3)
+ (0,0):(0,0):(1,0)
&Re
(3,4):3
***************
*** 876,879 ****
( 2,-3):( 0.14694666622553, 0.23182380450040)
# eof
-
--- 863,865 ----
diff -c 'perl5.005_02/t/lib/db-recno.t' 'perl5.005_03/t/lib/db-recno.t'
Index: ./t/lib/db-recno.t
*** ./t/lib/db-recno.t Thu Jul 23 23:02:14 1998
--- ./t/lib/db-recno.t Wed Mar 3 20:35:54 1999
***************
*** 42,55 ****
{
print STDERR <<EOM unless $bad_ones++ ;
#
! # Some older versions of Berkeley DB will fail tests 51, 53 and 55.
#
# You can safely ignore the errors if you're never going to use the
! # broken functionality (recno databases with a modified bval).
# Otherwise you'll have to upgrade your DB library.
#
! # If you want to upgrade Berkeley DB, the most recent version is 1.85.
! # Check out http://www.bostic.com/db for more details.
#
EOM
}
--- 42,57 ----
{
print STDERR <<EOM unless $bad_ones++ ;
#
! # Some older versions of Berkeley DB version 1 will fail tests 51,
! # 53 and 55.
#
# You can safely ignore the errors if you're never going to use the
! # broken functionality (recno databases with a modified bval).
# Otherwise you'll have to upgrade your DB library.
#
! # If you want to use Berkeley DB version 1, then 1.85 and 1.86 are the
! # last versions that were released. Berkeley DB version 2 is continually
! # being updated -- Check out http://www.sleepycat.com/ for more details.
#
EOM
}
diff -c 'perl5.005_02/t/lib/dumper.t' 'perl5.005_03/t/lib/dumper.t'
Index: ./t/lib/dumper.t
*** ./t/lib/dumper.t Thu Jul 23 23:02:14 1998
--- ./t/lib/dumper.t Sun Dec 13 10:31:54 1998
***************
*** 9,14 ****
--- 9,16 ----
}
use Data::Dumper;
+ use Config;
+ my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define';
$Data::Dumper::Pad = "#";
my $TMAX;
***************
*** 35,45 ****
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
! $TMAX = 138; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
! $TMAX = 69; $XS = 0;
}
print "1..$TMAX\n";
--- 37,47 ----
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
! $TMAX = 162; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
! $TMAX = 81; $XS = 0;
}
print "1..$TMAX\n";
***************
*** 234,246 ****
############# 43
##
$WANT = <<'EOT';
#$VAR1 = {
! # "abc\000\efg" => "mno\000"
#};
EOT
! $foo = { "abc\000\efg" => "mno\000" };
{
local $Data::Dumper::Useqq = 1;
TEST q(Dumper($foo));
--- 236,257 ----
############# 43
##
+ if (!$Is_ebcdic) {
$WANT = <<'EOT';
#$VAR1 = {
! # "abc\0'\efg" => "mno\0"
#};
EOT
+ }
+ else {
+ $WANT = <<'EOT';
+ #$VAR1 = {
+ # "\201\202\203\340\360'\340\205\206\207" => "\224\225\226\340\360"
+ #};
+ EOT
+ }
! $foo = { "abc\000\'\efg" => "mno\000" };
{
local $Data::Dumper::Useqq = 1;
TEST q(Dumper($foo));
***************
*** 248,254 ****
$WANT = <<"EOT";
#\$VAR1 = {
! # 'abc\000\efg' => 'mno\000'
#};
EOT
--- 259,265 ----
$WANT = <<"EOT";
#\$VAR1 = {
! # 'abc\0\\'\efg' => 'mno\0'
#};
EOT
***************
*** 444,461 ****
############# 85
##
$WANT = <<'EOT';
#%kennels = (
# First => \'Fido',
# Second => \'Wags'
#);
#@dogs = (
! # $kennels{First},
! # $kennels{Second},
# \%kennels
#);
#%mutts = %kennels;
EOT
TEST q(
$d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
--- 455,488 ----
############# 85
##
+ if (!$Is_ebcdic) {
$WANT = <<'EOT';
#%kennels = (
# First => \'Fido',
# Second => \'Wags'
#);
#@dogs = (
! # ${$kennels{First}},
! # ${$kennels{Second}},
! # \%kennels
! #);
! #%mutts = %kennels;
! EOT
! }
! else {
! $WANT = <<'EOT';
! #%kennels = (
! # Second => \'Wags',
! # First => \'Fido'
! #);
! #@dogs = (
! # ${$kennels{First}},
! # ${$kennels{Second}},
# \%kennels
#);
#%mutts = %kennels;
EOT
+ }
TEST q(
$d = Data::Dumper->new([\\%kennel, \\@dogs, $mutts],
***************
*** 483,501 ****
############# 97
##
$WANT = <<'EOT';
#%kennels = (
# First => \'Fido',
# Second => \'Wags'
#);
#@dogs = (
! # $kennels{First},
! # $kennels{Second},
# \%kennels
#);
#%mutts = %kennels;
EOT
!
TEST q($d->Reset; $d->Dump);
if ($XS) {
--- 510,543 ----
############# 97
##
+ if (!$Is_ebcdic) {
$WANT = <<'EOT';
#%kennels = (
# First => \'Fido',
# Second => \'Wags'
#);
#@dogs = (
! # ${$kennels{First}},
! # ${$kennels{Second}},
# \%kennels
#);
#%mutts = %kennels;
EOT
! }
! else {
! $WANT = <<'EOT';
! #%kennels = (
! # Second => \'Wags',
! # First => \'Fido'
! #);
! #@dogs = (
! # ${$kennels{First}},
! # ${$kennels{Second}},
! # \%kennels
! #);
! #%mutts = %kennels;
! EOT
! }
TEST q($d->Reset; $d->Dump);
if ($XS) {
***************
*** 504,510 ****
############# 103
##
! $WANT = <<'EOT';
#@dogs = (
# 'Fido',
# 'Wags',
--- 546,553 ----
############# 103
##
! if (!$Is_ebcdic) {
! $WANT = <<'EOT';
#@dogs = (
# 'Fido',
# 'Wags',
***************
*** 516,521 ****
--- 559,579 ----
#%kennels = %{$dogs[2]};
#%mutts = %{$dogs[2]};
EOT
+ }
+ else {
+ $WANT = <<'EOT';
+ #@dogs = (
+ # 'Fido',
+ # 'Wags',
+ # {
+ # Second => \$dogs[1],
+ # First => \$dogs[0]
+ # }
+ #);
+ #%kennels = %{$dogs[2]};
+ #%mutts = %{$dogs[2]};
+ EOT
+ }
TEST q(
$d = Data::Dumper->new([\\@dogs, \\%kennel, $mutts],
***************
*** 539,544 ****
--- 597,603 ----
############# 115
##
+ if (!$Is_ebcdic) {
$WANT = <<'EOT';
#@dogs = (
# 'Fido',
***************
*** 553,558 ****
--- 612,634 ----
# Second => \'Wags'
#);
EOT
+ }
+ else {
+ $WANT = <<'EOT';
+ #@dogs = (
+ # 'Fido',
+ # 'Wags',
+ # {
+ # Second => \'Wags',
+ # First => \'Fido'
+ # }
+ #);
+ #%kennels = (
+ # Second => \'Wags',
+ # First => \'Fido'
+ #);
+ EOT
+ }
TEST q(
$d = Data::Dumper->new( [\@dogs, \%kennel], [qw(*dogs *kennels)] );
***************
*** 566,573 ****
{
! sub a { print "foo\n" }
! $c = [ \&a ];
############# 121
##
--- 642,649 ----
{
! sub z { print "foo\n" }
! $c = [ \&z ];
############# 121
##
***************
*** 578,585 ****
#];
EOT
! TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dump;);
! TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'b' => \&a})->Dumpxs;)
if $XS;
############# 127
--- 654,661 ----
#];
EOT
! TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dump;);
! TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'b' => \&z})->Dumpxs;)
if $XS;
############# 127
***************
*** 591,598 ****
#];
EOT
! TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dump;);
! TEST q(Data::Dumper->new([\&a,$c],['a','c'])->Seen({'*b' => \&a})->Dumpxs;)
if $XS;
############# 133
--- 667,674 ----
#];
EOT
! TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dump;);
! TEST q(Data::Dumper->new([\&z,$c],['a','c'])->Seen({'*b' => \&z})->Dumpxs;)
if $XS;
############# 133
***************
*** 604,611 ****
#);
EOT
! TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dump;);
! TEST q(Data::Dumper->new([\&a,$c],['*a','*c'])->Seen({'*b' => \&a})->Dumpxs;)
if $XS;
}
--- 680,780 ----
#);
EOT
! TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dump;);
! TEST q(Data::Dumper->new([\&z,$c],['*a','*c'])->Seen({'*b' => \&z})->Dumpxs;)
! if $XS;
!
! }
!
! {
! $a = [];
! $a->[1] = \$a->[0];
!
! ############# 139
! ##
! $WANT = <<'EOT';
! #@a = (
! # undef,
! # ''
! #);
! #$a[1] = \$a[0];
! EOT
!
! TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dump;);
! TEST q(Data::Dumper->new([$a],['*a'])->Purity(1)->Dumpxs;)
! if $XS;
! }
!
! {
! $a = \\\\\'foo';
! $b = $$$a;
!
! ############# 145
! ##
! $WANT = <<'EOT';
! #$a = \\\\\'foo';
! #$b = ${${$a}};
! EOT
!
! TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
! TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
if $XS;
+ }
+
+ {
+ $a = [{ a => \$b }, { b => undef }];
+ $b = [{ c => \$b }, { d => \$a }];
+
+ ############# 151
+ ##
+ $WANT = <<'EOT';
+ #$a = [
+ # {
+ # a => \[
+ # {
+ # c => ''
+ # },
+ # {
+ # d => \[]
+ # }
+ # ]
+ # },
+ # {
+ # b => undef
+ # }
+ #];
+ #${$a->[0]{a}}->[0]->{c} = $a->[0]{a};
+ #${${$a->[0]{a}}->[1]->{d}} = $a;
+ #$b = ${$a->[0]{a}};
+ EOT
+ TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dump;);
+ TEST q(Data::Dumper->new([$a,$b],['a','b'])->Purity(1)->Dumpxs;)
+ if $XS;
+ }
+
+ {
+ $a = [[[[\\\\\'foo']]]];
+ $b = $a->[0][0];
+ $c = $${$b->[0][0]};
+
+ ############# 157
+ ##
+ $WANT = <<'EOT';
+ #$a = [
+ # [
+ # [
+ # [
+ # \\\\\'foo'
+ # ]
+ # ]
+ # ]
+ #];
+ #$b = $a->[0][0];
+ #$c = ${${$a->[0][0][0][0]}};
+ EOT
+
+ TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
+ TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
+ if $XS;
}
diff -c /dev/null 'perl5.005_03/t/lib/fatal.t'
Index: t/lib/fatal.t
*** t/lib/fatal.t Wed Dec 31 18:00:00 1969
--- t/lib/fatal.t Thu Mar 4 18:34:58 1999
***************
*** 0 ****
--- 1,27 ----
+ #!./perl -w
+
+ BEGIN {
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ print "1..9\n";
+ }
+
+ use strict;
+ use Fatal qw(open);
+
+ my $i = 1;
+ eval { open FOO, '<lkjqweriuapofukndajsdlfjnvcvn' };
+ print "not " unless $@ =~ /^Can't open/;
+ print "ok $i\n"; ++$i;
+
+ my $foo = 'FOO';
+ for ('$foo', "'$foo'", "*$foo", "\\*$foo") {
+ eval qq{ open $_, '<$0' };
+ print "not " if $@;
+ print "ok $i\n"; ++$i;
+
+ print "not " unless scalar(<FOO>) =~ m|^#!./perl|;
+ print "not " if $@;
+ print "ok $i\n"; ++$i;
+ close FOO;
+ }
diff -c 'perl5.005_02/t/lib/h2ph.pht' 'perl5.005_03/t/lib/h2ph.pht'
Index: ./t/lib/h2ph.pht
*** ./t/lib/h2ph.pht Thu Jul 23 23:02:15 1998
--- ./t/lib/h2ph.pht Thu Feb 11 18:06:14 1999
***************
*** 1,3 ****
--- 1,5 ----
+ require '_h2ph_pre.ph';
+
unless(defined(&SQUARE)) {
sub SQUARE {
local($x) = @_;
***************
*** 27,33 ****
if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
}
elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
! die("Nup, can't go on ");
} else {
eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
}
--- 29,35 ----
if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) {
}
elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) {
! die("Nup\,\ can\'t\ go\ on\ ");
} else {
eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK);
}
diff -c 'perl5.005_02/t/lib/io_udp.t' 'perl5.005_03/t/lib/io_udp.t'
Index: ./t/lib/io_udp.t
*** ./t/lib/io_udp.t Thu Jul 23 23:02:15 1998
--- ./t/lib/io_udp.t Wed Mar 17 18:06:02 1999
***************
*** 13,19 ****
if(-d "lib" && -f "TEST") {
if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
$Config{'extensions'} !~ /\bIO\b/ ||
! $^O eq 'os2') &&
!(($^O eq 'VMS') && $Config{d_socket})) {
print "1..0\n";
exit 0;
--- 13,19 ----
if(-d "lib" && -f "TEST") {
if ( ($Config{'extensions'} !~ /\bSocket\b/ ||
$Config{'extensions'} !~ /\bIO\b/ ||
! ($^O eq 'os2') || $^O eq 'apollo') &&
!(($^O eq 'VMS') && $Config{d_socket})) {
print "1..0\n";
exit 0;
diff -c 'perl5.005_02/t/lib/parsewords.t' 'perl5.005_03/t/lib/parsewords.t'
Index: ./t/lib/parsewords.t
*** ./t/lib/parsewords.t Thu Jul 23 23:02:16 1998
--- ./t/lib/parsewords.t Thu Jan 7 22:08:00 1999
***************
*** 7,13 ****
use Text::ParseWords;
! print "1..17\n";
@words = shellwords(qq(foo "bar quiz" zoo));
print "not " if $words[0] ne 'foo';
--- 7,13 ----
use Text::ParseWords;
! print "1..18\n";
@words = shellwords(qq(foo "bar quiz" zoo));
print "not " if $words[0] ne 'foo';
***************
*** 101,103 ****
--- 101,108 ----
$result = join('|', parse_line('\s+', 0, $string));
print "not " unless $result eq 'aaaabbbbb|cc cc|\"dddd eee\\\\"\'ffff|gg';
print "ok 17\n";
+
+ # test whitespace in the delimiters
+ @words = quotewords(' ', 1, '4 3 2 1 0');
+ print "not " unless join(";", @words) eq qq(4;3;2;1;0);
+ print "ok 18\n";
diff -c 'perl5.005_02/t/lib/posix.t' 'perl5.005_03/t/lib/posix.t'
Index: ./t/lib/posix.t
*** ./t/lib/posix.t Wed Aug 5 16:58:56 1998
--- ./t/lib/posix.t Sun Mar 14 15:01:23 1999
***************
*** 97,101 ****
$| = 0;
# The following line assumes buffered output, which may be not true with EMX:
! print '@#!*$@(!@#$' unless $^O eq 'os2';
_exit(0);
--- 97,101 ----
$| = 0;
# The following line assumes buffered output, which may be not true with EMX:
! print '@#!*$@(!@#$' unless ($^O eq 'os2' || $^O eq 'uwin' || $^O eq 'os390');
_exit(0);
diff -c 'perl5.005_02/t/lib/safe2.t' 'perl5.005_03/t/lib/safe2.t'
Index: ./t/lib/safe2.t
*** ./t/lib/safe2.t Thu Jul 23 23:02:16 1998
--- ./t/lib/safe2.t Thu Jan 28 19:15:20 1999
***************
*** 8,15 ****
print "1..0\n";
exit 0;
}
! # test 30 rather naughtily expects English error messages
! $ENV{'LC_ALL'} = 'C';
}
# Tests Todo:
--- 8,15 ----
print "1..0\n";
exit 0;
}
! # test 30 rather naughtily expects English error messages
! $ENV{'LC_ALL'} = 'C';
}
# Tests Todo:
***************
*** 122,132 ****
my $t = 30;
$cpt->rdo('/non/existant/file.name');
! print +(($! =~ /No such file/ || $! =~ /file specification syntax error/) ||
! $! =~ /A file or directory in the path name does not exist/ ||
! $! =~ /Invalid argument/ ||
! $! =~ /Device not configured/ ?
! "ok $t\n" : "not ok $t # $!\n"); $t++;
print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++;
#my $rdo_file = "tmp_rdo.tpl";
--- 122,130 ----
my $t = 30;
$cpt->rdo('/non/existant/file.name');
! # The regexp is getting rather baroque.
! print $! =~ /No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found/i ? "ok $t\n" : "not ok $t # $!\n"; $t++;
! # test #31 is gone.
print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++;
#my $rdo_file = "tmp_rdo.tpl";
diff -c 'perl5.005_02/t/lib/searchdict.t' 'perl5.005_03/t/lib/searchdict.t'
Index: ./t/lib/searchdict.t
*** ./t/lib/searchdict.t Thu Jul 23 23:02:16 1998
--- ./t/lib/searchdict.t Sun Dec 13 10:22:26 1998
***************
*** 5,11 ****
@INC = '../lib';
}
! print "1..3\n";
$DICT = <<EOT;
Aarhus
--- 5,11 ----
@INC = '../lib';
}
! print "1..4\n";
$DICT = <<EOT;
Aarhus
***************
*** 44,65 ****
binmode DICT; # To make length expected one.
print DICT $DICT;
! my $pos = look *DICT, "abash";
chomp($word = <DICT>);
! print "not " if $pos < 0 || $word ne "abash";
print "ok 1\n";
! $pos = look *DICT, "foo";
! chomp($word = <DICT>);
! print "not " if $pos != length($DICT); # will search to end of file
! print "ok 2\n";
$pos = look *DICT, "aarhus", 1, 1;
chomp($word = <DICT>);
print "not " if $pos < 0 || $word ne "Aarhus";
! print "ok 3\n";
close DICT or die "cannot close";
unlink "dict-$$";
--- 44,87 ----
binmode DICT; # To make length expected one.
print DICT $DICT;
! my $pos = look *DICT, "Ababa";
chomp($word = <DICT>);
! print "not " if $pos < 0 || $word ne "Ababa";
print "ok 1\n";
! if (ord('a') > ord('A') ) { # ASCII
!
! $pos = look *DICT, "foo";
! chomp($word = <DICT>);
!
! print "not " if $pos != length($DICT); # will search to end of file
! print "ok 2\n";
!
! my $pos = look *DICT, "abash";
! chomp($word = <DICT>);
! print "not " if $pos < 0 || $word ne "abash";
! print "ok 3\n";
!
! }
! else { # EBCDIC systems e.g. os390
!
! $pos = look *DICT, "FOO";
! chomp($word = <DICT>);
!
! print "not " if $pos != length($DICT); # will search to end of file
! print "ok 2\n";
! my $pos = look *DICT, "Abba";
! chomp($word = <DICT>);
! print "not " if $pos < 0 || $word ne "Abba";
! print "ok 3\n";
! }
$pos = look *DICT, "aarhus", 1, 1;
chomp($word = <DICT>);
print "not " if $pos < 0 || $word ne "Aarhus";
! print "ok 4\n";
close DICT or die "cannot close";
unlink "dict-$$";
diff -c /dev/null 'perl5.005_03/t/lib/textfill.t'
Index: t/lib/textfill.t
*** t/lib/textfill.t Wed Dec 31 18:00:00 1969
--- t/lib/textfill.t Thu Jan 28 21:32:05 1999
***************
*** 0 ****
--- 1,96 ----
+ #!./perl -w
+
+ BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+
+ @tests = (split(/\nEND\n/s, <<DONE));
+ TEST1
+ Cyberdog Information
+
+ Cyberdog & Netscape in the news
+ Important Press Release regarding Cyberdog and Netscape. Check it out!
+
+ Cyberdog Plug-in Support!
+ Cyberdog support for Netscape Plug-ins is now available to download! Go
+ to the Cyberdog Beta Download page and download it now!
+
+ Cyberdog Book
+ Check out Jesse Feiler's way-cool book about Cyberdog. You can find
+ details out about the book as well as ordering information at Philmont
+ Software Mill site.
+
+ Java!
+ Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and install
+ the Mac OS Runtime for Java and try it out!
+
+ Cyberdog 1.1 Beta 3
+ We hope that Cyberdog and OpenDoc 1.1 will be available within the next
+ two weeks. In the meantime, we have released another version of
+ Cyberdog, Cyberdog 1.1 Beta 3. This version fixes several bugs that were
+ reported to us during out public beta period. You can check out our release
+ notes to see what we fixed!
+ END
+ Cyberdog Information
+ Cyberdog & Netscape in the news Important Press Release regarding
+ Cyberdog and Netscape. Check it out!
+ Cyberdog Plug-in Support! Cyberdog support for Netscape Plug-ins is now
+ available to download! Go to the Cyberdog Beta Download page and download
+ it now!
+ Cyberdog Book Check out Jesse Feiler's way-cool book about Cyberdog.
+ You can find details out about the book as well as ordering information at
+ Philmont Software Mill site.
+ Java! Looking to view Java applets in Cyberdog 1.1 Beta 3? Download and
+ install the Mac OS Runtime for Java and try it out!
+ Cyberdog 1.1 Beta 3 We hope that Cyberdog and OpenDoc 1.1 will be
+ available within the next two weeks. In the meantime, we have released
+ another version of Cyberdog, Cyberdog 1.1 Beta 3. This version fixes
+ several bugs that were reported to us during out public beta period. You
+ can check out our release notes to see what we fixed!
+ END
+ DONE
+
+
+ $| = 1;
+
+ print "1..", @tests/2, "\n";
+
+ use Text::Wrap;
+
+ $rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
+
+ $tn = 1;
+ while (@tests) {
+ my $in = shift(@tests);
+ my $out = shift(@tests);
+
+ $in =~ s/^TEST(\d+)?\n//;
+
+ my $back = fill(' ', ' ', $in);
+
+ if ($back eq $out) {
+ print "ok $tn\n";
+ } elsif ($rerun) {
+ my $oi = $in;
+ open(F,">#o") and do { print F $back; close(F) };
+ open(F,">#e") and do { print F $out; close(F) };
+ foreach ($in, $back, $out) {
+ s/\t/^I\t/gs;
+ s/\n/\$\n/gs;
+ }
+ print "------------ input ------------\n";
+ print $in;
+ print "\n------------ output -----------\n";
+ print $back;
+ print "\n------------ expected ---------\n";
+ print $out;
+ print "\n-------------------------------\n";
+ $Text::Wrap::debug = 1;
+ fill(' ', ' ', $oi);
+ exit(1);
+ } else {
+ print "not ok $tn\n";
+ }
+ $tn++;
+ }
diff -c 'perl5.005_02/t/lib/textwrap.t' 'perl5.005_03/t/lib/textwrap.t'
Index: ./t/lib/textwrap.t
*** ./t/lib/textwrap.t Thu Jul 23 23:02:16 1998
--- ./t/lib/textwrap.t Thu Jan 28 19:15:21 1999
***************
*** 1,40 ****
! #!./perl
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
! print "1..5\n";
!
! use Text::Wrap qw(wrap $columns);
!
! $columns = 30;
!
! $text = <<'EOT';
! Text::Wrap is a very simple paragraph formatter. It formats a
! single paragraph at a time by breaking lines at word boundries.
! Indentation is controlled for the first line ($initial_tab) and
! all subsquent lines ($subsequent_tab) independently. $Text::Wrap::columns
! should be set to the full width of your output device.
! EOT
!
! $text =~ s/\n/ /g;
! $_ = wrap "| ", "|", $text;
!
! #print "$_\n";
!
! print "not " unless /^\| Text::Wrap is/; # start is ok
! print "ok 1\n";
!
! print "not " if /^.{31,}$/m; # no line longer than 30 chars
! print "ok 2\n";
!
! print "not " unless /^\|\w/m; # other lines start with
! print "ok 3\n";
!
! print "not " unless /\bsubsquent\b/; # look for a random word
! print "ok 4\n";
!
! print "not " unless /\bdevice\./; # look for last word
! print "ok 5\n";
--- 1,128 ----
! #!./perl -w
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
! @tests = (split(/\nEND\n/s, <<DONE));
! TEST1
! This
! is
! a
! test
! END
! This
! is
! a
! test
! END
! TEST2
! This is a test of a very long line. It should be broken up and put onto multiple lines.
! This is a test of a very long line. It should be broken up and put onto multiple lines.
!
! This is a test of a very long line. It should be broken up and put onto multiple lines.
! END
! This is a test of a very long line. It should be broken up and put onto
! multiple lines.
! This is a test of a very long line. It should be broken up and put onto
! multiple lines.
!
! This is a test of a very long line. It should be broken up and put onto
! multiple lines.
! END
! TEST3
! This is a test of a very long line. It should be broken up and put onto multiple lines.
! END
! This is a test of a very long line. It should be broken up and put onto
! multiple lines.
! END
! TEST4
! This is a test of a very long line. It should be broken up and put onto multiple lines.
!
! END
! This is a test of a very long line. It should be broken up and put onto
! multiple lines.
!
! END
! TEST5
! This is a test of a very long line. It should be broken up and put onto multiple This is a test of a very long line. It should be broken up and put
! END
! This is a test of a very long line. It should be broken up and put onto
! multiple This is a test of a very long line. It should be broken up and
! put
! END
! TEST6
! 11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
! END
! 11111111 22222222 33333333 44444444 55555555 66666666 77777777 888888888
! 999999999 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee ffffffff
! gggggggg hhhhhhhh iiiiiiii jjjjjjjj kkkkkkkk llllllll mmmmmmmmm nnnnnnnnn
! ooooooooo ppppppppp qqqqqqqqq rrrrrrrrr sssssssss
! END
! TEST7
! c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6 c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0 c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0 c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
! END
! c3t1d0s6 c4t1d0s6 c5t1d0s6 c6t1d0s6 c7t1d0s6 c8t1d0s6 c9t1d0s6 c10t1d0s6
! c11t1d0s6 c12t1d0s6 c13t1d0s6 c14t1d0s6 c15t1d0s6 c16t1d0s6 c3t1d0s0
! c4t1d0s0 c5t1d0s0 c6t1d0s0 c7t1d0s0 c8t1d0s0 c9t1d0s0 c10t1d0s0 c11t1d0s0
! c12t1d0s0 c13t1d0s0 c14t1d0s0 c15t1d0s0 c16t1d0s0
! END
! TEST8
! A test of a very very long word.
! a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
! END
! A test of a very very long word.
! a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
! 4567
! END
! TEST9
! A test of a very very long word. a123456789b123456789c123456789d123456789e123456789f123456789g123456789g1234567
! END
! A test of a very very long word.
! a123456789b123456789c123456789d123456789e123456789f123456789g123456789g123
! 4567
! END
! DONE
!
!
! $| = 1;
!
! print "1..", @tests/2, "\n";
!
! use Text::Wrap;
!
! $rerun = $ENV{'PERL_DL_NONLAZY'} ? 0 : 1;
!
! $tn = 1;
! while (@tests) {
! my $in = shift(@tests);
! my $out = shift(@tests);
!
! $in =~ s/^TEST(\d+)?\n//;
!
! my $back = wrap(' ', ' ', $in);
!
! if ($back eq $out) {
! print "ok $tn\n";
! } elsif ($rerun) {
! my $oi = $in;
! foreach ($in, $back, $out) {
! s/\t/^I\t/gs;
! s/\n/\$\n/gs;
! }
! print "------------ input ------------\n";
! print $in;
! print "\n------------ output -----------\n";
! print $back;
! print "\n------------ expected ---------\n";
! print $out;
! print "\n-------------------------------\n";
! $Text::Wrap::debug = 1;
! wrap(' ', ' ', $oi);
! exit(1);
! } else {
! print "not ok $tn\n";
! }
! $tn++;
! }
diff -c 'perl5.005_02/t/lib/thread.t' 'perl5.005_03/t/lib/thread.t'
Index: ./t/lib/thread.t
*** ./t/lib/thread.t Thu Jul 23 23:02:16 1998
--- ./t/lib/thread.t Sat Mar 27 22:21:29 1999
***************
*** 24,30 ****
}
# create a thread passing args and immedaietly wait for it.
! my $t = new Thread \&content,("ok 2\n","ok 3\n");
print $t->join;
# check that lock works ...
--- 24,30 ----
}
# create a thread passing args and immedaietly wait for it.
! my $t = new Thread \&content,("ok 2\n","ok 3\n", 1..1000);
print $t->join;
# check that lock works ...
diff -c 'perl5.005_02/t/op/array.t' 'perl5.005_03/t/op/array.t'
Index: ./t/op/array.t
*** ./t/op/array.t Thu Jul 23 23:02:17 1998
--- ./t/op/array.t Thu Nov 26 18:40:11 1998
***************
*** 1,6 ****
#!./perl
! print "1..63\n";
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
--- 1,6 ----
#!./perl
! print "1..65\n";
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
***************
*** 206,208 ****
--- 206,213 ----
t("@bee" eq "foo bar burbl blah"); # 63
}
+ # make sure reification behaves
+ my $t = 63;
+ sub reify { $_[1] = ++$t; print "@_\n"; }
+ reify('ok');
+ reify('ok');
diff -c 'perl5.005_02/t/op/die_exit.t' 'perl5.005_03/t/op/die_exit.t'
Index: ./t/op/die_exit.t
*** ./t/op/die_exit.t Sat Aug 1 23:26:01 1998
--- ./t/op/die_exit.t Sun Oct 25 13:02:55 1998
***************
*** 31,37 ****
15 => [ 255, 1],
16 => [ 255, 256],
# see if implicit close preserves $?
! 17 => [ 42, 42, '{ local *F; open F, q[TEST]; close F } die;'],
);
my $max = keys %tests;
--- 31,37 ----
15 => [ 255, 1],
16 => [ 255, 256],
# see if implicit close preserves $?
! 17 => [ 0, 512, '{ local *F; open F, q[TEST]; close F } die;'],
);
my $max = keys %tests;
***************
*** 46,53 ****
? system qq($perl -e "\$! = $bang; \$? = $query; $code" 2> nul)
: system qq($perl -e '\$! = $bang; \$? = $query; $code' 2> /dev/null));
! printf "# 0x%04x 0x%04x 0x%04x\nnot ", $exit, $bang, $query
! unless $exit == (($bang || ($query >> 8) || 255) << 8);
print "ok $test\n";
}
--- 46,53 ----
? system qq($perl -e "\$! = $bang; \$? = $query; $code" 2> nul)
: system qq($perl -e '\$! = $bang; \$? = $query; $code' 2> /dev/null));
! printf "# 0x%04x 0x%04x 0x%04x\n", $exit, $bang, $query;
! print "not " unless $exit == (($bang || ($query >> 8) || 255) << 8);
print "ok $test\n";
}
diff -c 'perl5.005_02/t/op/eval.t' 'perl5.005_03/t/op/eval.t'
Index: ./t/op/eval.t
*** ./t/op/eval.t Thu Jul 23 23:02:17 1998
--- ./t/op/eval.t Thu Mar 4 18:34:58 1999
***************
*** 1,8 ****
#!./perl
! # $RCSfile: eval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:48 $
!
! print "1..23\n";
eval 'print "ok 1\n";';
--- 1,6 ----
#!./perl
! print "1..36\n";
eval 'print "ok 1\n";';
***************
*** 79,81 ****
--- 77,173 ----
};
&$x();
}
+
+ my $b = 'wrong';
+ my $X = sub {
+ my $b = "right";
+ print eval('"$b"') eq $b ? "ok 24\n" : "not ok 24\n";
+ };
+ &$X();
+
+
+ # check navigation of multiple eval boundaries to find lexicals
+
+ my $x = 25;
+ eval <<'EOT'; die if $@;
+ print "# $x\n"; # clone into eval's pad
+ sub do_eval1 {
+ eval $_[0]; die if $@;
+ }
+ EOT
+ do_eval1('print "ok $x\n"');
+ $x++;
+ do_eval1('eval q[print "ok $x\n"]');
+ $x++;
+ do_eval1('sub { eval q[print "ok $x\n"] }->()');
+ $x++;
+
+ # calls from within eval'' should clone outer lexicals
+
+ eval <<'EOT'; die if $@;
+ sub do_eval2 {
+ eval $_[0]; die if $@;
+ }
+ do_eval2('print "ok $x\n"');
+ $x++;
+ do_eval2('eval q[print "ok $x\n"]');
+ $x++;
+ do_eval2('sub { eval q[print "ok $x\n"] }->()');
+ $x++;
+ EOT
+
+ # calls outside eval'' should NOT clone lexicals from called context
+
+ $main::x = 'ok';
+ eval <<'EOT'; die if $@;
+ # $x unbound here
+ sub do_eval3 {
+ eval $_[0]; die if $@;
+ }
+ EOT
+ do_eval3('print "$x ' . $x . '\n"');
+ $x++;
+ do_eval3('eval q[print "$x ' . $x . '\n"]');
+ $x++;
+ do_eval3('sub { eval q[print "$x ' . $x . '\n"] }->()');
+ $x++;
+
+ # can recursive subroutine-call inside eval'' see its own lexicals?
+ sub recurse {
+ my $l = shift;
+ if ($l < $x) {
+ ++$l;
+ eval 'print "# level $l\n"; recurse($l);';
+ die if $@;
+ }
+ else {
+ print "ok $l\n";
+ }
+ }
+ {
+ local $SIG{__WARN__} = sub { die "not ok $x\n" if $_[0] =~ /^Deep recurs/ };
+ recurse($x-5);
+ }
+ $x++;
+
+ # do closures created within eval bind correctly?
+ eval <<'EOT';
+ sub create_closure {
+ my $self = shift;
+ return sub {
+ print $self;
+ };
+ }
+ EOT
+ create_closure("ok $x\n")->();
+ $x++;
+
+ # does lexical search terminate correctly at subroutine boundary?
+ $main::r = "ok $x\n";
+ sub terminal { eval 'print $r' }
+ {
+ my $r = "not ok $x\n";
+ eval 'terminal($r)';
+ }
+ $x++;
+
diff -c 'perl5.005_02/t/op/goto.t' 'perl5.005_03/t/op/goto.t'
Index: ./t/op/goto.t
*** ./t/op/goto.t Thu Jul 23 23:02:18 1998
--- ./t/op/goto.t Sun Nov 1 22:47:58 1998
***************
*** 1,10 ****
#!./perl
- # $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $
-
# "This IS structured code. It's just randomly structured."
! print "1..9\n";
while ($?) {
$foo = 1;
--- 1,8 ----
#!./perl
# "This IS structured code. It's just randomly structured."
! print "1..13\n";
while ($?) {
$foo = 1;
***************
*** 56,62 ****
exit;
FINALE:
! print "ok 9\n";
exit;
bypass:
--- 54,60 ----
exit;
FINALE:
! print "ok 13\n";
exit;
bypass:
***************
*** 85,90 ****
--- 83,105 ----
$wherever = NOWHERE;
eval { goto $wherever };
print $@ =~ /Can't find label NOWHERE/ ? "ok 8\n" : "not ok 8\n";
+
+ # see if a modified @_ propagates
+ {
+ package Foo;
+ sub DESTROY { my $s = shift; print "ok $s->[0]\n"; }
+ sub show { print "# @_\nnot ok $_[0][0]\n" if @_ != 5; }
+ sub start { push @_, 1, "foo", {}; goto &show; }
+ for (9..11) { start(bless([$_]), 'bar'); }
+ }
+
+ sub auto {
+ goto &loadit;
+ }
+
+ sub AUTOLOAD { print @_ }
+
+ auto("ok 12\n");
$wherever = FINALE;
goto $wherever;
diff -c /dev/null 'perl5.005_03/t/op/grep.t'
Index: t/op/grep.t
*** t/op/grep.t Wed Dec 31 18:00:00 1969
--- t/op/grep.t Sun Mar 28 10:13:21 1999
***************
*** 0 ****
--- 1,31 ----
+ #!./perl
+
+ #
+ # grep() and map() tests
+ #
+
+ print "1..3\n";
+
+ $test = 1;
+
+ sub ok {
+ my ($got,$expect) = @_;
+ print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
+ print "ok $test\n";
+ }
+
+ {
+ my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
+ my @mapped = map {scalar @$_} @lol;
+ ok "@mapped", "3 0 3";
+ $test++;
+
+ my @grepped = grep {scalar @$_} @lol;
+ ok "@grepped", "$lol[0] $lol[2]";
+ $test++;
+
+ @grepped = grep { $_ } @mapped;
+ ok "@grepped", "3 3";
+ $test++;
+ }
+
diff -c 'perl5.005_02/t/op/local.t' 'perl5.005_03/t/op/local.t'
Index: ./t/op/local.t
*** ./t/op/local.t Thu Jul 23 23:02:18 1998
--- ./t/op/local.t Sat Feb 13 12:06:04 1999
***************
*** 1,8 ****
#!./perl
! # $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
!
! print "1..58\n";
# XXX known to leak scalars
$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
--- 1,6 ----
#!./perl
! print "1..69\n";
# XXX known to leak scalars
$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
***************
*** 197,200 ****
--- 195,237 ----
print +($ENV{_X_} eq 'a') ? "" : "not ", "ok 56\n";
print +($ENV{_Y_} eq 'b') ? "" : "not ", "ok 57\n";
print +($ENV{_Z_} eq 'c') ? "" : "not ", "ok 58\n";
+
+ # does implicit localization in foreach skip magic?
+
+ $_ = "ok 59,ok 60,";
+ my $iter = 0;
+ while (/(o.+?),/gc) {
+ print "$1\n";
+ foreach (1..1) { $iter++ }
+ if ($iter > 2) { print "not ok 60\n"; last; }
+ }
+
+ {
+ package UnderScore;
+ sub TIESCALAR { bless \my $self, shift }
+ sub FETCH { die "read \$_ forbidden" }
+ sub STORE { die "write \$_ forbidden" }
+ tie $_, __PACKAGE__;
+ my $t = 61;
+ my @tests = (
+ "Nesting" => sub { print '#'; for (1..3) { print }
+ print "\n" }, 1,
+ "Reading" => sub { print }, 0,
+ "Matching" => sub { $x = /badness/ }, 0,
+ "Concat" => sub { $_ .= "a" }, 0,
+ "Chop" => sub { chop }, 0,
+ "Filetest" => sub { -x }, 0,
+ "Assignment" => sub { $_ = "Bad" }, 0,
+ # XXX whether next one should fail is debatable
+ "Local \$_" => sub { local $_ = 'ok?'; print }, 0,
+ "for local" => sub { for("#ok?\n"){ print } }, 1,
+ );
+ while ( ($name, $code, $ok) = splice(@tests, 0, 3) ) {
+ print "# Testing $name\n";
+ eval { &$code };
+ print(($ok xor $@) ? "ok $t\n" : "not ok $t\n");
+ ++$t;
+ }
+ untie $_;
+ }
diff -c 'perl5.005_02/t/op/misc.t' 'perl5.005_03/t/op/misc.t'
Index: ./t/op/misc.t
*** ./t/op/misc.t Sun Aug 2 00:15:09 1998
--- ./t/op/misc.t Fri Feb 19 09:45:26 1999
***************
*** 36,42 ****
$status = $?;
$results = `$CAT $tmpfile`;
$results =~ s/\n+$//;
! $results =~ s/syntax error/syntax error/i;
$expected =~ s/\n+$//;
if ( $results ne $expected){
print STDERR "PROG: $switch\n$prog\n";
--- 36,44 ----
$status = $?;
$results = `$CAT $tmpfile`;
$results =~ s/\n+$//;
! # bison says 'parse error' instead of 'syntax error',
! # various yaccs may or may not capitalize 'syntax'.
! $results =~ s/^(syntax|parse) error/syntax error/mig;
$expected =~ s/\n+$//;
if ( $results ne $expected){
print STDERR "PROG: $switch\n$prog\n";
***************
*** 418,420 ****
--- 420,448 ----
destroyed
destroyed
########
+ BEGIN {
+ $| = 1;
+ $SIG{__WARN__} = sub {
+ eval { print $_[0] };
+ die "bar\n";
+ };
+ warn "foo\n";
+ }
+ EXPECT
+ foo
+ bar
+ BEGIN failed--compilation aborted at - line 8.
+ ########
+ use strict;
+ my $foo = "ZZZ\n";
+ END { print $foo }
+ EXPECT
+ ZZZ
+ ########
+ eval '
+ use strict;
+ my $foo = "ZZZ\n";
+ END { print $foo }
+ ';
+ EXPECT
+ ZZZ
diff -c 'perl5.005_02/t/op/mkdir.t' 'perl5.005_03/t/op/mkdir.t'
Index: ./t/op/mkdir.t
*** ./t/op/mkdir.t Thu Jul 23 23:02:18 1998
--- ./t/op/mkdir.t Thu Jan 28 19:15:23 1999
***************
*** 15,18 ****
print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
! print ($! =~ /such|exist/ ? "ok 7\n" : "not ok 7\n");
--- 15,18 ----
print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
! print ($! =~ /such|exist|not found/i ? "ok 7\n" : "not ok 7\n");
diff -c 'perl5.005_02/t/op/oct.t' 'perl5.005_03/t/op/oct.t'
Index: ./t/op/oct.t
*** ./t/op/oct.t Thu Jul 23 23:02:18 1998
--- ./t/op/oct.t Sun Oct 25 12:27:31 1998
***************
*** 1,8 ****
#!./perl
! # $RCSfile: oct.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:08 $
!
! print "1..8\n";
print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
--- 1,6 ----
#!./perl
! print "1..9\n";
print +(oct('01234') == 01234) ? "ok" : "not ok", " 1\n";
print +(oct('0x1234') == 0x1234) ? "ok" : "not ok", " 2\n";
***************
*** 12,14 ****
--- 10,13 ----
print +(hex('80000000') == 0x80000000) ? "ok" : "not ok", " 6\n";
print +(oct('1234') == 668) ? "ok" : "not ok", " 7\n";
print +(hex('1234') == 4660) ? "ok" : "not ok", " 8\n";
+ print +(hex('0x1234') == 0x1234) ? "ok" : "not ok", " 9\n";
diff -c 'perl5.005_02/t/op/pack.t' 'perl5.005_03/t/op/pack.t'
Index: ./t/op/pack.t
*** ./t/op/pack.t Sun Aug 2 18:35:57 1998
--- ./t/op/pack.t Sat Mar 27 22:14:48 1999
***************
*** 1,8 ****
#!./perl
! # $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
! print "1..60\n";
$format = "c2 x5 C C x s d i l a6";
# Need the expression in here to force ary[5] to be numeric. This avoids
--- 1,12 ----
#!./perl
! BEGIN {
! chdir 't' if -d 't';
! unshift @INC, '../lib' if -d '../lib';
! require Config; import Config;
! }
! print "1..142\n";
$format = "c2 x5 C C x s d i l a6";
# Need the expression in here to force ary[5] to be numeric. This avoids
***************
*** 31,37 ****
? "ok 6\n" : "not ok 6 $x\n";
my $sum = 129; # ASCII
! $sum = 103 if ($^O eq 'os390'); # An EBCDIC variant.
print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == $sum
? "ok 7\n" : "not ok 7 $x\n";
--- 35,41 ----
? "ok 6\n" : "not ok 6 $x\n";
my $sum = 129; # ASCII
! $sum = 103 if ($Config{ebcdic} eq 'define');
print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == $sum
? "ok 7\n" : "not ok 7 $x\n";
***************
*** 160,166 ****
# 57..60: uuencode/decode
! $in = join "", map { chr } 0..255;
# just to be anal, we do some random tr/`/ /
$uu = <<'EOUU';
--- 164,175 ----
# 57..60: uuencode/decode
! # Note that first uuencoding known 'text' data and then checking the
! # binary values of the uuencoded version would not be portable between
! # character sets. Uuencoding is meant for encoding binary data, not
! # text data.
!
! $in = pack 'C*', 0 .. 255;
# just to be anal, we do some random tr/`/ /
$uu = <<'EOUU';
***************
*** 199,205 ****
print "not " unless unpack('u', $uu) eq $in;
print "ok ", $test++, "\n";
! # Note that first uuencoding known 'text' data and then checking the
! # binary values of the uuencoded version would not be portable between
! # character sets. Uuencoding is meant for encoding binary data, not
! # text data.
--- 208,357 ----
print "not " unless unpack('u', $uu) eq $in;
print "ok ", $test++, "\n";
! # 61..72: test the ascii template types (A, a, Z)
!
! print "not " unless pack('A*', "foo\0bar\0 ") eq "foo\0bar\0 ";
! print "ok ", $test++, "\n";
!
! print "not " unless pack('A11', "foo\0bar\0 ") eq "foo\0bar\0 ";
! print "ok ", $test++, "\n";
!
! print "not " unless unpack('A*', "foo\0bar \0") eq "foo\0bar";
! print "ok ", $test++, "\n";
!
! print "not " unless unpack('A8', "foo\0bar \0") eq "foo\0bar";
! print "ok ", $test++, "\n";
!
! print "not " unless pack('a*', "foo\0bar\0 ") eq "foo\0bar\0 ";
! print "ok ", $test++, "\n";
!
! print "not " unless pack('a11', "foo\0bar\0 ") eq "foo\0bar\0 \0\0";
! print "ok ", $test++, "\n";
!
! print "not " unless unpack('a*', "foo\0bar \0") eq "foo\0bar \0";
! print "ok ", $test++, "\n";
!
! print "not " unless unpack('a8', "foo\0bar \0") eq "foo\0bar ";
! print "ok ", $test++, "\n";
!
! print "not " unless pack('Z*', "foo\0bar\0 ") eq "foo\0bar\0 ";
! print "ok ", $test++, "\n";
!
! print "not " unless pack('Z11', "foo\0bar\0 ") eq "foo\0bar\0 \0\0";
! print "ok ", $test++, "\n";
!
! print "not " unless unpack('Z*', "foo\0bar \0") eq "foo";
! print "ok ", $test++, "\n";
!
! print "not " unless unpack('Z8', "foo\0bar \0") eq "foo";
! print "ok ", $test++, "\n";
!
! # 73..78: packing native shorts/ints/longs
!
! # integrated from mainline and don't want to change numbers all the way
! # down. native ints are not supported in _0x so comment out checks
! #print "not " unless length(pack("s!", 0)) == $Config{shortsize};
! print "ok ", $test++, "\n";
!
! #print "not " unless length(pack("i!", 0)) == $Config{intsize};
! print "ok ", $test++, "\n";
!
! #print "not " unless length(pack("l!", 0)) == $Config{longsize};
! print "ok ", $test++, "\n";
!
! #print "not " unless length(pack("s!", 0)) <= length(pack("i!", 0));
! print "ok ", $test++, "\n";
!
! #print "not " unless length(pack("i!", 0)) <= length(pack("l!", 0));
! print "ok ", $test++, "\n";
!
! #print "not " unless length(pack("i!", 0)) == length(pack("i", 0));
! print "ok ", $test++, "\n";
!
! # 79..138: pack <-> unpack bijectionism
!
! # 79.. 83 c
! foreach my $c (-128, -1, 0, 1, 127) {
! print "not " unless unpack("c", pack("c", $c)) == $c;
! print "ok ", $test++, "\n";
! }
!
! # 84.. 88: C
! foreach my $C (0, 1, 127, 128, 255) {
! print "not " unless unpack("C", pack("C", $C)) == $C;
! print "ok ", $test++, "\n";
! }
!
! # 89.. 93: s
! foreach my $s (-32768, -1, 0, 1, 32767) {
! print "not " unless unpack("s", pack("s", $s)) == $s;
! print "ok ", $test++, "\n";
! }
!
! # 94.. 98: S
! foreach my $S (0, 1, 32767, 32768, 65535) {
! print "not " unless unpack("S", pack("S", $S)) == $S;
! print "ok ", $test++, "\n";
! }
!
! # 99..103: i
! foreach my $i (-2147483648, -1, 0, 1, 2147483647) {
! print "not " unless unpack("i", pack("i", $i)) == $i;
! print "ok ", $test++, "\n";
! }
!
! # 104..108: I
! foreach my $I (0, 1, 2147483647, 2147483648, 4294967295) {
! print "not " unless unpack("I", pack("I", $I)) == $I;
! print "ok ", $test++, "\n";
! }
!
! # 109..113: l
! foreach my $l (-2147483648, -1, 0, 1, 2147483647) {
! print "not " unless unpack("l", pack("l", $l)) == $l;
! print "ok ", $test++, "\n";
! }
!
! # 114..118: L
! foreach my $L (0, 1, 2147483647, 2147483648, 4294967295) {
! print "not " unless unpack("L", pack("L", $L)) == $L;
! print "ok ", $test++, "\n";
! }
!
! # 119..123: n
! foreach my $n (0, 1, 32767, 32768, 65535) {
! print "not " unless unpack("n", pack("n", $n)) == $n;
! print "ok ", $test++, "\n";
! }
!
! # 124..128: v
! foreach my $v (0, 1, 32767, 32768, 65535) {
! print "not " unless unpack("v", pack("v", $v)) == $v;
! print "ok ", $test++, "\n";
! }
!
! # 129..133: N
! foreach my $N (0, 1, 2147483647, 2147483648, 4294967295) {
! print "not " unless unpack("N", pack("N", $N)) == $N;
! print "ok ", $test++, "\n";
! }
!
! # 134..138: V
! foreach my $V (0, 1, 2147483647, 2147483648, 4294967295) {
! print "not " unless unpack("V", pack("V", $V)) == $V;
! print "ok ", $test++, "\n";
! }
!
! # 139..142: pack nvNV byteorders
!
! print "not " unless pack("n", 0xdead) eq "\xde\xad";
! print "ok ", $test++, "\n";
!
! print "not " unless pack("v", 0xdead) eq "\xad\xde";
! print "ok ", $test++, "\n";
!
! print "not " unless pack("N", 0xdeadbeef) eq "\xde\xad\xbe\xef";
! print "ok ", $test++, "\n";
!
! print "not " unless pack("V", 0xdeadbeef) eq "\xef\xbe\xad\xde";
! print "ok ", $test++, "\n";
diff -c 'perl5.005_02/t/op/pat.t' 'perl5.005_03/t/op/pat.t'
Index: ./t/op/pat.t
*** ./t/op/pat.t Thu Jul 23 23:02:19 1998
--- ./t/op/pat.t Sat Oct 31 17:55:42 1998
***************
*** 4,10 ****
# 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..141\n";
BEGIN {
chdir 't' if -d 't';
--- 4,10 ----
# 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..142\n";
BEGIN {
chdir 't' if -d 't';
***************
*** 593,597 ****
--- 593,602 ----
@_ = /(bbb)/g;
print "not " if @_;
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";
$test++;
diff -c 'perl5.005_02/t/op/range.t' 'perl5.005_03/t/op/range.t'
Index: ./t/op/range.t
*** ./t/op/range.t Thu Jul 23 23:02:19 1998
--- ./t/op/range.t Thu Mar 4 18:34:58 1999
***************
*** 1,6 ****
#!./perl
! print "1..10\n";
print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
--- 1,6 ----
#!./perl
! print "1..12\n";
print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
***************
*** 45,48 ****
--- 45,57 ----
}
print "not " unless join(",", @y) eq join(",", @x);
print "ok 10\n";
+
+ # check bounds
+ @a = 0x7ffffffe..0x7fffffff;
+ print "not " unless "@a" eq "2147483646 2147483647";
+ print "ok 11\n";
+
+ @a = -0x7fffffff..-0x7ffffffe;
+ print "not " unless "@a" eq "-2147483647 -2147483646";
+ print "ok 12\n";
diff -c 'perl5.005_02/t/op/re_tests' 'perl5.005_03/t/op/re_tests'
Index: ./t/op/re_tests
*** ./t/op/re_tests Sun Aug 2 00:15:09 1998
--- ./t/op/re_tests Thu Oct 29 19:28:52 1998
***************
*** 335,340 ****
--- 335,343 ----
^(a(?(1)\1)){4}$ aaaaaaaaaa y $1 aaaa
^(a(?(1)\1)){4}$ aaaaaaaaa n - -
^(a(?(1)\1)){4}$ aaaaaaaaaaa n - -
+ ((a{4})+) aaaaaaaaa y $1 aaaaaaaa
+ (((aa){2})+) aaaaaaaaaa y $1 aaaaaaaa
+ (((a{2}){2})+) aaaaaaaaaa y $1 aaaaaaaa
(?:(f)(o)(o)|(b)(a)(r))* foobar y $1:$2:$3:$4:$5:$6 f:o:o:b:a:r
(?<=a)b ab y $& b
(?<=a)b cb n - -
***************
*** 483,485 ****
--- 486,491 ----
b\z a\nb\n n - -
b\Z a\nb y - -
b\z a\nb y - -
+ (^|x)(c) ca y $2 c
+ a*abc?xyz+pqr{3}ab{2,}xy{4,5}pq{0,6}AB{0,}zz x n - -
+ round\(((?>[^()]+))\) _I(round(xs * sz),1) y $1 xs * sz
diff -c 'perl5.005_02/t/op/repeat.t' 'perl5.005_03/t/op/repeat.t'
Index: ./t/op/repeat.t
*** ./t/op/repeat.t Thu Jul 23 23:02:20 1998
--- ./t/op/repeat.t Tue Dec 29 08:48:53 1998
***************
*** 2,8 ****
# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $
! print "1..19\n";
# compile time
--- 2,8 ----
# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $
! print "1..20\n";
# compile time
***************
*** 40,42 ****
--- 40,93 ----
print join(':', (9) x 4) eq '9:9:9:9' ? "ok 17\n" : "not ok 17\n";
print join(':', (9,9) x 4) eq '9:9:9:9:9:9:9:9' ? "ok 18\n" : "not ok 18\n";
print join('', (split(//,"123")) x 2) eq '123123' ? "ok 19\n" : "not ok 19\n";
+
+ #
+ # The test #20 is actually testing for Digital C compiler optimizer bug.
+ #
+ # Dec C versions 5.* and 6.0 (used in Digital UNIX and VMS) used
+ # to produce (as of December 1998) broken code for util.c:repeatcpy()
+ # (a utility function for the 'x' operator) in the case *all* these
+ # four conditions held:
+ #
+ # (1) len == 1
+ # (2) "from" had the 8th bit on in its single character
+ # (3) count > 7 (the 'x' count > 16)
+ # (4) the highest optimization level was used in compilation
+ # (which is the default when compiling Perl)
+ #
+ # The bug looked like this (. being the eight-bit character and ? being \xff):
+ #
+ # 16 ................
+ # 17 .........???????.
+ # 18 .........???????..
+ # 19 .........???????...
+ # 20 .........???????....
+ # 21 .........???????.....
+ # 22 .........???????......
+ # 23 .........???????.......
+ # 24 .........???????.???????
+ # 25 .........???????.???????.
+ #
+ # The bug could be (obscurely) avoided by changing "from" to
+ # be an unsigned char pointer.
+ #
+ # The bug was triggered in the "if (len == 1)" branch. The fix
+ # was to introduce a new temporary variable. In diff -u format:
+ #
+ # register char *frombase = from;
+ #
+ # if (len == 1) {
+ #- todo = *from;
+ #+ register char c = *from;
+ # while (count-- > 0)
+ #- *to++ = todo;
+ #+ *to++ = c;
+ # return;
+ # }
+ #
+ # This obscure bug was not found by the then test suite but instead
+ # by Mark.Martinec@nsc.ijs.si while trying to install Digest-MD5-2.00.
+ #
+ # jhi@iki.fi
+ #
+ print "\xdd" x 24 eq "\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd\xdd" ? "ok 20\n" : "not ok 20\n";
diff -c 'perl5.005_02/t/op/runlevel.t' 'perl5.005_03/t/op/runlevel.t'
Index: ./t/op/runlevel.t
*** ./t/op/runlevel.t Thu Jul 23 23:02:20 1998
--- ./t/op/runlevel.t Sat Oct 31 17:40:25 1998
***************
*** 315,317 ****
--- 315,337 ----
In DIE
main|-|10|(eval)
main|-|10|main::foo
+ ########
+ package TEST;
+
+ sub TIEARRAY {
+ return bless [qw(foo fee fie foe)], $_[0];
+ }
+ sub FETCH {
+ my ($s,$i) = @_;
+ if ($i) {
+ goto bbb;
+ }
+ bbb:
+ return $s->[$i];
+ }
+
+ package main;
+ tie my @bar, 'TEST';
+ print join('|', @bar[0..3]), "\n";
+ EXPECT
+ foo|fee|fie|foe
diff -c 'perl5.005_02/t/op/sort.t' 'perl5.005_03/t/op/sort.t'
Index: ./t/op/sort.t
*** ./t/op/sort.t Sun Aug 2 00:15:09 1998
--- ./t/op/sort.t Sun Nov 29 16:35:36 1998
***************
*** 1,8 ****
#!./perl
! # $RCSfile: sort.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:24 $
! print "1..21\n";
sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
--- 1,9 ----
#!./perl
! print "1..29\n";
! # XXX known to leak scalars
! $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
***************
*** 125,127 ****
--- 126,159 ----
my @result = sort 'one', 'two';
CODE
print $@ ? "not ok 21\n# $@" : "ok 21\n";
+
+ {
+ my $sortsub = \&backwards;
+ my $sortglob = *backwards;
+ my $sortglobr = \*backwards;
+ my $sortname = 'backwards';
+ @b = sort $sortsub 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 22\n" : "not ok 22 |@b|\n");
+ @b = sort $sortglob 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 23\n" : "not ok 23 |@b|\n");
+ @b = sort $sortname 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 24\n" : "not ok 24 |@b|\n");
+ @b = sort $sortglobr 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 25\n" : "not ok 25 |@b|\n");
+ }
+
+ {
+ local $sortsub = \&backwards;
+ local $sortglob = *backwards;
+ local $sortglobr = \*backwards;
+ local $sortname = 'backwards';
+ @b = sort $sortsub 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 26\n" : "not ok 26 |@b|\n");
+ @b = sort $sortglob 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 27\n" : "not ok 27 |@b|\n");
+ @b = sort $sortname 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 28\n" : "not ok 28 |@b|\n");
+ @b = sort $sortglobr 4,1,3,2;
+ print ("@b" eq '4 3 2 1' ? "ok 29\n" : "not ok 29 |@b|\n");
+ }
+
diff -c 'perl5.005_02/t/op/sysio.t' 'perl5.005_03/t/op/sysio.t'
Index: ./t/op/sysio.t
*** ./t/op/sysio.t Thu Jul 23 23:02:21 1998
--- ./t/op/sysio.t Tue Jan 5 20:26:13 1999
***************
*** 1,12 ****
#!./perl
! print "1..36\n";
chdir('op') || die "sysio.t: cannot look for myself: $!";
open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
! $reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos');
$x = 'abc';
--- 1,13 ----
#!./perl
! print "1..39\n";
chdir('op') || die "sysio.t: cannot look for myself: $!";
open(I, 'sysio.t') || die "sysio.t: cannot find myself: $!";
! $reopen = ($^O eq 'VMS' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'dos' ||
! $^O eq 'mpeix');
$x = 'abc';
***************
*** 151,156 ****
--- 152,172 ----
print 'not ' unless (-s $outfile == 7);
print "ok 28\n";
+ # with implicit length argument
+ print 'not ' unless (syswrite(O, $x) == 3);
+ print "ok 29\n";
+
+ # $a still intact
+ print 'not ' unless ($x eq "abc");
+ print "ok 30\n";
+
+ # $outfile should have grown now
+ if ($reopen) { # must close file to update EOF marker for stat
+ close O; open(O, ">>$outfile") || die "sysio.t: cannot write $outfile: $!";
+ }
+ print 'not ' unless (-s $outfile == 10);
+ print "ok 31\n";
+
close(O);
open(I, $outfile) || die "sysio.t: cannot read $outfile: $!";
***************
*** 158,187 ****
$b = 'xyz';
# reading too much only return as much as available
! print 'not ' unless (sysread(I, $b, 100) == 7);
! print "ok 29\n";
# this we should have
! print 'not ' unless ($b eq '#!ererl');
! print "ok 30\n";
# test sysseek
print 'not ' unless sysseek(I, 2, 0) == 2;
! print "ok 31\n";
sysread(I, $b, 3);
print 'not ' unless $b eq 'ere';
! print "ok 32\n";
print 'not ' unless sysseek(I, -2, 1) == 3;
! print "ok 33\n";
sysread(I, $b, 4);
print 'not ' unless $b eq 'rerl';
! print "ok 34\n";
print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
! print "ok 35\n";
print 'not ' if defined sysseek(I, -1, 1);
! print "ok 36\n";
close(I);
--- 174,203 ----
$b = 'xyz';
# reading too much only return as much as available
! print 'not ' unless (sysread(I, $b, 100) == 10);
! print "ok 32\n";
# this we should have
! print 'not ' unless ($b eq '#!ererlabc');
! print "ok 33\n";
# test sysseek
print 'not ' unless sysseek(I, 2, 0) == 2;
! print "ok 34\n";
sysread(I, $b, 3);
print 'not ' unless $b eq 'ere';
! print "ok 35\n";
print 'not ' unless sysseek(I, -2, 1) == 3;
! print "ok 36\n";
sysread(I, $b, 4);
print 'not ' unless $b eq 'rerl';
! print "ok 37\n";
print 'not ' unless sysseek(I, 0, 0) eq '0 but true';
! print "ok 38\n";
print 'not ' if defined sysseek(I, -1, 1);
! print "ok 39\n";
close(I);
diff -c 'perl5.005_02/t/op/taint.t' 'perl5.005_03/t/op/taint.t'
Index: ./t/op/taint.t
*** ./t/op/taint.t Sun Aug 2 00:15:10 1998
--- ./t/op/taint.t Thu Jan 28 19:15:25 1999
***************
*** 366,372 ****
test 72, $@ eq '', $@; # NB: This should be allowed
# Try first new style but allow also old style.
! test 73, $!{ENOENT} || $! == 2 || ($Is_Dos && $! == 22); # File not found
test 74, eval { open FOO, "> $foo" } eq '', 'open for write';
test 75, $@ =~ /^Insecure dependency/, $@;
--- 366,375 ----
test 72, $@ eq '', $@; # NB: This should be allowed
# Try first new style but allow also old style.
! test 73, $!{ENOENT} ||
! $! == 2 || # File not found
! ($Is_Dos && $! == 22) ||
! ($^O eq 'mint' && $! == 33);
test 74, eval { open FOO, "> $foo" } eq '', 'open for write';
test 75, $@ =~ /^Insecure dependency/, $@;
diff -c 'perl5.005_02/t/op/tie.t' 'perl5.005_03/t/op/tie.t'
Index: ./t/op/tie.t
*** ./t/op/tie.t Thu Jul 23 23:02:21 1998
--- ./t/op/tie.t Mon Oct 19 20:02:36 1998
***************
*** 153,155 ****
--- 153,168 ----
}
untie %H;
EXPECT
+ ########
+
+ # verify no leak when underlying object is selfsame tied variable
+ my ($a, $b);
+ sub Self::TIEHASH { bless $_[1], $_[0] }
+ sub Self::DESTROY { $b = $_[0] + 0; }
+ {
+ my %b5;
+ $a = \%b5 + 0;
+ tie %b5, 'Self', \%b5;
+ }
+ die unless $a == $b;
+ EXPECT
diff -c 'perl5.005_02/t/op/tiehandle.t' 'perl5.005_03/t/op/tiehandle.t'
Index: ./t/op/tiehandle.t
*** ./t/op/tiehandle.t Thu Jul 23 23:02:21 1998
--- ./t/op/tiehandle.t Sat Oct 31 21:23:19 1998
***************
*** 64,70 ****
sub WRITE {
compare(WRITE => @_);
$data = substr($_[1],$_[3] || 0, $_[2]);
! 4;
}
sub CLOSE {
--- 64,70 ----
sub WRITE {
compare(WRITE => @_);
$data = substr($_[1],$_[3] || 0, $_[2]);
! length($data);
}
sub CLOSE {
***************
*** 77,83 ****
use Symbol;
! print "1..23\n";
my $fh = gensym;
--- 77,83 ----
use Symbol;
! print "1..29\n";
my $fh = gensym;
***************
*** 131,136 ****
--- 131,150 ----
$r = syswrite $fh,$buf,4,1;
ok($r == 4);
ok($data eq "wert");
+
+ $buf = "qwerty";
+ @expect = (WRITE => $ob, $buf, 4);
+ $data = "";
+ $r = syswrite $fh,$buf,4;
+ ok($r == 4);
+ ok($data eq "qwer");
+
+ $buf = "qwerty";
+ @expect = (WRITE => $ob, $buf, 6);
+ $data = "";
+ $r = syswrite $fh,$buf;
+ ok($r == 6);
+ ok($data eq "qwerty");
@expect = (CLOSE => $ob);
$r = close $fh;
diff -c /dev/null 'perl5.005_03/t/op/tr.t'
Index: t/op/tr.t
*** t/op/tr.t Wed Dec 31 18:00:00 1969
--- t/op/tr.t Fri Oct 23 21:07:28 1998
***************
*** 0 ****
--- 1,33 ----
+ # tr.t
+
+ print "1..4\n";
+
+ $_ = "abcdefghijklmnopqrstuvwxyz";
+
+ tr/a-z/A-Z/;
+
+ print "not " unless $_ eq "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+ print "ok 1\n";
+
+ tr/A-Z/a-z/;
+
+ print "not " unless $_ eq "abcdefghijklmnopqrstuvwxyz";
+ print "ok 2\n";
+
+ tr/b-y/B-Y/;
+
+ print "not " unless $_ eq "aBCDEFGHIJKLMNOPQRSTUVWXYz";
+ print "ok 3\n";
+
+ # In EBCDIC 'I' is \xc9 and 'J' is \0xd1, 'i' is \x89 and 'j' is \x91.
+ # Yes, discontinuities. Regardless, the \xca in the below should stay
+ # untouched (and not became \x8a).
+
+ $_ = "I\xcaJ";
+
+ tr/I-J/i-j/;
+
+ print "not " unless $_ eq "i\xcaj";
+ print "ok 4\n";
+
+ #
diff -c 'perl5.005_02/t/op/undef.t' 'perl5.005_03/t/op/undef.t'
Index: ./t/op/undef.t
*** ./t/op/undef.t Thu Jul 23 23:02:21 1998
--- ./t/op/undef.t Sun Nov 29 14:26:00 1998
***************
*** 1,8 ****
#!./perl
! # $RCSfile: undef.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:34 $
!
! print "1..21\n";
print defined($a) ? "not ok 1\n" : "ok 1\n";
--- 1,6 ----
#!./perl
! print "1..23\n";
print defined($a) ? "not ok 1\n" : "ok 1\n";
***************
*** 54,56 ****
--- 52,61 ----
print defined &foo ? "ok 20\n" : "not ok 20\n";
undef &foo;
print defined(&foo) ? "not ok 21\n" : "ok 21\n";
+
+ eval { undef $1 };
+ print $@ =~ /^Modification of a read/ ? "ok 22\n" : "not ok 22\n";
+
+ eval { $1 = undef };
+ print $@ =~ /^Modification of a read/ ? "ok 23\n" : "not ok 23\n";
+
diff -c 'perl5.005_02/t/op/write.t' 'perl5.005_03/t/op/write.t'
Index: ./t/op/write.t
*** ./t/op/write.t Thu Jul 23 23:02:21 1998
--- ./t/op/write.t Sun Nov 29 19:22:09 1998
***************
*** 2,8 ****
# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
! print "1..5\n";
my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
--- 2,8 ----
# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
! print "1..6\n";
my $CAT = ($^O eq 'MSWin32') ? 'type' : 'cat';
***************
*** 166,169 ****
--- 166,192 ----
}
print $was1 eq $mustbe ? "ok 4\n" : "not ok 4\n";
print $was2 eq $mustbe ? "ok 5\n" : "not ok 5\n";
+
+ $^A = '';
+
+ # more test
+
+ format OUT3 =
+ ^<<<<<<...
+ $foo
+ .
+
+ open(OUT3, '>Op_write.tmp') || die "Can't create Op_write.tmp";
+
+ $foo = 'fit ';
+ write(OUT3);
+ close OUT3;
+
+ $right =
+ "fit\n";
+
+ if (`$CAT Op_write.tmp` eq $right)
+ { print "ok 6\n"; unlink 'Op_write.tmp'; }
+ else
+ { print "not ok 6\n"; }
diff -c 'perl5.005_02/t/pragma/constant.t' 'perl5.005_03/t/pragma/constant.t'
Index: ./t/pragma/constant.t
*** ./t/pragma/constant.t Sun Aug 2 00:15:10 1998
--- ./t/pragma/constant.t Sat Oct 31 19:23:45 1998
***************
*** 14,20 ****
######################### We start with some black magic to print on failure.
! BEGIN { $| = 1; print "1..39\n"; }
END {print "not ok 1\n" unless $loaded;}
use constant;
$loaded = 1;
--- 14,20 ----
######################### We start with some black magic to print on failure.
! BEGIN { $| = 1; print "1..46\n"; }
END {print "not ok 1\n" unless $loaded;}
use constant;
$loaded = 1;
***************
*** 139,141 ****
--- 139,157 ----
test 38, @warnings == 0, "unexpected warning";
test 39, $^W & 1, "Who disabled the warnings?";
+
+ use constant CSCALAR => \"ok 40\n";
+ use constant CHASH => { foo => "ok 41\n" };
+ use constant CARRAY => [ undef, "ok 42\n" ];
+ use constant CPHASH => [ { foo => 1 }, "ok 43\n" ];
+ use constant CCODE => sub { "ok $_[0]\n" };
+
+ print ${+CSCALAR};
+ print CHASH->{foo};
+ print CARRAY->[1];
+ print CPHASH->{foo};
+ eval q{ CPHASH->{bar} };
+ test 44, scalar($@ =~ /^No such array/);
+ print CCODE->(45);
+ eval q{ CCODE->{foo} };
+ test 46, scalar($@ =~ /^Constant is not a HASH/);
diff -c 'perl5.005_02/t/pragma/locale.t' 'perl5.005_03/t/pragma/locale.t'
Index: ./t/pragma/locale.t
*** ./t/pragma/locale.t Thu Jul 23 23:02:22 1998
--- ./t/pragma/locale.t Fri Oct 23 21:07:38 1998
***************
*** 23,28 ****
--- 23,31 ----
# and mingw32 uses said silly CRT
$have_setlocale = 0 if $^O eq 'MSWin32' && $Config{cc} =~ /^(cl|gcc)/i;
+ # 103 (the last test) may fail but that is okay.
+ # (It indicates something broken in the environment, not Perl)
+ # Therefore .. only until 102, not 103.
print "1..", ($have_setlocale ? 102 : 98), "\n";
use vars qw($a
***************
*** 404,409 ****
--- 407,413 ----
# Test for read-onlys.
+ print "# testing 102\n";
{
no locale;
$a = "qwerty";
***************
*** 419,425 ****
# Thanks to Hallvard Furuseth <h.b.furuseth@usit.uio.no>
# for inventing a way to test for ordering consistency
# without requiring any particular order.
! # ++$jhi;#@iki.fi
print "# testing 103\n";
{
--- 423,429 ----
# Thanks to Hallvard Furuseth <h.b.furuseth@usit.uio.no>
# for inventing a way to test for ordering consistency
# without requiring any particular order.
! # <jhi@iki.fi>
print "# testing 103\n";
{
diff -c 'perl5.005_02/t/pragma/overload.t' 'perl5.005_03/t/pragma/overload.t'
Index: ./t/pragma/overload.t
*** ./t/pragma/overload.t Sun Aug 2 00:15:10 1998
--- ./t/pragma/overload.t Tue Dec 29 08:10:02 1998
***************
*** 694,698 ****
test( scalar ($seven =~ /i/), '1')
}
# Last test is:
! sub last {173}
--- 694,710 ----
test( scalar ($seven =~ /i/), '1')
}
+ {
+ package sorting;
+ use overload 'cmp' => \∁
+ sub new { my ($p, $v) = @_; bless \$v, $p }
+ sub comp { my ($x,$y) = @_; ($$x * 3 % 10) <=> ($$y * 3 % 10) or $$x cmp $$y }
+ }
+ {
+ my @arr = map sorting->new($_), 0..12;
+ my @sorted1 = sort @arr;
+ my @sorted2 = map $$_, @sorted1;
+ test "@sorted2", '0 10 7 4 1 11 8 5 12 2 9 6 3';
+ }
# Last test is:
! sub last {174}
diff -c 'perl5.005_02/t/pragma/subs.t' 'perl5.005_03/t/pragma/subs.t'
Index: ./t/pragma/subs.t
*** ./t/pragma/subs.t Sun Aug 2 00:15:10 1998
--- ./t/pragma/subs.t Mon Nov 23 19:27:41 1998
***************
*** 55,61 ****
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+/-/g;
$results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
! $results =~ s/Syntax/syntax/; # non-standard yacc
$expected =~ s/\n+$//;
my $prefix = ($results =~ s/^PREFIX\n//) ;
if ( $results =~ s/^SKIPPED\n//) {
--- 55,63 ----
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+/-/g;
$results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
! # bison says 'parse error' instead of 'syntax error',
! # various yaccs may or may not capitalize 'syntax'.
! $results =~ s/^(syntax|parse) error/syntax error/mig;
$expected =~ s/\n+$//;
my $prefix = ($results =~ s/^PREFIX\n//) ;
if ( $results =~ s/^SKIPPED\n//) {
diff -c 'perl5.005_02/t/pragma/warn-1global' 'perl5.005_03/t/pragma/warn-1global'
Index: ./t/pragma/warn-1global
*** ./t/pragma/warn-1global Thu Jul 23 23:02:22 1998
--- ./t/pragma/warn-1global Sat Mar 27 19:42:53 1999
***************
*** 12,23 ****
--- 12,25 ----
$a =+ 3 ;
EXPECT
Reversed += operator at - line 3.
+ Name "main::a" used only once: possible typo at - line 3.
########
#! perl -w
# warnable code, warnings enabled via #! line
$a =+ 3 ;
EXPECT
Reversed += operator at - line 3.
+ Name "main::a" used only once: possible typo at - line 3.
########
# warnable code, warnings enabled via compile time $^W
***************
*** 25,30 ****
--- 27,33 ----
$a =+ 3 ;
EXPECT
Reversed += operator at - line 4.
+ Name "main::a" used only once: possible typo at - line 4.
########
# compile-time warnable code, warnings enabled via runtime $^W
***************
*** 149,151 ****
--- 152,159 ----
-e undef
EXPECT
Use of uninitialized value at - line 2.
+ ########
+ BEGIN { $^W = 1 }
+ for (@{[0]}) { "$_" } # check warning isn't duplicated
+ EXPECT
+ Useless use of string in void context at - line 2.
diff -c 'perl5.005_02/t/pragma/warning.t' 'perl5.005_03/t/pragma/warning.t'
Index: ./t/pragma/warning.t
*** ./t/pragma/warning.t Thu Jul 23 23:02:22 1998
--- ./t/pragma/warning.t Mon Nov 23 19:29:18 1998
***************
*** 4,14 ****
chdir 't' if -d 't';
@INC = '../lib';
$ENV{PERL5LIB} = '../lib';
}
$| = 1;
! my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $tmpfile = "tmp0000";
my $i = 0 ;
--- 4,15 ----
chdir 't' if -d 't';
@INC = '../lib';
$ENV{PERL5LIB} = '../lib';
+ require Config; import Config;
}
$| = 1;
! my $Is_VMS = $^O eq 'VMS';
my $Is_MSWin32 = $^O eq 'MSWin32';
my $tmpfile = "tmp0000";
my $i = 0 ;
***************
*** 19,24 ****
--- 20,27 ----
foreach (sort glob("pragma/warn-*")) {
+ next if /\.orig$/ ;
+
next if /(~|\.orig)$/;
open F, "<$_" or die "Cannot open $_: $!\n" ;
***************
*** 76,88 ****
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+/-/g;
$results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
$expected =~ s/\n+$//;
my $prefix = ($results =~ s/^PREFIX\n//) ;
if ( $results =~ s/^SKIPPED\n//) {
print "$results\n" ;
}
! elsif (($prefix and $results !~ /^\Q$expected/) or
! (!$prefix and $results ne $expected)){
print STDERR "PROG: $switch\n$prog\n";
print STDERR "EXPECTED:\n$expected\n";
print STDERR "GOT:\n$results\n";
--- 79,107 ----
# allow expected output to be written as if $prog is on STDIN
$results =~ s/tmp\d+/-/g;
$results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg
+ # bison says 'parse error' instead of 'syntax error',
+ # various yaccs may or may not capitalize 'syntax'.
+ $results =~ s/^(syntax|parse) error/syntax error/mig;
$expected =~ s/\n+$//;
my $prefix = ($results =~ s/^PREFIX\n//) ;
+ # any special options? (OPTIONS foo bar zap)
+ my $option_regex = 0;
+ if ($expected =~ s/^OPTIONS? (.+)\n//) {
+ foreach my $option (split(' ', $1)) {
+ if ($option eq 'regex') { # allow regular expressions
+ $option_regex = 1;
+ } else {
+ die "$0: Unknown OPTION '$option'\n";
+ }
+ }
+ }
if ( $results =~ s/^SKIPPED\n//) {
print "$results\n" ;
}
! elsif (($prefix && (( $option_regex && $results !~ /^$expected/) ||
! (!$option_regex && $results !~ /^\Q$expected/))) or
! (!$prefix && (( $option_regex && $results !~ /^$expected/) ||
! (!$option_regex && $results ne $expected)))) {
print STDERR "PROG: $switch\n$prog\n";
print STDERR "EXPECTED:\n$expected\n";
print STDERR "GOT:\n$results\n";
diff -c 'perl5.005_02/taint.c' 'perl5.005_03/taint.c'
Index: ./taint.c
*** ./taint.c Thu Jul 23 23:02:22 1998
--- ./taint.c Tue Jan 5 20:50:18 1999
***************
*** 17,22 ****
--- 17,24 ----
"%s %d %d %d\n", s, PL_tainted, PL_uid, PL_euid));
if (PL_tainted) {
+ if (!f)
+ f = no_security;
if (PL_euid != PL_uid)
ug = " while running setuid";
else if (PL_egid != PL_gid)
***************
*** 44,50 ****
--- 46,56 ----
NULL
};
+ if(!PL_envgv)
+ return;
+
#ifdef VMS
+ {
int i = 0;
char name[10 + TYPE_DIGITS(int)] = "DCL$PATH";
***************
*** 66,71 ****
--- 72,78 ----
}
i++;
}
+ }
#endif /* VMS */
svp = hv_fetch(GvHVn(PL_envgv),"PATH",4,FALSE);
***************
*** 87,95 ****
svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
dTHR; /* just for taint */
bool was_tainted = PL_tainted;
! char *t = SvPV(*svp, PL_na);
! char *e = t + PL_na;
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
--- 94,103 ----
svp = hv_fetch(GvHVn(PL_envgv),"TERM",4,FALSE);
if (svp && *svp && SvTAINTED(*svp)) {
dTHR; /* just for taint */
+ STRLEN n_a;
bool was_tainted = PL_tainted;
! char *t = SvPV(*svp, n_a);
! char *e = t + n_a;
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
t++;
diff -c 'perl5.005_02/thread.h' 'perl5.005_03/thread.h'
Index: ./thread.h
*** ./thread.h Sun Aug 2 01:08:11 1998
--- ./thread.h Wed Mar 3 20:35:56 1999
***************
*** 35,40 ****
--- 35,102 ----
# endif
#endif
+ #ifdef I_MACH_CTHREADS
+
+ /* cthreads interface */
+
+ /* #include <mach/cthreads.h> is in perl.h #ifdef I_MACH_CTHREADS */
+
+ #define MUTEX_INIT(m) \
+ STMT_START { \
+ *m = mutex_alloc(); \
+ if (*m) { \
+ mutex_init(*m); \
+ } else { \
+ croak("panic: MUTEX_INIT"); \
+ } \
+ } STMT_END
+
+ #define MUTEX_LOCK(m) mutex_lock(*m)
+ #define MUTEX_UNLOCK(m) mutex_unlock(*m)
+ #define MUTEX_DESTROY(m) \
+ STMT_START { \
+ mutex_free(*m); \
+ *m = 0; \
+ } STMT_END
+
+ #define COND_INIT(c) \
+ STMT_START { \
+ *c = condition_alloc(); \
+ if (*c) { \
+ condition_init(*c); \
+ } else { \
+ croak("panic: COND_INIT"); \
+ } \
+ } STMT_END
+
+ #define COND_SIGNAL(c) condition_signal(*c)
+ #define COND_BROADCAST(c) condition_broadcast(*c)
+ #define COND_WAIT(c, m) condition_wait(*c, *m)
+ #define COND_DESTROY(c) \
+ STMT_START { \
+ condition_free(*c); \
+ *c = 0; \
+ } STMT_END
+
+ #define THREAD_CREATE(thr, f) (thr->self = cthread_fork(f, thr), 0)
+ #define THREAD_POST_CREATE(thr)
+
+ #define THREAD_RET_TYPE any_t
+ #define THREAD_RET_CAST(x) ((any_t) x)
+
+ #define DETACH(t) cthread_detach(t->self)
+ #define JOIN(t, avp) (*(avp) = (AV *)cthread_join(t->self))
+
+ #define SET_THR(thr) cthread_set_data(cthread_self(), thr)
+ #define THR cthread_data(cthread_self())
+
+ #define INIT_THREADS cthread_init()
+ #define YIELD cthread_yield()
+ #define ALLOC_THREAD_KEY
+ #define SET_THREAD_SELF(thr) (thr->self = cthread_self())
+
+ #endif /* I_MACH_CTHREADS */
+
#ifndef YIELD
# ifdef HAS_SCHED_YIELD
# define YIELD sched_yield()
***************
*** 45,56 ****
--- 107,132 ----
# endif
#endif
+ #ifdef __hpux
+ # define MUTEX_INIT_NEEDS_MUTEX_ZEROED
+ #endif
+
#ifndef MUTEX_INIT
+ #ifdef MUTEX_INIT_NEEDS_MUTEX_ZEROED
+ /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */
+ #define MUTEX_INIT(m) \
+ STMT_START { \
+ Zero((m), 1, perl_mutex); \
+ if (pthread_mutex_init((m), pthread_mutexattr_default)) \
+ croak("panic: MUTEX_INIT"); \
+ } STMT_END
+ #else
#define MUTEX_INIT(m) \
STMT_START { \
if (pthread_mutex_init((m), pthread_mutexattr_default)) \
croak("panic: MUTEX_INIT"); \
} STMT_END
+ #endif
#define MUTEX_LOCK(m) \
STMT_START { \
if (pthread_mutex_lock((m))) \
***************
*** 138,143 ****
--- 214,221 ----
* from thrsv which is cached in the per-interpreter structure.
* Systems with very fast pthread_get_specific (which should be all systems
* but unfortunately isn't) may wish to simplify to "...*thr = THR".
+ *
+ * The use of PL_threadnum should be safe here.
*/
#ifndef dTHR
# define dTHR \
***************
*** 160,176 ****
* try only locking them if there may be more than one thread in existence.
* Systems with very fast mutexes (and/or slow conditionals) may wish to
* remove the "if (threadnum) ..." test.
*/
! #define LOCK_SV_MUTEX \
! STMT_START { \
! if (PL_threadnum) \
! MUTEX_LOCK(&PL_sv_mutex); \
} STMT_END
! #define UNLOCK_SV_MUTEX \
! STMT_START { \
! if (PL_threadnum) \
! MUTEX_UNLOCK(&PL_sv_mutex); \
} STMT_END
#ifndef THREAD_RET_TYPE
--- 238,264 ----
* try only locking them if there may be more than one thread in existence.
* Systems with very fast mutexes (and/or slow conditionals) may wish to
* remove the "if (threadnum) ..." test.
+ * XXX do NOT use C<if (PL_threadnum) ...> -- it sets up race conditions!
*/
! #define LOCK_SV_MUTEX \
! STMT_START { \
! MUTEX_LOCK(&PL_sv_mutex); \
} STMT_END
! #define UNLOCK_SV_MUTEX \
! STMT_START { \
! MUTEX_UNLOCK(&PL_sv_mutex); \
! } STMT_END
!
! /* Likewise for strtab_mutex */
! #define LOCK_STRTAB_MUTEX \
! STMT_START { \
! MUTEX_LOCK(&PL_strtab_mutex); \
! } STMT_END
!
! #define UNLOCK_STRTAB_MUTEX \
! STMT_START { \
! MUTEX_UNLOCK(&PL_strtab_mutex); \
} STMT_END
#ifndef THREAD_RET_TYPE
***************
*** 223,228 ****
--- 311,318 ----
#define COND_DESTROY(c)
#define LOCK_SV_MUTEX
#define UNLOCK_SV_MUTEX
+ #define LOCK_STRTAB_MUTEX
+ #define UNLOCK_STRTAB_MUTEX
#define THR
/* Rats: if dTHR is just blank then the subsequent ";" throws an error */
diff -c 'perl5.005_02/toke.c' 'perl5.005_03/toke.c'
Index: ./toke.c
*** ./toke.c Tue Aug 4 19:50:02 1998
--- ./toke.c Sun Mar 28 01:57:23 1999
***************
*** 1,6 ****
/* toke.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* toke.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 53,58 ****
--- 53,61 ----
static SV *new_constant _((char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type));
static void restore_expect _((void *e));
static void restore_lex_expect _((void *e));
+
+ static char *PL_super_bufptr;
+ static char *PL_super_bufend;
#endif /* PERL_OBJECT */
static char ident_too_long[] = "Identifier too long";
***************
*** 382,394 ****
}
for (;;) {
STRLEN prevlen;
! while (s < PL_bufend && isSPACE(*s))
! s++;
if (s < PL_bufend && *s == '#') {
while (s < PL_bufend && *s != '\n')
s++;
! if (s < PL_bufend)
s++;
}
if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
return s;
--- 385,404 ----
}
for (;;) {
STRLEN prevlen;
! while (s < PL_bufend && isSPACE(*s)) {
! if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
! incline(s);
! }
if (s < PL_bufend && *s == '#') {
while (s < PL_bufend && *s != '\n')
s++;
! if (s < PL_bufend) {
s++;
+ if (PL_in_eval && !PL_rsfp) {
+ incline(s);
+ continue;
+ }
+ }
}
if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
return s;
***************
*** 862,867 ****
--- 872,878 ----
/* expand a range A-Z to the full set of characters. AIE! */
if (dorange) {
I32 i; /* current expanded character */
+ I32 min; /* first character in range */
I32 max; /* last character in range */
i = d - SvPVX(sv); /* remember current offset */
***************
*** 869,878 ****
d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
d -= 2; /* eat the first char and the - */
! max = (U8)d[1]; /* last char in range */
! for (i = (U8)*d; i <= max; i++)
! *d++ = i;
/* mark the range as done, and continue */
dorange = FALSE;
--- 880,905 ----
d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
d -= 2; /* eat the first char and the - */
! min = (U8)*d; /* first char in range */
! max = (U8)d[1]; /* last char in range */
! #ifndef ASCIIish
! if ((isLOWER(min) && isLOWER(max)) ||
! (isUPPER(min) && isUPPER(max))) {
! if (isLOWER(min)) {
! for (i = min; i <= max; i++)
! if (isLOWER(i))
! *d++ = i;
! } else {
! for (i = min; i <= max; i++)
! if (isUPPER(i))
! *d++ = i;
! }
! }
! else
! #endif
! for (i = min; i <= max; i++)
! *d++ = i;
/* mark the range as done, and continue */
dorange = FALSE;
***************
*** 1284,1290 ****
--- 1311,1319 ----
* Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
* private use must be set using malloc'd pointers.
*/
+ #ifndef PERL_OBJECT
static int filter_debug = 0;
+ #endif
SV *
filter_add(filter_t funcp, SV *datasv)
***************
*** 1300,1307 ****
if (!SvUPGRADE(datasv, SVt_PVIO))
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
! if (filter_debug)
! warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na));
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
--- 1329,1338 ----
if (!SvUPGRADE(datasv, SVt_PVIO))
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
! if (filter_debug) {
! STRLEN n_a;
! warn("filter_add func %p (%s)", funcp, SvPV(datasv,n_a));
! }
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
***************
*** 1317,1323 ****
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
! if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (void*)funcp){
sv_free(av_pop(PL_rsfp_filters));
return;
--- 1348,1354 ----
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
! if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){
sv_free(av_pop(PL_rsfp_filters));
return;
***************
*** 1377,1385 ****
}
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
! if (filter_debug)
warn("filter_read %d: via function %p (%s)\n",
! idx, funcp, SvPV(datasv,PL_na));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
--- 1408,1418 ----
}
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
! if (filter_debug) {
! STRLEN n_a;
warn("filter_read %d: via function %p (%s)\n",
! idx, funcp, SvPV(datasv,n_a));
! }
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
***************
*** 1955,1961 ****
else
newargv = PL_origargv;
newargv[0] = ipath;
! execv(ipath, newargv);
croak("Can't exec %s", ipath);
}
if (d) {
--- 1988,1994 ----
else
newargv = PL_origargv;
newargv[0] = ipath;
! PerlProc_execv(ipath, newargv);
croak("Can't exec %s", ipath);
}
if (d) {
***************
*** 2443,2449 ****
--- 2476,2486 ----
}
if (PL_lex_brackets < PL_lex_formbrack) {
char *t;
+ #ifdef PERL_STRICT_CR
for (t = s; *t == ' ' || *t == '\t'; t++) ;
+ #else
+ for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+ #endif
if (*t == '\n' || *t == '#') {
s--;
PL_expect = XBLOCK;
***************
*** 2567,2573 ****
for (t++; isSPACE(*t); t++) ;
if (isIDFIRST(*t)) {
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
! if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
warn("You need to quote \"%s\"", tmpbuf);
}
}
--- 2604,2611 ----
for (t++; isSPACE(*t); t++) ;
if (isIDFIRST(*t)) {
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
! for (; isSPACE(*t); t++) ;
! if (*t == ';' && perl_get_cv(tmpbuf, FALSE))
warn("You need to quote \"%s\"", tmpbuf);
}
}
***************
*** 2613,2621 ****
PL_expect = XTERM; /* e.g. print $fh 3 */
else if (*s == '.' && isDIGIT(s[1]))
PL_expect = XTERM; /* e.g. print $fh .3 */
! else if (strchr("/?-+", *s) && !isSPACE(s[1]))
PL_expect = XTERM; /* e.g. print $fh -1 */
! else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
PL_expect = XTERM; /* print $fh <<"EOF" */
}
PL_pending_ident = '$';
--- 2651,2659 ----
PL_expect = XTERM; /* e.g. print $fh 3 */
else if (*s == '.' && isDIGIT(s[1]))
PL_expect = XTERM; /* e.g. print $fh .3 */
! else if (strchr("/?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
PL_expect = XTERM; /* e.g. print $fh -1 */
! else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]) && s[2] != '=')
PL_expect = XTERM; /* print $fh <<"EOF" */
}
PL_pending_ident = '$';
***************
*** 2672,2679 ****
OPERATOR(tmp);
case '.':
! if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack && s[1] == '\n' &&
! (s == PL_linestart || s[-1] == '\n') ) {
PL_lex_formbrack = 0;
PL_expect = XSTATE;
goto rightbracket;
--- 2710,2723 ----
OPERATOR(tmp);
case '.':
! if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack
! #ifdef PERL_STRICT_CR
! && s[1] == '\n'
! #else
! && (s[1] == '\n' || (s[1] == '\r' && s[2] == '\n'))
! #endif
! && (s == PL_linestart || s[-1] == '\n') )
! {
PL_lex_formbrack = 0;
PL_expect = XSTATE;
goto rightbracket;
***************
*** 2794,2799 ****
--- 2838,2844 ----
case 'z': case 'Z':
keylookup: {
+ STRLEN n_a;
gv = Nullgv;
gvp = 0;
***************
*** 2868,2874 ****
tmp = -tmp;
gv = Nullgv;
gvp = 0;
! if (PL_dowarn && hgv)
warn("Ambiguous call resolved as CORE::%s(), %s",
GvENAME(hgv), "qualify as such or use &");
}
--- 2913,2920 ----
tmp = -tmp;
gv = Nullgv;
gvp = 0;
! if (PL_dowarn && hgv
! && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
warn("Ambiguous call resolved as CORE::%s(), %s",
GvENAME(hgv), "qualify as such or use &");
}
***************
*** 2985,2992 ****
if (*s == '(') {
CLINE;
if (gv && GvCVu(gv)) {
for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
! if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
s = d + 1;
goto its_constant;
}
--- 3031,3041 ----
if (*s == '(') {
CLINE;
if (gv && GvCVu(gv)) {
+ CV *cv;
+ if ((cv = GvCV(gv)) && SvPOK(cv))
+ PL_last_proto = SvPV((SV*)cv, n_a);
for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
! if (*d == ')' && (sv = cv_const_sv(cv))) {
s = d + 1;
goto its_constant;
}
***************
*** 2995,3000 ****
--- 3044,3050 ----
PL_expect = XOPERATOR;
force_next(WORD);
yylval.ival = 0;
+ PL_last_lop_op = OP_ENTERSUB;
TOKEN('&');
}
***************
*** 3033,3038 ****
--- 3083,3089 ----
/* Resolve to GV now. */
op_free(yylval.opval);
yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+ PL_last_lop_op = OP_ENTERSUB;
/* Is there a prototype? */
if (SvPOK(cv)) {
STRLEN len;
***************
*** 3059,3065 ****
PL_last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
PL_last_lop_op != OP_ACCEPT &&
PL_last_lop_op != OP_PIPE_OP &&
! PL_last_lop_op != OP_SOCKPAIR)
{
warn(
"Bareword \"%s\" not allowed while \"strict subs\" in use",
--- 3110,3119 ----
PL_last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
PL_last_lop_op != OP_ACCEPT &&
PL_last_lop_op != OP_PIPE_OP &&
! PL_last_lop_op != OP_SOCKPAIR &&
! !(PL_last_lop_op == OP_ENTERSUB
! && PL_last_proto
! && PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*'))
{
warn(
"Bareword \"%s\" not allowed while \"strict subs\" in use",
***************
*** 3935,3941 ****
PL_lex_stuff = Nullsv;
}
! if (*SvPV(PL_subname,PL_na) == '?') {
sv_setpv(PL_subname,"__ANON__");
TOKEN(ANONSUB);
}
--- 3989,3995 ----
PL_lex_stuff = Nullsv;
}
! if (*SvPV(PL_subname,n_a) == '?') {
sv_setpv(PL_subname,"__ANON__");
TOKEN(ANONSUB);
}
***************
*** 5074,5079 ****
--- 5128,5136 ----
if (es) {
SV *repl;
+ PL_super_bufptr = s;
+ PL_super_bufend = PL_bufend;
+ PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
repl = newSVpv("",0);
while (es-- > 0)
***************
*** 5236,5242 ****
PL_multi_start = PL_curcop->cop_line;
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
! if (!outer) {
d = s;
while (s < PL_bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
--- 5293,5325 ----
PL_multi_start = PL_curcop->cop_line;
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
! if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
! char *bufptr = PL_super_bufptr;
! char *bufend = PL_super_bufend;
! char *olds = s - SvCUR(herewas);
! s = strchr(bufptr, '\n');
! if (!s)
! s = bufend;
! d = s;
! while (s < bufend &&
! (*s != term || memNE(s,PL_tokenbuf,len)) ) {
! if (*s++ == '\n')
! PL_curcop->cop_line++;
! }
! if (s >= bufend) {
! PL_curcop->cop_line = PL_multi_start;
! missingterm(PL_tokenbuf);
! }
! sv_setpvn(herewas,bufptr,d-bufptr+1);
! sv_setpvn(tmpstr,d+1,s-d);
! s += len - 1;
! sv_catpvn(herewas,s,bufend-s);
! (void)strcpy(bufptr,SvPVX(herewas));
!
! s = olds;
! goto retval;
! }
! else if (!outer) {
d = s;
while (s < PL_bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
***************
*** 5300,5307 ****
sv_catsv(tmpstr,PL_linestr);
}
}
- PL_multi_end = PL_curcop->cop_line;
s++;
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
--- 5383,5391 ----
sv_catsv(tmpstr,PL_linestr);
}
}
s++;
+ retval:
+ PL_multi_end = PL_curcop->cop_line;
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
***************
*** 5887,5894 ****
while (!needargs) {
if (*s == '.' || *s == '}') {
/*SUPPRESS 530*/
! for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
! if (*t == '\n')
break;
}
if (PL_in_eval && !PL_rsfp) {
--- 5971,5982 ----
while (!needargs) {
if (*s == '.' || *s == '}') {
/*SUPPRESS 530*/
! #ifdef PERL_STRICT_CR
! for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
! #else
! for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
! #endif
! if (*t == '\n' || t == PL_bufend)
break;
}
if (PL_in_eval && !PL_rsfp) {
diff -c 'perl5.005_02/universal.c' 'perl5.005_03/universal.c'
Index: ./universal.c
*** ./universal.c Thu Jul 23 23:02:26 1998
--- ./universal.c Wed Dec 30 22:36:58 1998
***************
*** 106,129 ****
#include "XSUB.h"
- static
XS(XS_UNIVERSAL_isa)
{
dXSARGS;
SV *sv;
char *name;
if (items != 2)
croak("Usage: UNIVERSAL::isa(reference, kind)");
sv = ST(0);
! name = (char *)SvPV(ST(1),PL_na);
ST(0) = boolSV(sv_derived_from(sv, name));
XSRETURN(1);
}
- static
XS(XS_UNIVERSAL_can)
{
dXSARGS;
--- 106,128 ----
#include "XSUB.h"
XS(XS_UNIVERSAL_isa)
{
dXSARGS;
SV *sv;
char *name;
+ STRLEN n_a;
if (items != 2)
croak("Usage: UNIVERSAL::isa(reference, kind)");
sv = ST(0);
! name = (char *)SvPV(ST(1),n_a);
ST(0) = boolSV(sv_derived_from(sv, name));
XSRETURN(1);
}
XS(XS_UNIVERSAL_can)
{
dXSARGS;
***************
*** 131,142 ****
char *name;
SV *rv;
HV *pkg = NULL;
if (items != 2)
croak("Usage: UNIVERSAL::can(object-ref, method)");
sv = ST(0);
! name = (char *)SvPV(ST(1),PL_na);
rv = &PL_sv_undef;
if(SvROK(sv)) {
--- 130,142 ----
char *name;
SV *rv;
HV *pkg = NULL;
+ STRLEN n_a;
if (items != 2)
croak("Usage: UNIVERSAL::can(object-ref, method)");
sv = ST(0);
! name = (char *)SvPV(ST(1),n_a);
rv = &PL_sv_undef;
if(SvROK(sv)) {
***************
*** 158,164 ****
XSRETURN(1);
}
- static
XS(XS_UNIVERSAL_VERSION)
{
dXSARGS;
--- 158,163 ----
***************
*** 192,200 ****
undef = "(undef)";
}
! if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv))))
croak("%s version %s required--this is only version %s",
! HvNAME(pkg), SvPV(ST(1),PL_na), undef ? undef : SvPV(sv,PL_na));
ST(0) = sv;
--- 191,201 ----
undef = "(undef)";
}
! if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) {
! STRLEN n_a;
croak("%s version %s required--this is only version %s",
! HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a));
! }
ST(0) = sv;
diff -c 'perl5.005_02/unixish.h' 'perl5.005_03/unixish.h'
Index: ./unixish.h
*** ./unixish.h Thu Jul 23 23:02:26 1998
--- ./unixish.h Thu Feb 11 18:06:20 1999
***************
*** 89,95 ****
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
# include <signal.h>
#endif
--- 89,95 ----
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
! #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
# include <signal.h>
#endif
diff -c 'perl5.005_02/util.c' 'perl5.005_03/util.c'
Index: ./util.c
*** ./util.c Sun Aug 2 01:14:23 1998
--- ./util.c Sat Mar 27 11:55:28 1999
***************
*** 1,6 ****
/* util.c
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* util.c
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
***************
*** 621,626 ****
--- 621,629 ----
#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;
***************
*** 641,705 ****
else
setlocale_failure = TRUE;
}
! if (!setlocale_failure)
! #endif /* LC_ALL */
! {
#ifdef USE_LOCALE_CTYPE
! if (! (curctype = setlocale(LC_CTYPE,
! (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
! if (! (curcoll = setlocale(LC_COLLATE,
! (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
! if (! (curnum = setlocale(LC_NUMERIC,
! (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
}
! #else /* !LOCALE_ENVIRON_REQUIRED */
! #ifdef LC_ALL
if (! setlocale(LC_ALL, ""))
setlocale_failure = TRUE;
! else {
! #ifdef USE_LOCALE_CTYPE
! curctype = setlocale(LC_CTYPE, Nullch);
! #endif /* USE_LOCALE_CTYPE */
! #ifdef USE_LOCALE_COLLATE
! curcoll = setlocale(LC_COLLATE, Nullch);
! #endif /* USE_LOCALE_COLLATE */
! #ifdef USE_LOCALE_NUMERIC
! curnum = setlocale(LC_NUMERIC, Nullch);
! #endif /* USE_LOCALE_NUMERIC */
! }
!
! #else /* !LC_ALL */
#ifdef USE_LOCALE_CTYPE
! if (! (curctype = setlocale(LC_CTYPE, "")))
! setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
! if (! (curcoll = setlocale(LC_COLLATE, "")))
! setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
! if (! (curnum = setlocale(LC_NUMERIC, "")))
! setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
!
! #endif /* LC_ALL */
!
! #endif /* !LOCALE_ENVIRON_REQUIRED */
if (setlocale_failure) {
char *p;
--- 644,696 ----
else
setlocale_failure = TRUE;
}
! if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
! if (! (curctype =
! setlocale(LC_CTYPE,
! (!done && (lang || PerlEnv_getenv("LC_CTYPE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
! if (! (curcoll =
! setlocale(LC_COLLATE,
! (!done && (lang || PerlEnv_getenv("LC_COLLATE")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
! if (! (curnum =
! setlocale(LC_NUMERIC,
! (!done && (lang || PerlEnv_getenv("LC_NUMERIC")))
? "" : Nullch)))
setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
}
! #endif /* LC_ALL */
! #endif /* !LOCALE_ENVIRON_REQUIRED */
+ #ifdef LC_ALL
if (! setlocale(LC_ALL, ""))
setlocale_failure = TRUE;
! #endif /* LC_ALL */
+ if (!setlocale_failure) {
#ifdef USE_LOCALE_CTYPE
! if (! (curctype = setlocale(LC_CTYPE, "")))
! setlocale_failure = TRUE;
#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
! if (! (curcoll = setlocale(LC_COLLATE, "")))
! setlocale_failure = TRUE;
#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
! if (! (curnum = setlocale(LC_NUMERIC, "")))
! setlocale_failure = TRUE;
#endif /* USE_LOCALE_NUMERIC */
! }
if (setlocale_failure) {
char *p;
***************
*** 736,741 ****
--- 727,740 ----
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 ? '"' : '(',
***************
*** 897,910 ****
void
fbm_compile(SV *sv, U32 flags /* not used yet */)
{
! register unsigned char *s;
! register unsigned char *table;
register U32 i;
! register U32 len = SvCUR(sv);
I32 rarest = 0;
U32 frequency = 256;
! sv_upgrade(sv, SVt_PVBM);
if (len > 255 || len == 0) /* TAIL might be on on a zero-length string. */
return; /* can't have offsets that big */
if (len > 2) {
--- 896,910 ----
void
fbm_compile(SV *sv, U32 flags /* not used yet */)
{
! register U8 *s;
! register U8 *table;
register U32 i;
! STRLEN len;
I32 rarest = 0;
U32 frequency = 256;
! s = (U8*)SvPV_force(sv, len);
! (void)SvUPGRADE(sv, SVt_PVBM);
if (len > 255 || len == 0) /* TAIL might be on on a zero-length string. */
return; /* can't have offsets that big */
if (len > 2) {
***************
*** 1501,1521 ****
#else /* !USE_WIN32_RTL_ENV */
! /* The sane way to deal with the environment.
! * Has these advantages over putenv() & co.:
! * * enables us to store a truly empty value in the
! * environment (like in UNIX).
! * * we don't have to deal with RTL globals, bugs and leaks.
! * * Much faster.
! * Why you may want to enable USE_WIN32_RTL_ENV:
! * * environ[] and RTL functions will not reflect changes,
! * which might be an issue if extensions want to access
! * the env. via RTL. This cuts both ways, since RTL will
! * not see changes made by extensions that call the Win32
! * functions directly, either.
! * GSAR 97-06-07
! */
! SetEnvironmentVariable(nam,val);
#endif
}
--- 1501,1516 ----
#else /* !USE_WIN32_RTL_ENV */
! register char *envstr;
! STRLEN len = strlen(nam) + 3;
! if (!val) {
! val = "";
! }
! len += strlen(val);
! New(904, envstr, len, char);
! (void)sprintf(envstr,"%s=%s",nam,val);
! (void)PerlEnv_putenv(envstr);
! Safefree(envstr);
#endif
}
***************
*** 2198,2206 ****
register char *frombase = from;
if (len == 1) {
! todo = *from;
while (count-- > 0)
! *to++ = todo;
return;
}
while (count-- > 0) {
--- 2193,2201 ----
register char *frombase = from;
if (len == 1) {
! register char c = *from;
while (count-- > 0)
! *to++ = c;
return;
}
while (count-- > 0) {
***************
*** 2354,2371 ****
register UV retval = 0;
bool overflowed = FALSE;
char *tmp = s;
! while (len-- && *s && (tmp = strchr((char *) PL_hexdigit, *s))) {
! register UV n = retval << 4;
if (!overflowed && (n >> 4) != retval) {
warn("Integer overflow in hex number");
overflowed = TRUE;
}
retval = n | ((tmp - PL_hexdigit) & 15);
- s++;
- }
- if (PL_dowarn && !tmp) {
- warn("Illegal hex digit ignored");
}
*retlen = s - start;
return retval;
--- 2349,2374 ----
register UV retval = 0;
bool overflowed = FALSE;
char *tmp = s;
+ register UV n;
! while (len-- && *s) {
! tmp = strchr((char *) PL_hexdigit, *s++);
! if (!tmp) {
! if (*(s-1) == '_' || (*(s-1) == 'x' && retval == 0))
! continue;
! else {
! --s;
! if (PL_dowarn)
! warn("Illegal hex digit ignored");
! break;
! }
! }
! n = retval << 4;
if (!overflowed && (n >> 4) != retval) {
warn("Integer overflow in hex number");
overflowed = TRUE;
}
retval = n | ((tmp - PL_hexdigit) & 15);
}
*retlen = s - start;
return retval;
***************
*** 2469,2475 ****
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log,
"Looking for %s\n",cur));
! if (PerlLIO_stat(cur,&PL_statbuf) >= 0) {
dosearch = 0;
scriptname = cur;
#ifdef SEARCH_EXTS
--- 2472,2479 ----
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log,
"Looking for %s\n",cur));
! if (PerlLIO_stat(cur,&PL_statbuf) >= 0
! && !S_ISDIR(PL_statbuf.st_mode)) {
dosearch = 0;
scriptname = cur;
#ifdef SEARCH_EXTS
***************
*** 2538,2543 ****
--- 2542,2550 ----
#endif
DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf));
retval = PerlLIO_stat(tmpbuf,&PL_statbuf);
+ if (S_ISDIR(PL_statbuf.st_mode)) {
+ retval = -1;
+ }
#ifdef SEARCH_EXTS
} while ( retval < 0 /* not there */
&& extidx>=0 && ext[extidx] /* try an extension? */
***************
*** 2560,2566 ****
xfailed = savepv(tmpbuf);
}
#ifndef DOSISH
! if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&PL_statbuf) < 0))
#endif
seen_dot = 1; /* Disable message. */
if (!xfound) {
--- 2567,2575 ----
xfailed = savepv(tmpbuf);
}
#ifndef DOSISH
! if (!xfound && !seen_dot && !xfailed &&
! (PerlLIO_stat(scriptname,&PL_statbuf) < 0
! || S_ISDIR(PL_statbuf.st_mode)))
#endif
seen_dot = 1; /* Disable message. */
if (!xfound) {
***************
*** 2729,2735 ****
SvGROW(sv, sizeof(struct perl_thread) + 1);
SvCUR_set(sv, sizeof(struct perl_thread));
thr = (Thread) SvPVX(sv);
! /* debug */
memset(thr, 0xab, sizeof(struct perl_thread));
PL_markstack = 0;
PL_scopestack = 0;
--- 2738,2744 ----
SvGROW(sv, sizeof(struct perl_thread) + 1);
SvCUR_set(sv, sizeof(struct perl_thread));
thr = (Thread) SvPVX(sv);
! #ifdef DEBUGGING
memset(thr, 0xab, sizeof(struct perl_thread));
PL_markstack = 0;
PL_scopestack = 0;
***************
*** 2737,2743 ****
PL_retstack = 0;
PL_dirty = 0;
PL_localizing = 0;
! /* end debug */
thr->oursv = sv;
init_stacks(ARGS);
--- 2746,2755 ----
PL_retstack = 0;
PL_dirty = 0;
PL_localizing = 0;
! Zero(&PL_hv_fetch_ent_mh, 1, HE);
! #else
! Zero(thr, 1, struct perl_thread);
! #endif
thr->oursv = sv;
init_stacks(ARGS);
***************
*** 2751,2760 ****
thr->flags = THRf_R_JOINABLE;
MUTEX_INIT(&thr->mutex);
- PL_curcop = t->Tcurcop; /* XXX As good a guess as any? */
- PL_defstash = t->Tdefstash; /* XXX maybe these should */
- PL_curstash = t->Tcurstash; /* always be set to main? */
-
/* top_env needs to be non-zero. It points to an area
in which longjmp() stuff is stored, as C callstack
--- 2763,2768 ----
***************
*** 2772,2777 ****
--- 2780,2804 ----
PL_in_eval = FALSE;
PL_restartop = 0;
+ PL_statname = NEWSV(66,0);
+ PL_maxscream = -1;
+ PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
+ PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+ PL_regindent = 0;
+ PL_reginterp_cnt = 0;
+ PL_lastscream = Nullsv;
+ PL_screamfirst = 0;
+ PL_screamnext = 0;
+ PL_reg_start_tmp = 0;
+ PL_reg_start_tmpl = 0;
+
+ /* parent thread's data needs to be locked while we make copy */
+ MUTEX_LOCK(&t->mutex);
+
+ PL_curcop = t->Tcurcop; /* XXX As good a guess as any? */
+ PL_defstash = t->Tdefstash; /* XXX maybe these should */
+ PL_curstash = t->Tcurstash; /* always be set to main? */
+
PL_tainted = t->Ttainted;
PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */
PL_nrs = newSVsv(t->Tnrs);
***************
*** 2785,2802 ****
PL_bodytarget = newSVsv(t->Tbodytarget);
PL_toptarget = newSVsv(t->Ttoptarget);
- PL_statname = NEWSV(66,0);
- PL_maxscream = -1;
- PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
- PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
- PL_regindent = 0;
- PL_reginterp_cnt = 0;
- PL_lastscream = Nullsv;
- PL_screamfirst = 0;
- PL_screamnext = 0;
- PL_reg_start_tmp = 0;
- PL_reg_start_tmpl = 0;
-
/* Initialise all per-thread SVs that the template thread used */
svp = AvARRAY(t->threadsv);
for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) {
--- 2812,2817 ----
***************
*** 2819,2824 ****
--- 2834,2842 ----
thr->next->prev = thr;
MUTEX_UNLOCK(&PL_threads_mutex);
+ /* done copying parent's state */
+ MUTEX_UNLOCK(&t->mutex);
+
#ifdef HAVE_THREAD_INTERN
init_thread_intern(thr);
#endif /* HAVE_THREAD_INTERN */
***************
*** 2877,2879 ****
--- 2895,2994 ----
{
return PL_specialsv_list;
}
+
+
+ MGVTBL*
+ get_vtbl(int vtbl_id)
+ {
+ MGVTBL* result = Null(MGVTBL*);
+
+ switch(vtbl_id) {
+ case want_vtbl_sv:
+ result = &vtbl_sv;
+ break;
+ case want_vtbl_env:
+ result = &vtbl_env;
+ break;
+ case want_vtbl_envelem:
+ result = &vtbl_envelem;
+ break;
+ case want_vtbl_sig:
+ result = &vtbl_sig;
+ break;
+ case want_vtbl_sigelem:
+ result = &vtbl_sigelem;
+ break;
+ case want_vtbl_pack:
+ result = &vtbl_pack;
+ break;
+ case want_vtbl_packelem:
+ result = &vtbl_packelem;
+ break;
+ case want_vtbl_dbline:
+ result = &vtbl_dbline;
+ break;
+ case want_vtbl_isa:
+ result = &vtbl_isa;
+ break;
+ case want_vtbl_isaelem:
+ result = &vtbl_isaelem;
+ break;
+ case want_vtbl_arylen:
+ result = &vtbl_arylen;
+ break;
+ case want_vtbl_glob:
+ result = &vtbl_glob;
+ break;
+ case want_vtbl_mglob:
+ result = &vtbl_mglob;
+ break;
+ case want_vtbl_nkeys:
+ result = &vtbl_nkeys;
+ break;
+ case want_vtbl_taint:
+ result = &vtbl_taint;
+ break;
+ case want_vtbl_substr:
+ result = &vtbl_substr;
+ break;
+ case want_vtbl_vec:
+ result = &vtbl_vec;
+ break;
+ case want_vtbl_pos:
+ result = &vtbl_pos;
+ break;
+ case want_vtbl_bm:
+ result = &vtbl_bm;
+ break;
+ case want_vtbl_fm:
+ result = &vtbl_fm;
+ break;
+ case want_vtbl_uvar:
+ result = &vtbl_uvar;
+ break;
+ #ifdef USE_THREADS
+ case want_vtbl_mutex:
+ result = &vtbl_mutex;
+ break;
+ #endif
+ case want_vtbl_defelem:
+ result = &vtbl_defelem;
+ break;
+ case want_vtbl_regexp:
+ result = &vtbl_regexp;
+ break;
+ #ifdef USE_LOCALE_COLLATE
+ case want_vtbl_collxfrm:
+ result = &vtbl_collxfrm;
+ break;
+ #endif
+ case want_vtbl_amagic:
+ result = &vtbl_amagic;
+ break;
+ case want_vtbl_amagicelem:
+ result = &vtbl_amagicelem;
+ break;
+ }
+ return result;
+ }
+
diff -c 'perl5.005_02/util.h' 'perl5.005_03/util.h'
Index: ./util.h
*** ./util.h Thu Jul 23 23:02:27 1998
--- ./util.h Sat Mar 27 11:58:27 1999
***************
*** 1,6 ****
/* util.h
*
! * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
--- 1,6 ----
/* util.h
*
! * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
diff -c 'perl5.005_02/utils/h2ph.PL' 'perl5.005_03/utils/h2ph.PL'
Index: ./utils/h2ph.PL
*** ./utils/h2ph.PL Thu Jul 23 23:02:28 1998
--- ./utils/h2ph.PL Thu Feb 11 18:06:21 1999
***************
*** 63,68 ****
--- 63,70 ----
@ARGV = ('-') unless @ARGV;
+ build_preamble_if_necessary();
+
while (defined ($file = next_file())) {
if (-l $file and -d $file) {
link_if_possible($file) if ($opt_l);
***************
*** 97,102 ****
--- 99,106 ----
open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next);
open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n";
}
+
+ print OUT "require '_h2ph_pre.ph';\n\n";
while (<IN>) {
chop;
while (/\\$/) {
***************
*** 105,110 ****
--- 109,115 ----
chop;
}
print OUT "# $_\n" if $opt_D;
+
if (s:/\*:\200:g) {
s:\*/:\201:g;
s/\200[^\201]*\201//g; # delete single line comments
***************
*** 158,163 ****
--- 163,169 ----
$args = reindent($args);
if ($t ne '') {
$new =~ s/(['\\])/\\$1/g; #']);
+
if ($opt_h) {
print OUT $t,"eval \"\\n#line $eval_index $outfile\\n\" . 'sub $name () {",$new,";}' unless defined(\&$name);\n";
$eval_index++;
***************
*** 165,170 ****
--- 171,179 ----
print OUT $t,"eval 'sub $name () {",$new,";}' unless defined(\&$name);\n";
}
} else {
+ # Shunt around such directives as `#define FOO FOO':
+ next if " \&$name" eq $new;
+
print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
}
}
***************
*** 230,239 ****
print OUT $t,"}\n";
} elsif(/^undef\s+(\w+)/) {
print OUT $t, "undef(&$1) if defined(&$1);\n";
} elsif(/^error\s+(.*)/) {
! print OUT $t, "die(\"$1\");\n";
} elsif(/^warning\s+(.*)/) {
! print OUT $t, "warn(\"$1\");\n";
} elsif(/^ident\s+(.*)/) {
print OUT $t, "# $1\n";
}
--- 239,250 ----
print OUT $t,"}\n";
} elsif(/^undef\s+(\w+)/) {
print OUT $t, "undef(&$1) if defined(&$1);\n";
+ } elsif(/^error\s+(".*")/) {
+ print OUT $t, "die($1);\n";
} elsif(/^error\s+(.*)/) {
! print OUT $t, "die(\"", quotemeta($1), "\");\n";
} elsif(/^warning\s+(.*)/) {
! print OUT $t, "warn(\"", quotemeta($1), "\");\n";
} elsif(/^ident\s+(.*)/) {
print OUT $t, "# $1\n";
}
***************
*** 512,517 ****
--- 523,593 ----
}
+ # Create "_h2ph_pre.ph", if it doesn't exist or was built by a different
+ # version of h2ph.
+ sub build_preamble_if_necessary
+ {
+ # Increment $VERSION every time this function is modified:
+ my $VERSION = 1;
+ my $preamble = "$Dest_dir/_h2ph_pre.ph";
+
+ # Can we skip building the preamble file?
+ if (-r $preamble) {
+ # Extract version number from first line of preamble:
+ open PREAMBLE, $preamble or die "Cannot open $preamble: $!";
+ my $line = <PREAMBLE>;
+ $line =~ /(\b\d+\b)/;
+ close PREAMBLE or die "Cannot close $preamble: $!";
+
+ # Don't build preamble if a compatible preamble exists:
+ return if $1 == $VERSION;
+ }
+
+ my (%define) = _extract_cc_defines();
+
+ open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!";
+ print PREAMBLE "# This file was created by h2ph version $VERSION\n";
+
+ foreach (sort keys %define) {
+ if ($opt_D) {
+ print PREAMBLE "# $_=$define{$_}\n";
+ }
+
+ if ($define{$_} =~ /^\d+$/) {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { $define{$_} } }\n\n";
+ } else {
+ print PREAMBLE
+ "unless (defined &$_) { sub $_() { \"",
+ quotemeta($define{$_}), "\" } }\n\n";
+ }
+ }
+ close PREAMBLE or die "Cannot close $preamble: $!";
+ }
+
+
+ # %Config contains information on macros that are pre-defined by the
+ # system's compiler. We need this information to make the .ph files
+ # function with perl as the .h files do with cc.
+ sub _extract_cc_defines
+ {
+ my %define;
+ my $allsymbols = join " ", @Config{ccsymbols, cppsymbols, cppccsymbols};
+
+ # Split compiler pre-definitions into `key=value' pairs:
+ foreach (split /\s+/, $allsymbols) {
+ /(.*?)=(.*)/;
+ $define{$1} = $2;
+
+ if ($opt_D) {
+ print STDERR "$_: $1 -> $2\n";
+ }
+ }
+
+ return %define;
+ }
+
+
1;
##############################################################################
***************
*** 590,595 ****
--- 666,675 ----
Include the code from the B<.h> file as a comment in the B<.ph> file.
This is primarily used for debugging I<h2ph>.
+ =item -Q
+
+ ``Quiet'' mode; don't print out the names of the files being converted.
+
=back
=head1 ENVIRONMENT
***************
*** 625,630 ****
--- 705,728 ----
It's only intended as a rough tool.
You may need to dicker with the files produced.
+
+ Doesn't run with C<use strict>
+
+ You have to run this program by hand; it's not run as part of the Perl
+ installation.
+
+ Doesn't handle complicated expressions built piecemeal, a la:
+
+ enum {
+ FIRST_VALUE,
+ SECOND_VALUE,
+ #ifdef ABC
+ THIRD_VALUE
+ #endif
+ };
+
+ Doesn't necessarily locate all of your C compiler's internally-defined
+ symbols.
=cut
diff -c 'perl5.005_02/utils/h2xs.PL' 'perl5.005_03/utils/h2xs.PL'
Index: ./utils/h2xs.PL
*** ./utils/h2xs.PL Thu Jul 23 23:02:29 1998
--- ./utils/h2xs.PL Fri Feb 19 10:07:06 1999
***************
*** 211,217 ****
=cut
! my( $H2XS_VERSION ) = ' $Revision: 1.18 $ ' =~ /\$Revision:\s+([^\s]+)/;
my $TEMPLATE_VERSION = '0.01';
use Getopt::Std;
--- 211,217 ----
=cut
! my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/;
my $TEMPLATE_VERSION = '0.01';
use Getopt::Std;
***************
*** 499,504 ****
--- 499,505 ----
croak "Your vendor has not defined $module macro \$constname";
}
}
+ no strict 'refs';
*\$AUTOLOAD = sub () { \$val };
goto &\$AUTOLOAD;
}
***************
*** 591,605 ****
warn "Writing $ext$modpname/$modfname.xs\n";
print XS <<"END";
- #ifdef __cplusplus
- extern "C" {
- #endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
- #ifdef __cplusplus
- }
- #endif
END
if( @path_h ){
--- 592,600 ----
***************
*** 615,631 ****
if( ! $opt_c ){
print XS <<"END";
static int
! not_here(s)
! char *s;
{
croak("$module::%s not implemented on this architecture", s);
return -1;
}
static double
! constant(name, arg)
! char *name;
! int arg;
{
errno = 0;
switch (*name) {
--- 610,623 ----
if( ! $opt_c ){
print XS <<"END";
static int
! not_here(char *s)
{
croak("$module::%s not implemented on this architecture", s);
return -1;
}
static double
! constant(char *name, int arg)
{
errno = 0;
switch (*name) {
diff -c 'perl5.005_02/utils/perlbug.PL' 'perl5.005_03/utils/perlbug.PL'
Index: ./utils/perlbug.PL
*** ./utils/perlbug.PL Thu Jul 23 23:02:30 1998
--- ./utils/perlbug.PL Thu Mar 25 23:45:37 1999
***************
*** 528,534 ****
Environment for perl $]:
EOF
for my $env (sort
! (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR),
grep /^(?:PERL|LC_)/, keys %ENV)
) {
print OUT " $env",
--- 528,534 ----
Environment for perl $]:
EOF
for my $env (sort
! (qw(PATH LD_LIBRARY_PATH LANG PERL_BADLANG SHELL HOME LOGDIR LANGUAGE),
grep /^(?:PERL|LC_)/, keys %ENV)
) {
print OUT " $env",
***************
*** 901,906 ****
--- 901,913 ----
Be aware of the familiar traps that perl programmers of various hues
fall into. See L<perltrap>.
+ Check in L<perldiag> to see what any Perl error message(s) mean.
+ If message isn't in perldiag, it probably isn't generated by Perl.
+ Consult your operating system documentation instead.
+
+ If you are on a non-UNIX platform check also L<perlport>, some
+ features may not be implemented or work differently.
+
Try to study the problem under the perl debugger, if necessary.
See L<perldebug>.
***************
*** 916,921 ****
--- 923,939 ----
test suite. If you have the time, consider making your test case so
that it will readily fit into the standard test suite.
+ Remember also to include the B<exact> error messages, if any.
+ "Perl complained something" is not an exact error message.
+
+ If you get a core dump (or equivalent), you may use a debugger
+ (B<dbx>, B<gdb>, etc) to produce a stack trace to include in the bug
+ report. NOTE: unless your Perl has been compiled with debug info
+ (often B<-g>), the stack trace is likely to be somewhat hard to use
+ because it will most probably contain only the function names, not
+ their arguments. If possible, recompile your Perl with debug info and
+ reproduce the dump and the stack trace.
+
=item Can you describe the bug in plain English?
The easier it is to understand a reproducible bug, the more likely it
***************
*** 954,959 ****
--- 972,982 ----
C<perlbug> at all on your system, be sure to include the entire output
produced by running C<perl -V> (note the uppercase V).
+ Whether you use C<perlbug> or send the email manually, please make
+ your subject informative. "a bug" not informative. Neither is "perl
+ crashes" nor "HELP!!!", these all are null information. A compact
+ description of what's wrong is fine.
+
=back
Having done your bit, please be prepared to wait, to be told the bug
***************
*** 1071,1082 ****
by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
! (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>)
! and Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>).
=head1 SEE ALSO
! perl(1), perldebug(1), perltrap(1), diff(1), patch(1)
=head1 BUGS
--- 1094,1107 ----
by Gurusamy Sarathy (E<lt>gsar@umich.eduE<gt>), Tom Christiansen
(E<lt>tchrist@perl.comE<gt>), Nathan Torkington (E<lt>gnat@frii.comE<gt>),
Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
! (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
! Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>), and
! Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>).
=head1 SEE ALSO
! perl(1), perldebug(1), perldiag(1), perlport(1), perltrap(1),
! diff(1), patch(1), dbx(1), gdb(1)
=head1 BUGS
***************
*** 1090,1093 ****
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;
-
--- 1115,1117 ----
diff -c 'perl5.005_02/utils/perldoc.PL' 'perl5.005_03/utils/perldoc.PL'
Index: ./utils/perldoc.PL
*** ./utils/perldoc.PL Thu Jul 23 23:02:31 1998
--- ./utils/perldoc.PL Thu Mar 4 18:35:01 1999
***************
*** 91,97 ****
-F Arguments are file names, not modules
-v Verbosely describe what's going on
-X use index if present (looks for pod.idx at $Config{archlib})
!
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
--- 91,97 ----
-F Arguments are file names, not modules
-v Verbosely describe what's going on
-X use index if present (looks for pod.idx at $Config{archlib})
! -q Search the text of questions (not answers) in perlfaq[1-9]
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
***************
*** 188,194 ****
if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
# on a case-forgiving file system or if case is important
# that is it all we can do
! warn "Ignored $file: unreadable\n" if -f _;
return '';
}
local *DIR;
--- 188,194 ----
if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
# on a case-forgiving file system or if case is important
# that is it all we can do
! warn "Ignored $path: unreadable\n" if -f _;
return '';
}
local *DIR;
***************
*** 227,233 ****
return "" unless $found;
push @p, $cip;
return "@p" if -f "@p" and -r _;
! warn "Ignored $file: unreadable\n" if -f _;
}
}
return "";
--- 227,233 ----
return "" unless $found;
push @p, $cip;
return "@p" if -f "@p" and -r _;
! warn "Ignored @p: unreadable\n" if -f _;
}
}
return "";
***************
*** 408,413 ****
--- 408,416 ----
my $perlfunc = shift @found;
open(PFUNC, $perlfunc) or die "Can't open $perlfunc: $!";
+ # Functions like -r, -e, etc. are listed under `-X'.
+ my $search_string = ($opt_f =~ /^-[rwxoRWXOeszfdlpSbctugkTBMAC]$/) ? 'I<-X' : $opt_f ;
+
# Skip introduction
while (<PFUNC>) {
last if /^=head2 Alphabetical Listing of Perl Functions/;
***************
*** 417,423 ****
my $found = 0;
my @pod;
while (<PFUNC>) {
! if (/^=item\s+\Q$opt_f\E\b/o) {
$found = 1;
} elsif (/^=item/) {
last if $found > 1;
--- 420,426 ----
my $found = 0;
my @pod;
while (<PFUNC>) {
! if (/^=item\s+\Q$search_string\E\b/o) {
$found = 1;
} elsif (/^=item/) {
last if $found > 1;
***************
*** 456,462 ****
my @pod;
while (<>) {
! if (/^=head2\s+.*$opt_q/oi) {
$found = 1;
push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
} elsif (/^=head2/) {
--- 459,465 ----
my @pod;
while (<>) {
! if (/^=head2\s+.*(?:$opt_q)/oi) {
$found = 1;
push @pod, "=head1 Found in $ARGV\n\n" unless $found_in{$ARGV}++;
} elsif (/^=head2/) {
diff -c 'perl5.005_02/vms/ext/Stdio/Stdio.pm' 'perl5.005_03/vms/ext/Stdio/Stdio.pm'
Index: ./vms/ext/Stdio/Stdio.pm
*** ./vms/ext/Stdio/Stdio.pm Thu Jul 23 23:02:33 1998
--- ./vms/ext/Stdio/Stdio.pm Fri Nov 13 22:09:57 1998
***************
*** 3,8 ****
--- 3,9 ----
# Author: Charles Bailey bailey@genetics.upenn.edu
# Version: 2.1
# Revised: 24-Mar-1998
+ # Docs revised: 13-Oct-1998 Dan Sugalski <sugalskd@ous.edu>
package VMS::Stdio;
***************
*** 81,104 ****
=head1 SYNOPSIS
! use VMS::Stdio qw( &flush &getname &remove &rewind &setdef &sync &tmpnam
! &vmsopen &vmssysopen &waitfh &writeof );
! setdef("new:[default.dir]");
! $uniquename = tmpnam;
! $fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!;
! $name = getname($fh);
! print $fh "Hello, world!\n";
! flush($fh);
! sync($fh);
! rewind($fh);
! $line = <$fh>;
! undef $fh; # closes file
! $fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin");
! sysread($fh,$data,128);
! waitfh($fh);
! close($fh);
! remove("another.file");
! writeof($pipefh);
=head1 DESCRIPTION
This package gives Perl scripts access via VMS extensions to several
--- 82,106 ----
=head1 SYNOPSIS
! use VMS::Stdio qw( &flush &getname &remove &rewind &setdef &sync &tmpnam
! &vmsopen &vmssysopen &waitfh &writeof );
! setdef("new:[default.dir]");
! $uniquename = tmpnam;
! $fh = vmsopen("my.file","rfm=var","alq=100",...) or die $!;
! $name = getname($fh);
! print $fh "Hello, world!\n";
! flush($fh);
! sync($fh);
! rewind($fh);
! $line = <$fh>;
! undef $fh; # closes file
! $fh = vmssysopen("another.file", O_RDONLY | O_NDELAY, 0, "ctx=bin");
! sysread($fh,$data,128);
! waitfh($fh);
! close($fh);
! remove("another.file");
! writeof($pipefh);
!
=head1 DESCRIPTION
This package gives Perl scripts access via VMS extensions to several
***************
*** 221,226 ****
--- 223,595 ----
a VMS::Stdio file handle is overwritten, C<undef>d, or goes
out of scope, the associated file is closed automatically.
+ =over 4
+
+ =head2 File characteristic options
+
+ =over 2
+
+ =item alq=INTEGER
+
+ Sets the allocation quantity for this file
+
+ =item bls=INTEGER
+
+ File blocksize
+
+ =item ctx=STRING
+
+ Sets the context for the file. Takes one of these arguments:
+
+ =over 4
+
+ =item bin
+
+ Disables LF to CRLF translation
+
+ =item cvt
+
+ Negates previous setting of C<ctx=noctx>
+
+ =item nocvt
+
+ Disables conversion of FORTRAN carriage control
+
+ =item rec
+
+ Force record-mode access
+
+ =item stm
+
+ Force stream mode
+
+ =item xplct
+
+ Causes records to be flushed I<only> when the file is closed, or when an
+ explicit flush is done
+
+ =back
+
+ =item deq=INTEGER
+
+ Sets the default extension quantity
+
+ =item dna=FILESPEC
+
+ Sets the default filename string. Used to fill in any missing pieces of the
+ filename passed.
+
+ =item fop=STRING
+
+ File processing option. Takes one or more of the following (in a
+ comma-separated list if there's more than one)
+
+ =over 4
+
+ =item ctg
+
+ Contiguous.
+
+ =item cbt
+
+ Contiguous-best-try.
+
+ =item dfw
+
+ Deferred write; only applicable to files opened for shared access.
+
+ =item dlt
+
+ Delete file on close.
+
+ =item tef
+
+ Truncate at end-of-file.
+
+ =item cif
+
+ Create if nonexistent.
+
+ =item sup
+
+ Supersede.
+
+ =item scf
+
+ Submit as command file on close.
+
+ =item spl
+
+ Spool to system printer on close.
+
+ =item tmd
+
+ Temporary delete.
+
+ =item tmp
+
+ Temporary (no file directory).
+
+ =item nef
+
+ Not end-of-file.
+
+ =item rck
+
+ Read check compare operation.
+
+ =item wck
+
+ Write check compare operation.
+
+ =item mxv
+
+ Maximize version number.
+
+ =item rwo
+
+ Rewind file on open.
+
+ =item pos
+
+ Current position.
+
+ =item rwc
+
+ Rewind file on close.
+
+ =item sqo
+
+ File can only be processed in a sequential manner.
+
+ =back
+
+ =item fsz=INTEGER
+
+ Fixed header size
+
+ =item gbc=INTEGER
+
+ Global buffers requested for the file
+
+ =item mbc=INTEGER
+
+ Multiblock count
+
+ =item mbf=INTEGER
+
+ Bultibuffer count
+
+ =item mrs=INTEGER
+
+ Maximum record size
+
+ =item rat=STRING
+
+ File record attributes. Takes one of the following:
+
+ =over 4
+
+ =item cr
+
+ Carriage-return control.
+
+ =item blk
+
+ Disallow records to span block boundaries.
+
+ =item ftn
+
+ FORTRAN print control.
+
+ =item none
+
+ Explicitly forces no carriage control.
+
+ =item prn
+
+ Print file format.
+
+ =back
+
+ =item rfm=STRING
+
+ File record format. Takes one of the following:
+
+ =over 4
+
+ =item fix
+
+ Fixed-length record format.
+
+ =item stm
+
+ RMS stream record format.
+
+ =item stmlf
+
+ Stream format with line-feed terminator.
+
+ =item stmcr
+
+ Stream format with carriage-return terminator.
+
+ =item var
+
+ Variable-length record format.
+
+ =item vfc
+
+ Variable-length record with fixed control.
+
+ =item udf
+
+ Undefined format
+
+ =back
+
+ =item rop=STRING
+
+ Record processing operations. Takes one or more of the following in a
+ comma-separated list:
+
+ =over 4
+
+ =item asy
+
+ Asynchronous I/O.
+
+ =item cco
+
+ Cancel Ctrl/O (used with Terminal I/O).
+
+ =item cvt
+
+ Capitalizes characters on a read from the terminal.
+
+ =item eof
+
+ Positions the record stream to the end-of-file for the connect operation
+ only.
+
+ =item nlk
+
+ Do not lock record.
+
+ =item pmt
+
+ Enables use of the prompt specified by pmt=usr-prmpt on input from the
+ terminal.
+
+ =item pta
+
+ Eliminates any information in the type-ahead buffer on a read from the
+ terminal.
+
+ =item rea
+
+ Locks record for a read operation for this process, while allowing other
+ accessors to read the record.
+
+ =item rlk
+
+ Locks record for write.
+
+ =item rne
+
+ Suppresses echoing of input data on the screen as it is entered on the
+ keyboard.
+
+ =item rnf
+
+ Indicates that Ctrl/U, Ctrl/R, and DELETE are not to be considered control
+ commands on terminal input, but are to be passed to the application
+ program.
+
+ =item rrl
+
+ Reads regardless of lock.
+
+ =item syncsts
+
+ Returns success status of RMS$_SYNCH if the requested service completes its
+ task immediately.
+
+ =item tmo
+
+ Timeout I/O.
+
+ =item tpt
+
+ Allows put/write services using sequential record access mode to occur at
+ any point in the file, truncating the file at that point.
+
+ =item ulk
+
+ Prohibits RMS from automatically unlocking records.
+
+ =item wat
+
+ Wait until record is available, if currently locked by another stream.
+
+ =item rah
+
+ Read ahead.
+
+ =item wbh
+
+ Write behind.
+
+ =back
+
+ =item rtv=INTEGER
+
+ The number of retrieval pointers that RMS has to maintain (0 to 127255)
+
+ =item shr=STRING
+
+ File sharing options. Choose one of the following:
+
+ =over 4
+
+ =item del
+
+ Allows users to delete.
+
+ =item get
+
+ Allows users to read.
+
+ =item mse
+
+ Allows mainstream access.
+
+ =item nil
+
+ Prohibits file sharing.
+
+ =item put
+
+ Allows users to write.
+
+ =item upd
+
+ Allows users to update.
+
+ =item upi
+
+ Allows one or more writers.
+
+ =back
+
+ =item tmo=INTEGER
+
+ I/O timeout value
+
+ =back
+
+ =back
+
=item vmssysopen
This function bears the same relationship to the CORE function
***************
*** 250,255 ****
=head1 REVISION
! This document was last revised on 10-Dec-1996, for Perl 5.004.
=cut
--- 619,625 ----
=head1 REVISION
! This document was last revised on 13-Oct-1998, for Perl 5.004, 5.005, and
! 5.006.
=cut
diff -c 'perl5.005_02/vms/ext/Stdio/Stdio.xs' 'perl5.005_03/vms/ext/Stdio/Stdio.xs'
Index: ./vms/ext/Stdio/Stdio.xs
*** ./vms/ext/Stdio/Stdio.xs Thu Jul 23 23:02:33 1998
--- ./vms/ext/Stdio/Stdio.xs Wed Dec 30 22:38:18 1998
***************
*** 164,174 ****
struct FAB deffab = cc$rms_fab;
struct NAM defnam = cc$rms_nam;
struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
if (items) {
SV *defsv = ST(items-1); /* mimic chdir() */
ST(0) = &PL_sv_undef;
if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); }
! if (tovmsspec(SvPV(defsv,PL_na),vmsdef) == NULL) { XSRETURN(1); }
deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef);
}
else {
--- 164,175 ----
struct FAB deffab = cc$rms_fab;
struct NAM defnam = cc$rms_nam;
struct dsc$descriptor_s dirdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
+ STRLEN n_a;
if (items) {
SV *defsv = ST(items-1); /* mimic chdir() */
ST(0) = &PL_sv_undef;
if (!SvPOK(defsv)) { SETERRNO(EINVAL,LIB$_INVARG); XSRETURN(1); }
! if (tovmsspec(SvPV(defsv,n_a),vmsdef) == NULL) { XSRETURN(1); }
deffab.fab$l_fna = vmsdef; deffab.fab$b_fns = strlen(vmsdef);
}
else {
***************
*** 232,237 ****
--- 233,239 ----
char *args[8],mode[3] = {'r','\0','\0'}, type = '<';
register int i, myargc;
FILE *fp;
+ STRLEN n_a;
if (!spec || !*spec) {
SETERRNO(EINVAL,LIB$_INVARG);
***************
*** 250,256 ****
}
else if (*spec == '<') spec++;
myargc = items - 1;
! for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),PL_na);
/* This hack brought to you by C's opaque arglist management */
switch (myargc) {
case 0:
--- 252,258 ----
}
else if (*spec == '<') spec++;
myargc = items - 1;
! for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+1),n_a);
/* This hack brought to you by C's opaque arglist management */
switch (myargc) {
case 0:
***************
*** 298,310 ****
int i, myargc, fd;
FILE *fp;
SV *fh;
if (!spec || !*spec) {
SETERRNO(EINVAL,LIB$_INVARG);
XSRETURN_UNDEF;
}
if (items > 11) croak("too many args");
myargc = items - 3;
! for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),PL_na);
/* More fun with C calls; can't combine with above because
args 2,3 of different types in fopen() and open() */
switch (myargc) {
--- 300,313 ----
int i, myargc, fd;
FILE *fp;
SV *fh;
+ STRLEN n_a;
if (!spec || !*spec) {
SETERRNO(EINVAL,LIB$_INVARG);
XSRETURN_UNDEF;
}
if (items > 11) croak("too many args");
myargc = items - 3;
! for (i = 0; i < myargc; i++) args[i] = SvPV(ST(i+3),n_a);
/* More fun with C calls; can't combine with above because
args 2,3 of different types in fopen() and open() */
switch (myargc) {
diff -c 'perl5.005_02/vms/ext/Stdio/test.pl' 'perl5.005_03/vms/ext/Stdio/test.pl'
Index: ./vms/ext/Stdio/test.pl
*** ./vms/ext/Stdio/test.pl Thu Jul 23 23:02:33 1998
--- ./vms/ext/Stdio/test.pl Thu Jan 28 19:15:26 1999
***************
*** 2,8 ****
use VMS::Stdio;
import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
! print "1..19\n";
print +(defined(&getname) ? '' : 'not '), "ok 1\n";
$name = "test$$";
--- 2,8 ----
use VMS::Stdio;
import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
! print "1..18\n";
print +(defined(&getname) ? '' : 'not '), "ok 1\n";
$name = "test$$";
***************
*** 43,60 ****
print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n";
! if (open(P, qq[| MCR $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) {
! print P "Baz\nQuux\n";
! print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n";
! print P "Baz\nQuux\n";
! print +(close(P) ? '' : 'not '),"ok 16\n";
! $fh = VMS::Stdio::vmsopen("$name.tmp");
! chomp($line = <$fh>);
! close $fh;
! unlink("$name.tmp");
! print +($line eq 'FooBar' ? '' : 'not '),"ok 17\n";
! }
! else { print "not ok 15\nnot ok 16\nnot ok 17\n"; }
$sfh = VMS::Stdio::vmsopen(">$name.tmp");
$setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);";
--- 43,62 ----
print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n";
! #if (open(P, qq[| MCR $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) {
! # print P "Baz\nQuux\n";
! # print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n";
! # print P "Baz\nQuux\n";
! # print +(close(P) ? '' : ''),"ok 16\n";
! # $fh = VMS::Stdio::vmsopen("$name.tmp");
! # chomp($line = <$fh>);
! # close $fh;
! # unlink("$name.tmp");
! # print +($line eq 'FooBar' ? '' : 'not '),"ok 17\n";
! #}
! #else {
! print "ok 15\nok 16\nok 17\n";
! #}
$sfh = VMS::Stdio::vmsopen(">$name.tmp");
$setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);";
***************
*** 65,68 ****
@defs = map { /(\S+)/ && $1 } `\@$name.tmp`;
unlink("$name.tmp");
print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n";
! print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n";
--- 67,70 ----
@defs = map { /(\S+)/ && $1 } `\@$name.tmp`;
unlink("$name.tmp");
print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n";
! #print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n";
diff -c 'perl5.005_02/vms/perly_c.vms' 'perl5.005_03/vms/perly_c.vms'
Index: ./vms/perly_c.vms
Prereq: 1.8
*** ./vms/perly_c.vms Thu Jul 23 23:02:38 1998
--- ./vms/perly_c.vms Fri Feb 19 09:45:30 1999
***************
*** 1774,1783 ****
break;
case 57:
#line 294 "perly.y"
! { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, PL_na);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
! CvUNIQUE_on(PL_compcv);
yyval.opval = yyvsp[0].opval; }
break;
case 58:
--- 1774,1783 ----
break;
case 57:
#line 294 "perly.y"
! { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, n_a);
if (strEQ(name, "BEGIN") || strEQ(name, "END")
|| strEQ(name, "INIT"))
! CvSPECIAL_on(PL_compcv);
yyval.opval = yyvsp[0].opval; }
break;
case 58:
***************
*** 1802,1808 ****
break;
case 64:
#line 317 "perly.y"
! { CvUNIQUE_on(PL_compcv); /* It's a BEGIN {} */ }
break;
case 65:
#line 319 "perly.y"
--- 1802,1808 ----
break;
case 64:
#line 317 "perly.y"
! { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
break;
case 65:
#line 319 "perly.y"
diff -c 'perl5.005_02/vms/subconfigure.com' 'perl5.005_03/vms/subconfigure.com'
Index: ./vms/subconfigure.com
*** ./vms/subconfigure.com Sun Aug 2 00:07:37 1998
--- ./vms/subconfigure.com Sat Mar 6 08:48:43 1999
***************
*** 56,61 ****
--- 56,71 ----
$ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE")
$!
$! ##ADD NEW CONSTANTS HERE##
+ $ perl_i_sysmount="undef"
+ $ perl_d_fstatfs="undef"
+ $ perl_i_machcthreads="undef"
+ $ perl_i_pthread="define"
+ $ perl_d_fstatvfs="undef"
+ $ perl_d_statfsflags="undef"
+ $ perl_i_sysstatvfs="undef"
+ $ perl_i_mntent="undef"
+ $ perl_d_getmntent="undef"
+ $ perl_d_hasmntopt="undef"
$ perl_package="''package'"
$ perl_baserev = "''baserev'"
$ cc_defines=""
***************
*** 2346,2351 ****
--- 2356,2362 ----
$ WC "sig_num='" + perl_sig_num + "'"
$ tempsym = "sig_name_init='" + perl_sig_name_with_commas + "'"
$ WC/symbol tempsym
+ $ WC "sig_num_init='" + perl_sig_num_with_commas + "'"
$ WC "modetype='" + perl_modetype + "'"
$ WC "ssizetype='" + perl_ssizetype + "'"
$ WC "o_nonblock='" + perl_o_nonblock + "'"
***************
*** 2470,2475 ****
--- 2481,2496 ----
$ WC "extensions='" + perl_extensions + "'"
$ WC "d_mknod='" + perl_d_mknod + "'"
$ WC "devtype='" + perl_devtype + "'"
+ $ 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 "i_machcthreads='" + perl_i_machcthreads + "'"
+ $ WC "i_pthread='" + perl_i_pthread + "'"
+ $ WC "d_fstatvfs='" + perl_d_fstatvfs + "'"
+ $ WC "i_mntent='" + perl_i_mntent + "'"
+ $ WC "d_getmntent='" + perl_d_getmntent + "'"
+ $ WC "d_hasmntopt='" + perl_d_hasmntopt + "'"
$!
$! ##WRITE NEW CONSTANTS HERE##
$!
diff -c 'perl5.005_02/vms/vms.c' 'perl5.005_03/vms/vms.c'
Index: ./vms/vms.c
Prereq: 2.2
*** ./vms/vms.c Thu Jul 23 23:02:42 1998
--- ./vms/vms.c Wed Jan 6 22:50:05 1999
***************
*** 712,718 ****
unsigned long int chan, iosb[2], retsts, retsts2;
struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
! if (fgetname(info->fp,devnam)) {
/* It oughta be a mailbox, so fgetname should give just the device
* name, but just in case . . . */
if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
--- 712,718 ----
unsigned long int chan, iosb[2], retsts, retsts2;
struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
! if (fgetname(info->fp,devnam,1)) {
/* It oughta be a mailbox, so fgetname should give just the device
* name, but just in case . . . */
if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
***************
*** 768,774 ****
_ckvmssts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
_ckvmssts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
if (ownerpid != mypid)
! warn("pid %d not a child",pid);
}
_ckvmssts(sys$bintim(&intdsc,interval));
--- 768,774 ----
_ckvmssts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
_ckvmssts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
if (ownerpid != mypid)
! warn("pid %x not a child",pid);
}
_ckvmssts(sys$bintim(&intdsc,interval));
***************
*** 981,987 ****
** tounixspec() - convert any file spec into a Unix-style file spec.
** tovmsspec() - convert any file spec into a VMS-style spec.
**
! ** Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>
** Permission is given to distribute this code as part of the Perl
** standard distribution under the terms of the GNU General Public
** License or the Perl Artistic License. Copies of each may be
--- 981,987 ----
** tounixspec() - convert any file spec into a Unix-style file spec.
** tovmsspec() - convert any file spec into a VMS-style spec.
**
! ** Copyright 1996 by Charles Bailey <bailey@newman.upenn.edu>
** Permission is given to distribute this code as part of the Perl
** standard distribution under the terms of the GNU General Public
** License or the Perl Artistic License. Copies of each may be
***************
*** 1815,1821 ****
* gain. *
* *
* 27-Aug-1994 Modified for inclusion in perl5 *
! * by Charles Bailey bailey@genetics.upenn.edu *
*****************************************************************************
*/
--- 1815,1821 ----
* gain. *
* *
* 27-Aug-1994 Modified for inclusion in perl5 *
! * by Charles Bailey bailey@newman.upenn.edu *
*****************************************************************************
*/
***************
*** 2564,2570 ****
* VMS readdir() routines.
* Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
*
! * 21-Jul-1994 Charles Bailey bailey@genetics.upenn.edu
* Minor modifications to original routines.
*/
--- 2564,2570 ----
* VMS readdir() routines.
* Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
*
! * 21-Jul-1994 Charles Bailey bailey@newman.upenn.edu
* Minor modifications to original routines.
*/
***************
*** 2848,2853 ****
--- 2848,2854 ----
register size_t cmdlen = 0;
size_t rlen;
register SV **idx;
+ STRLEN n_a;
idx = mark;
if (really) {
***************
*** 2874,2880 ****
while (++mark <= sp) {
if (*mark) {
strcat(PL_Cmd," ");
! strcat(PL_Cmd,SvPVx(*mark,PL_na));
}
}
return PL_Cmd;
--- 2875,2881 ----
while (++mark <= sp) {
if (*mark) {
strcat(PL_Cmd," ");
! strcat(PL_Cmd,SvPVx(*mark,n_a));
}
}
return PL_Cmd;
***************
*** 3527,3533 ****
* UTC support, since they also handle C<use vmsish qw(times);>
*
* Contributed by Chuck Lane <lane@duphy4.physics.drexel.edu>
! * Modified by Charles Bailey <bailey@genetics.upenn.edu>
*/
/*{{{time_t my_time(time_t *timep)*/
--- 3528,3534 ----
* UTC support, since they also handle C<use vmsish qw(times);>
*
* Contributed by Chuck Lane <lane@duphy4.physics.drexel.edu>
! * Modified by Charles Bailey <bailey@newman.upenn.edu>
*/
/*{{{time_t my_time(time_t *timep)*/
***************
*** 4160,4166 ****
int ret = 0, saverrno = errno, savevmserrno = vaxc$errno;
fpos_t pos;
! if (!fgetname(fp,filespec)) return NULL;
for (s = filespec; *s; s++) {
if (*s == ':') colon = s;
else if (*s == ']' || *s == '>') dirend = s;
--- 4161,4167 ----
int ret = 0, saverrno = errno, savevmserrno = vaxc$errno;
fpos_t pos;
! if (!fgetname(fp,filespec,1)) return NULL;
for (s = filespec; *s; s++) {
if (*s == ':') colon = s;
else if (*s == ']' || *s == '>') dirend = s;
***************
*** 4223,4229 ****
*
* Returns 1 on success; returns 0 and sets errno and vaxc$errno on failure.
*
! * Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>.
* Incorporates, with permission, some code from EZCOPY by Tim Adye
* <T.J.Adye@rl.ac.uk>. Permission is given to distribute this code
* as part of the Perl standard distribution under the terms of the
--- 4224,4230 ----
*
* Returns 1 on success; returns 0 and sets errno and vaxc$errno on failure.
*
! * Copyright 1996 by Charles Bailey <bailey@newman.upenn.edu>.
* Incorporates, with permission, some code from EZCOPY by Tim Adye
* <T.J.Adye@rl.ac.uk>. Permission is given to distribute this code
* as part of the Perl standard distribution under the terms of the
***************
*** 4407,4418 ****
{
dXSARGS;
char *fspec, *defspec = NULL, *rslt;
if (!items || items > 2)
croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])");
! fspec = SvPV(ST(0),PL_na);
if (!fspec || !*fspec) XSRETURN_UNDEF;
! if (items == 2) defspec = SvPV(ST(1),PL_na);
rslt = do_rmsexpand(fspec,NULL,1,defspec,0);
ST(0) = sv_newmortal();
--- 4408,4420 ----
{
dXSARGS;
char *fspec, *defspec = NULL, *rslt;
+ STRLEN n_a;
if (!items || items > 2)
croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])");
! fspec = SvPV(ST(0),n_a);
if (!fspec || !*fspec) XSRETURN_UNDEF;
! if (items == 2) defspec = SvPV(ST(1),n_a);
rslt = do_rmsexpand(fspec,NULL,1,defspec,0);
ST(0) = sv_newmortal();
***************
*** 4425,4433 ****
{
dXSARGS;
char *vmsified;
if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
! vmsified = do_tovmsspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
XSRETURN(1);
--- 4427,4436 ----
{
dXSARGS;
char *vmsified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
! vmsified = do_tovmsspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
XSRETURN(1);
***************
*** 4438,4446 ****
{
dXSARGS;
char *unixified;
if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
! unixified = do_tounixspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
XSRETURN(1);
--- 4441,4450 ----
{
dXSARGS;
char *unixified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
! unixified = do_tounixspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
XSRETURN(1);
***************
*** 4451,4459 ****
{
dXSARGS;
char *fileified;
if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
! fileified = do_fileify_dirspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
XSRETURN(1);
--- 4455,4464 ----
{
dXSARGS;
char *fileified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
! fileified = do_fileify_dirspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
XSRETURN(1);
***************
*** 4464,4472 ****
{
dXSARGS;
char *pathified;
if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
! pathified = do_pathify_dirspec(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
XSRETURN(1);
--- 4469,4478 ----
{
dXSARGS;
char *pathified;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
! pathified = do_pathify_dirspec(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
XSRETURN(1);
***************
*** 4477,4485 ****
{
dXSARGS;
char *vmspath;
if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
! vmspath = do_tovmspath(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
XSRETURN(1);
--- 4483,4492 ----
{
dXSARGS;
char *vmspath;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
! vmspath = do_tovmspath(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
XSRETURN(1);
***************
*** 4490,4498 ****
{
dXSARGS;
char *unixpath;
if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
! unixpath = do_tounixpath(SvPV(ST(0),PL_na),NULL,1);
ST(0) = sv_newmortal();
if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
XSRETURN(1);
--- 4497,4506 ----
{
dXSARGS;
char *unixpath;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
! unixpath = do_tounixpath(SvPV(ST(0),n_a),NULL,1);
ST(0) = sv_newmortal();
if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
XSRETURN(1);
***************
*** 4505,4516 ****
char fspec[NAM$C_MAXRSS+1], *fsp;
SV *mysv;
IO *io;
if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
if (SvTYPE(mysv) == SVt_PVGV) {
! if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
--- 4513,4525 ----
char fspec[NAM$C_MAXRSS+1], *fsp;
SV *mysv;
IO *io;
+ STRLEN n_a;
if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
if (SvTYPE(mysv) == SVt_PVGV) {
! if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec,1)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
***************
*** 4518,4524 ****
fsp = fspec;
}
else {
! if (mysv != ST(0) || !(fsp = SvPV(mysv,PL_na)) || !*fsp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
--- 4527,4533 ----
fsp = fspec;
}
else {
! if (mysv != ST(0) || !(fsp = SvPV(mysv,n_a)) || !*fsp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
***************
*** 4540,4552 ****
unsigned long int sts;
SV *mysv;
IO *io;
if (items < 2 || items > 3)
croak("Usage: File::Copy::rmscopy(from,to[,date_flag])");
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
if (SvTYPE(mysv) == SVt_PVGV) {
! if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
--- 4549,4562 ----
unsigned long int sts;
SV *mysv;
IO *io;
+ STRLEN n_a;
if (items < 2 || items > 3)
croak("Usage: File::Copy::rmscopy(from,to[,date_flag])");
mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
if (SvTYPE(mysv) == SVt_PVGV) {
! if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec,1)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
***************
*** 4554,4560 ****
inp = inspec;
}
else {
! if (mysv != ST(0) || !(inp = SvPV(mysv,PL_na)) || !*inp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
--- 4564,4570 ----
inp = inspec;
}
else {
! if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
***************
*** 4562,4568 ****
}
mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
if (SvTYPE(mysv) == SVt_PVGV) {
! if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
--- 4572,4578 ----
}
mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
if (SvTYPE(mysv) == SVt_PVGV) {
! if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec,1)) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
***************
*** 4570,4576 ****
outp = outspec;
}
else {
! if (mysv != ST(1) || !(outp = SvPV(mysv,PL_na)) || !*outp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
--- 4580,4586 ----
outp = outspec;
}
else {
! if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
ST(0) = &PL_sv_no;
XSRETURN(1);
diff -c /dev/null 'perl5.005_03/vos/Changes'
Index: vos/Changes
*** vos/Changes Wed Dec 31 18:00:00 1969
--- vos/Changes Thu Feb 11 18:06:21 1999
***************
*** 0 ****
--- 1,41 ----
+ This file documents the changes made to port Perl to the Stratus
+ VOS operating system.
+
+ Paul Green (Paul_Green@stratus.com)
+ February 4, 1999
+
+ after 5.005_03:
+ Fixed the VOS port to work with the current version of VOS POSIX.1.
+ Fixed "build.cm" to work-around C compiler bug pcg-98 that affected
+ pp.c when compiled for PA-RISC systems.
+ Updated "config.h" to latest version.
+ Changed "compile_perl.cm" from a sample macro to a real one.
+ Changed "perl.bind" to use Unix-style slash-separated pathnames
+ instead of VOS-style greater-than-separated pathnames.
+ Updated "README.vos" to document the location of the VOS perl
+ libraries.
+ Created "vos_accept.c" to redirect standard "accept" call to
+ nonstandard VOS "_accept" call.
+ Updated "vos_dummies.c" to agree with current version of VOS POSIX.1.
+ Updated "vosish.h" to track changes made to unixish.h.
+
+ after 5.005_02:
+ Initial release.
+ Supplied "build.cm" command macro to build perl.
+ Supplied "Changes" to document the change history.
+ Supplied "compile_perl.cm" to launch processes to compile all
+ four versions of the Perl 5 binaries.
+ Supplied "config.h" to configure Perl 5 to VOS. Unfortunately,
+ since VOS does not have the configure tool, this file was
+ built by hand by editing "config_h.SH".
+ Supplied "config_h.SH.orig", which is the version of this file
+ that was current for version 5.005_02. Use this to discover
+ any subsequent changes to config_h.SH that must be
+ hand-copied into the real config.h.
+ Supplied "perl.bind" to control the VOS binder.
+ Supplied "README.vos" to describe the VOS port.
+ Supplied "test_vos_dummies.c" to test the VOS dummy functions.
+ Supplied "vos_dummies.c" to trap unimplemented POSIX functions.
+ Supplied "vosish.h" to configure Perl 5 to VOS.
+
+ (end)
diff -c /dev/null 'perl5.005_03/vos/build.cm'
Index: vos/build.cm
*** vos/build.cm Wed Dec 31 18:00:00 1969
--- vos/build.cm Thu Feb 11 18:06:21 1999
***************
*** 0 ****
--- 1,154 ----
+ &begin_parameters
+ cpu option(-processor)name,allow(mc68020,i80860,pa7100,pa8000),=mc68020
+ recompile switch(-recompile),=1
+ rebind switch(-rebind),=1
+ &end_parameters
+ &echo command_lines
+ &
+ & This is a VOS command macro to build Perl 5 for the Stratus VOS
+ & operating system. You need to have the VOS POSIX.1 support
+ & loaded on your system. Change the following statement, if
+ & necessary, to assign the correct pathname of the directory that
+ & contains VOS POSIX.1 support.
+ &
+ &set_string POSIX >vos_ftp_site>pub>vos>alpha>posix
+ &
+ & See if the site has VOS POSIX.1 support loaded. If not, quit now.
+ &
+ &if ^ (exists &POSIX& -directory)
+ &then &do
+ &display_line build: VOS POSIX.1 support not found. &POSIX&
+ &return
+ &end
+ &
+ & Set up the appropriate directory suffix for each architecture.
+ &
+ &if &cpu& = mc68020
+ &then &set_string obj ''
+ &if &cpu& = i80860
+ &then &set_string obj .860
+ &if &cpu& = pa7100
+ &then &set_string obj .7100
+ &if &cpu& = pa8000
+ &then &set_string obj .8000
+ &
+ &if &cpu& = mc68020
+ &then &set_string obj2 .68k
+ &else &set_string obj2 &obj&
+ &
+ &set_string cpu -processor &cpu&
+ &
+ & If requested, compile the source code.
+ &
+ &if &recompile& = 0
+ &then &goto CHECK_REBIND
+ &
+ !set_library_paths include << < &POSIX&>incl &+
+ (master_disk)>system>include_library
+ !list_library_paths include
+ &
+ &if (exists *.obj -link)
+ &then !unlink *.obj -no_ask -brief
+ &
+ & Suppress several harmless compiler warning and advice messages.
+ &
+ & For complete listings, add -list -show_macros both_ways -show_include all
+ &set_string cflags -O4 -u
+ !cc <<av.c -suppress_diag 2006 2064 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<byterun.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<deb.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<doio.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<doop.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<dump.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<ebcdic.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<globals.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<gv.c -suppress_diag 2006 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<hv.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ & !cc <<malloc.c -suppress_diag 2006 &cpu& &cflags&
+ & &if (command_status) ^= 0 &then &return
+ !cc <<mg.c -suppress_diag 2006 2064 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<miniperlmain.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<op.c -suppress_diag 2006 2064 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<perl.c -suppress_diag 2006 2065 &cpu& &cflags& &+
+ -DARCHLIB="/system/ported/perl/lib/5.005&obj2&" &+
+ -DARCHLIB_EXP="/system/ported/perl/lib/5.005&obj2&" &+
+ -DSITEARCH="/system/ported/perl/lib/site/5.005&obj2&" &+
+ -DSITEARCH_EXP="/system/ported/perl/lib/site/5.005&obj2&"
+ &if (command_status) ^= 0 &then &return
+ !cc <<perlio.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<perly.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ & compiling pp.c for the PA-RISC hits compiler bug pcg-98; avoid it.
+ &if (index (string &cpu&) pa) > 0
+ &then !cc <<pp.c -suppress_diag 2006 2064 &cpu& &cflags& -no_schedule
+ &else !cc <<pp.c -suppress_diag 2006 2064 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<pp_ctl.c -suppress_diag 2006 2064 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<pp_hot.c -suppress_diag 2006 2064 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<pp_sys.c -suppress_diag 2002 2006 2064 2065 &cpu& &cflags& -Xc
+ &if (command_status) ^= 0 &then &return
+ !cc <<regcomp.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<regexec.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<run.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<scope.c -suppress_diag 2006 2064 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<sv.c -suppress_diag 2006 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<taint.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<toke.c -suppress_diag 2006 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<universal.c -suppress_diag 2006 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <<util.c -suppress_diag 2006 2065 &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ !cc <vos_accept.c &cpu& &cflags& -Xc
+ &if (command_status) ^= 0 &then &return
+ !cc <vos_dummies.c &cpu& &cflags&
+ &if (command_status) ^= 0 &then &return
+ &
+ & If requested, bind the executable program module.
+ &
+ &label CHECK_REBIND
+ &if &rebind& = 0
+ &then &return
+ &
+ &if (exists -directory (master_disk)>system>tcp_os>object_library&obj&)
+ &then &set_string tcp_objlib (master_disk)>system>tcp_os>object_library&obj&
+ &else &set_string tcp_objlib (master_disk)>system>tcp_os>object_library
+ &
+ &if (exists -directory (master_disk)>system>object_library&obj&)
+ &then &set_string objlib (master_disk)>system>object_library&obj&
+ &else &set_string objlib (master_disk)>system>object_library
+ &
+ &if (exists -directory (master_disk)>system>c_object_library&obj&)
+ &then &set_string c_objlib (master_disk)>system>c_object_library&obj&
+ &else &set_string c_objlib (master_disk)>system>c_object_library
+ &
+ !set_library_paths object . &+
+ &POSIX&>c>runtime>obj&obj& &+
+ &POSIX&>c>sysv_runtime>obj&obj& &+
+ &tcp_objlib& &objlib& &c_objlib&
+ !list_library_paths object
+ !bind -control <perl.bind &cpu&
+ &if (command_status) ^= 0 &then &return
+ !delete_file *.obj -no_ask -brief
diff -c /dev/null 'perl5.005_03/vos/compile_perl.cm'
Index: vos/compile_perl.cm
*** vos/compile_perl.cm Wed Dec 31 18:00:00 1969
--- vos/compile_perl.cm Thu Feb 11 18:06:22 1999
***************
*** 0 ****
--- 1,39 ----
+ & This command macro creates the appropriate subdirectory
+ & for the specified processor type and then runs the
+ & build macro in that subdirectory to create the perl
+ & executable program module file.
+ & Written 99-02-03 by Paul Green (Paul_Green@stratus.com)
+ &
+ &begin_parameters
+ cpu option(-processor)name,allow(mc68020,i80860,pa7100,pa8000),=mc68020
+ recompile switch(-recompile),=1
+ rebind switch(-rebind),=1
+ &end_parameters
+ &echo command_lines
+ &
+ &if &recompile&
+ &then &set_string recompile -recompile
+ &else &set_string recompile -no_recompile
+ &
+ &if &rebind&
+ &then &set_string rebind -rebind
+ &else &set_string rebind -no_rebind
+ &
+ &if &cpu& = mc68020
+ &then &set_string obj ''
+ &if &cpu& = i80860
+ &then &set_string obj .860
+ &if &cpu& = pa7100
+ &then &set_string obj .7100
+ &if &cpu& = pa8000
+ &then &set_string obj .8000
+ &
+ &if ^ (exists obj&obj& -directory)
+ &then !create_dir obj&obj&
+ &
+ &if ^ (exists obj&obj&>build.out)
+ &then !create_file obj&obj&>build.out ; set_implicit_locking obj&obj&>build.out
+ &
+ !change_current_dir obj&obj&
+ !start_process (string <build -processor &cpu& &recompile& &rebind&)
+ !change_current_dir <
diff -c /dev/null 'perl5.005_03/vos/config.h'
Index: vos/config.h
*** vos/config.h Wed Dec 31 18:00:00 1969
--- vos/config.h Sat Mar 6 08:48:46 1999
***************
*** 0 ****
--- 1,2167 ----
+ /* This is config.h for Stratus VOS. It was created by hand
+ from the distribution copy of config_h.SH. */
+
+ /* Configuration time: March 5, 1999
+ * Configured by: Paul Green
+ * Target system: Stratus VOS
+ */
+
+ #ifndef _config_h_
+ #define _config_h_
+
+ /* LOC_SED:
+ * This symbol holds the complete pathname to the sed program.
+ */
+ #define LOC_SED "/system/ported/command_library/sed.pm" /**/
+
+ /* BIN:
+ * This symbol holds the path of the bin directory where the package will
+ * be installed. Program must be prepared to deal with ~name substitution.
+ */
+ /* BIN_EXP:
+ * This symbol is the filename expanded version of the BIN symbol, for
+ * programs that do not want to deal with that at run-time.
+ */
+ #define BIN "/system/ported/command_library" /**/
+ #define BIN_EXP "/system/ported/command_library" /**/
+
+ /* CPPSTDIN:
+ * This symbol contains the first part of the string which will invoke
+ * the C preprocessor on the standard input and produce to standard
+ * output. Typical value of "cc -E" or "/lib/cpp", but it can also
+ * call a wrapper. See CPPRUN.
+ */
+ /* CPPMINUS:
+ * This symbol contains the second part of the string which will invoke
+ * the C preprocessor on the standard input and produce to standard
+ * output. This symbol will have the value "-" if CPPSTDIN needs a minus
+ * to specify standard input, otherwise the value is "".
+ */
+ #define CPPSTDIN "cc -E"
+ #define CPPMINUS "-"
+
+ /* HAS_ALARM:
+ * This symbol, if defined, indicates that the alarm routine is
+ * available.
+ */
+ #define HAS_ALARM /**/
+
+ /* HASATTRIBUTE:
+ * This symbol indicates the C compiler can check for function attributes,
+ * such as printf formats. This is normally only supported by GNU cc.
+ */
+ /*#define HASATTRIBUTE / **/
+ #ifndef HASATTRIBUTE
+ #define __attribute__(_arg_)
+ #endif
+
+ /* HAS_BCMP:
+ * This symbol is defined if the bcmp() routine is available to
+ * compare blocks of memory.
+ */
+ /*#define HAS_BCMP /**/
+
+ /* HAS_BCOPY:
+ * This symbol is defined if the bcopy() routine is available to
+ * copy blocks of memory.
+ */
+ /*#define HAS_BCOPY /**/
+
+ /* HAS_BZERO:
+ * This symbol is defined if the bzero() routine is available to
+ * set a memory block to 0.
+ */
+ /*#define HAS_BZERO /**/
+
+ /* HAS_CHOWN:
+ * This symbol, if defined, indicates that the chown routine is
+ * available.
+ */
+ /*#define HAS_CHOWN /**/
+
+ /* HAS_CHROOT:
+ * This symbol, if defined, indicates that the chroot routine is
+ * available.
+ */
+ /*#define HAS_CHROOT /**/
+
+ /* HAS_CHSIZE:
+ * This symbol, if defined, indicates that the chsize routine is available
+ * to truncate files. You might need a -lx to get this routine.
+ */
+ /*#define HAS_CHSIZE / **/
+
+ /* HASCONST:
+ * This symbol, if defined, indicates that this C compiler knows about
+ * the const type. There is no need to actually test for that symbol
+ * within your programs. The mere use of the "const" keyword will
+ * trigger the necessary tests.
+ */
+ #define HASCONST /**/
+ #ifndef HASCONST
+ #define const
+ #endif
+
+ /* HAS_CRYPT:
+ * This symbol, if defined, indicates that the crypt routine is available
+ * to encrypt passwords and the like.
+ */
+ /*#define HAS_CRYPT /**/
+
+ /* HAS_CUSERID:
+ * This symbol, if defined, indicates that the cuserid routine is
+ * available to get character login names.
+ */
+ /*#define HAS_CUSERID /**/
+
+ /* HAS_DBL_DIG:
+ * This symbol, if defined, indicates that this system's <float.h>
+ * or <limits.h> defines the symbol DBL_DIG, which is the number
+ * of significant digits in a double precision number. If this
+ * symbol is not defined, a guess of 15 is usually pretty good.
+ */
+ #define HAS_DBL_DIG /* */
+
+ /* HAS_DIFFTIME:
+ * This symbol, if defined, indicates that the difftime routine is
+ * available.
+ */
+ #define HAS_DIFFTIME /**/
+
+ /* HAS_DLERROR:
+ * This symbol, if defined, indicates that the dlerror routine is
+ * available to return a string describing the last error that
+ * occurred from a call to dlopen(), dlclose() or dlsym().
+ */
+ /*#define HAS_DLERROR /**/
+
+ /* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+ /* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+ #define SETUID_SCRIPTS_ARE_SECURE_NOW /**/ /* PG: ASSUME THESE ARE NO-OPS W/O SETUID */
+ /*#define DOSUID / **/
+
+ /* HAS_DUP2:
+ * This symbol, if defined, indicates that the dup2 routine is
+ * available to duplicate file descriptors.
+ */
+ /*#define HAS_DUP2 /**/
+
+ /* HAS_FCHMOD:
+ * This symbol, if defined, indicates that the fchmod routine is available
+ * to change mode of opened files. If unavailable, use chmod().
+ */
+ #define HAS_FCHMOD /**/
+
+ /* HAS_FCHOWN:
+ * This symbol, if defined, indicates that the fchown routine is available
+ * to change ownership of opened files. If unavailable, use chown().
+ */
+ /*#define HAS_FCHOWN /**/
+
+ /* HAS_FCNTL:
+ * This symbol, if defined, indicates to the C program that
+ * the fcntl() function exists.
+ */
+ #define HAS_FCNTL /**/
+
+ /* HAS_FGETPOS:
+ * This symbol, if defined, indicates that the fgetpos routine is
+ * available to get the file position indicator, similar to ftell().
+ */
+ #define HAS_FGETPOS /**/
+
+ /* FLEXFILENAMES:
+ * This symbol, if defined, indicates that the system supports filenames
+ * longer than 14 characters.
+ */
+ #define FLEXFILENAMES /**/
+
+ /* HAS_FLOCK:
+ * This symbol, if defined, indicates that the flock routine is
+ * available to do file locking.
+ */
+ /*#define HAS_FLOCK / **/
+
+ /* HAS_FORK:
+ * This symbol, if defined, indicates that the fork routine is
+ * available.
+ */
+ /*#define HAS_FORK /**/
+
+ /* HAS_FSETPOS:
+ * This symbol, if defined, indicates that the fsetpos routine is
+ * available to set the file position indicator, similar to fseek().
+ */
+ #define HAS_FSETPOS /**/
+
+ /* I_SYS_MOUNT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/mount.h>.
+ */
+ /*#define I_SYS_MOUNT /**/
+
+ /* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+ /*#define HAS_FSTATFS /**/
+
+ /* HAS_STRUCT_STATFS_FLAGS:
+ * This symbol, if defined, indicates that the struct statfs has
+ * the f_flags member for mount flags.
+ */
+ /*#define HAS_STRUCT_STATFS_FLAGS /**/
+
+ /* I_SYS_STATVFS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/statvfs.h>.
+ */
+ /*#define I_SYS_STATVFS /**/
+
+ /* HAS_FSTATVFS:
+ * This symbol, if defined, indicates that the fstatvfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+ /*#define HAS_FSTATVFS /**/
+
+ /* I_MNTENT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mntent.h>.
+ */
+ /*#define I_MNTENT /**/
+
+ /* HAS_GETMNTENT:
+ * This symbol, if defined, indicates that the getmntent routine is
+ * available to lookup mount entries in some data base or other.
+ */
+ /*#define HAS_GETMNTENT /**/
+
+ /* HAS_HASMNTOPT:
+ * This symbol, if defined, indicates that the hasmntopt routine is
+ * available to query mount entries returned by getmntent.
+ */
+ /*#define HAS_HASMNTOPT /**/
+
+ /* HAS_GETTIMEOFDAY:
+ * This symbol, if defined, indicates that the gettimeofday() system
+ * call is available for a sub-second accuracy clock. Usually, the file
+ * <sys/resource.h> needs to be included (see I_SYS_RESOURCE).
+ * The type "Timeval" should be used to refer to "struct timeval".
+ */
+ /*#define HAS_GETTIMEOFDAY / **/
+ #ifdef HAS_GETTIMEOFDAY
+ #define Timeval struct timeval /* Structure used by gettimeofday() */
+ #endif
+
+ /* HAS_GETGROUPS:
+ * This symbol, if defined, indicates that the getgroups() routine is
+ * available to get the list of process groups. If unavailable, multiple
+ * groups are probably not supported.
+ */
+ /*#define HAS_GETGROUPS /**/
+
+ /* HAS_UNAME:
+ * This symbol, if defined, indicates that the C program may use the
+ * uname() routine to derive the host name. See also HAS_GETHOSTNAME
+ * and PHOSTNAME.
+ */
+ #define HAS_UNAME /**/
+
+ /* HAS_GETLOGIN:
+ * This symbol, if defined, indicates that the getlogin routine is
+ * available to get the login name.
+ */
+ #define HAS_GETLOGIN /**/
+
+ /* HAS_GETPGID:
+ * This symbol, if defined, indicates to the C program that
+ * the getpgid(pid) function is available to get the
+ * process group id.
+ */
+ /*#define HAS_GETPGID /**/
+
+ /* HAS_GETPGRP:
+ * This symbol, if defined, indicates that the getpgrp routine is
+ * available to get the current process group.
+ */
+ /* USE_BSD_GETPGRP:
+ * This symbol, if defined, indicates that getpgrp needs one
+ * arguments whereas USG one needs none.
+ */
+ #define HAS_GETPGRP /**/
+ /*#define USE_BSD_GETPGRP / **/
+
+ /* HAS_GETPGRP2:
+ * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
+ * routine is available to get the current process group.
+ */
+ /*#define HAS_GETPGRP2 / **/
+
+ /* HAS_GETPPID:
+ * This symbol, if defined, indicates that the getppid routine is
+ * available to get the parent process ID.
+ */
+ #define HAS_GETPPID /**/
+
+ /* HAS_GETPRIORITY:
+ * This symbol, if defined, indicates that the getpriority routine is
+ * available to get a process's priority.
+ */
+ /*#define HAS_GETPRIORITY /**/
+
+ /* HAS_HTONL:
+ * This symbol, if defined, indicates that the htonl() routine (and
+ * friends htons() ntohl() ntohs()) are available to do network
+ * order byte swapping.
+ */
+ /* HAS_HTONS:
+ * This symbol, if defined, indicates that the htons() routine (and
+ * friends htonl() ntohl() ntohs()) are available to do network
+ * order byte swapping.
+ */
+ /* HAS_NTOHL:
+ * This symbol, if defined, indicates that the ntohl() routine (and
+ * friends htonl() htons() ntohs()) are available to do network
+ * order byte swapping.
+ */
+ /* HAS_NTOHS:
+ * This symbol, if defined, indicates that the ntohs() routine (and
+ * friends htonl() htons() ntohl()) are available to do network
+ * order byte swapping.
+ */
+ #define HAS_HTONL /**/
+ #define HAS_HTONS /**/
+ #define HAS_NTOHL /**/
+ #define HAS_NTOHS /**/
+
+ /* HAS_INET_ATON:
+ * This symbol, if defined, indicates to the C program that the
+ * inet_aton() function is available to parse IP address "dotted-quad"
+ * strings.
+ */
+ /*#define HAS_INET_ATON /**/ /* PG: WE HAVE OTHERS, NOT THIS ONE. */
+
+ /* HAS_KILLPG:
+ * This symbol, if defined, indicates that the killpg routine is available
+ * to kill process groups. If unavailable, you probably should use kill
+ * with a negative process number.
+ */
+ /*#define HAS_KILLPG /**/
+
+ /* HAS_LINK:
+ * This symbol, if defined, indicates that the link routine is
+ * available to create hard links.
+ */
+ /*#define HAS_LINK /**/
+
+ /* HAS_LOCALECONV:
+ * This symbol, if defined, indicates that the localeconv routine is
+ * available for numeric and monetary formatting conventions.
+ */
+ #define HAS_LOCALECONV /**/
+
+ /* HAS_LOCKF:
+ * This symbol, if defined, indicates that the lockf routine is
+ * available to do file locking.
+ */
+ #define HAS_LOCKF /**/
+
+ /* HAS_LSTAT:
+ * This symbol, if defined, indicates that the lstat routine is
+ * available to do file stats on symbolic links.
+ */
+ #define HAS_LSTAT /**/
+
+ /* HAS_MBLEN:
+ * This symbol, if defined, indicates that the mblen routine is available
+ * to find the number of bytes in a multibye character.
+ */
+ #define HAS_MBLEN /**/
+
+ /* HAS_MBSTOWCS:
+ * This symbol, if defined, indicates that the mbstowcs routine is
+ * available to covert a multibyte string into a wide character string.
+ */
+ #define HAS_MBSTOWCS /**/
+
+ /* HAS_MBTOWC:
+ * This symbol, if defined, indicates that the mbtowc routine is available
+ * to covert a multibyte to a wide character.
+ */
+ #define HAS_MBTOWC /**/
+
+ /* HAS_MEMCMP:
+ * This symbol, if defined, indicates that the memcmp routine is available
+ * to compare blocks of memory.
+ */
+ #define HAS_MEMCMP /**/
+
+ /* HAS_MEMCPY:
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy blocks of memory.
+ */
+ #define HAS_MEMCPY /**/
+
+ /* HAS_MEMMOVE:
+ * This symbol, if defined, indicates that the memmove routine is available
+ * to copy potentially overlapping blocks of memory. This should be used
+ * only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your
+ * own version.
+ */
+ #define HAS_MEMMOVE /**/
+
+ /* HAS_MEMSET:
+ * This symbol, if defined, indicates that the memset routine is available
+ * to set blocks of memory.
+ */
+ #define HAS_MEMSET /**/
+
+ /* HAS_MKDIR:
+ * This symbol, if defined, indicates that the mkdir routine is available
+ * to create directories. Otherwise you should fork off a new process to
+ * exec /bin/mkdir.
+ */
+ #define HAS_MKDIR /**/
+
+ /* HAS_MKFIFO:
+ * This symbol, if defined, indicates that the mkfifo routine is
+ * available to create FIFOs. Otherwise, mknod should be able to
+ * do it for you. However, if mkfifo is there, mknod might require
+ * super-user privileges which mkfifo will not.
+ */
+ #define HAS_MKFIFO /**/
+
+ /* HAS_MKTIME:
+ * This symbol, if defined, indicates that the mktime routine is
+ * available.
+ */
+ #define HAS_MKTIME /**/
+
+ /* HAS_MSG:
+ * This symbol, if defined, indicates that the entire msg*(2) library is
+ * supported (IPC mechanism based on message queues).
+ */
+ /*#define HAS_MSG /**/
+
+ /* HAS_NICE:
+ * This symbol, if defined, indicates that the nice routine is
+ * available.
+ */
+ /*#define HAS_NICE /**/
+
+ /* HAS_PATHCONF:
+ * This symbol, if defined, indicates that pathconf() is available
+ * to determine file-system related limits and options associated
+ * with a given filename.
+ */
+ /* HAS_FPATHCONF:
+ * This symbol, if defined, indicates that pathconf() is available
+ * to determine file-system related limits and options associated
+ * with a given open file descriptor.
+ */
+ #define HAS_PATHCONF /**/
+ #define HAS_FPATHCONF /**/
+
+ /* HAS_PAUSE:
+ * This symbol, if defined, indicates that the pause routine is
+ * available to suspend a process until a signal is received.
+ */
+ #define HAS_PAUSE /**/
+
+ /* HAS_PIPE:
+ * This symbol, if defined, indicates that the pipe routine is
+ * available to create an inter-process channel.
+ */
+ #define HAS_PIPE /**/
+
+ /* HAS_POLL:
+ * This symbol, if defined, indicates that the poll routine is
+ * available to poll active file descriptors. You may safely
+ * include <poll.h> when this symbol is defined.
+ */
+ #define HAS_POLL /**/
+
+ /* HAS_READDIR:
+ * This symbol, if defined, indicates that the readdir routine is
+ * available to read directory entries. You may have to include
+ * <dirent.h>. See I_DIRENT.
+ */
+ #define HAS_READDIR /**/
+
+ /* HAS_SEEKDIR:
+ * This symbol, if defined, indicates that the seekdir routine is
+ * available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+ /*#define HAS_SEEKDIR /**/
+
+ /* HAS_TELLDIR:
+ * This symbol, if defined, indicates that the telldir routine is
+ * available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+ /*#define HAS_TELLDIR /**/
+
+ /* HAS_REWINDDIR:
+ * This symbol, if defined, indicates that the rewinddir routine is
+ * available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+ #define HAS_REWINDDIR /**/
+
+ /* HAS_READLINK:
+ * This symbol, if defined, indicates that the readlink routine is
+ * available to read the value of a symbolic link.
+ */
+ #define HAS_READLINK /**/
+
+ /* HAS_RENAME:
+ * This symbol, if defined, indicates that the rename routine is available
+ * to rename files. Otherwise you should do the unlink(), link(), unlink()
+ * trick.
+ */
+ #define HAS_RENAME /**/
+
+ /* HAS_RMDIR:
+ * This symbol, if defined, indicates that the rmdir routine is
+ * available to remove directories. Otherwise you should fork off a
+ * new process to exec /bin/rmdir.
+ */
+ #define HAS_RMDIR /**/
+
+ /* HAS_SELECT:
+ * This symbol, if defined, indicates that the select routine is
+ * available to select active file descriptors. If the timeout field
+ * is used, <sys/time.h> may need to be included.
+ */
+ #define HAS_SELECT /**/
+
+ /* HAS_SEM:
+ * This symbol, if defined, indicates that the entire sem*(2) library is
+ * supported.
+ */
+ /*#define HAS_SEM /**/
+
+ /* HAS_SETEGID:
+ * This symbol, if defined, indicates that the setegid routine is available
+ * to change the effective gid of the current program.
+ */
+ /*#define HAS_SETEGID /**/
+
+ /* HAS_SETEUID:
+ * This symbol, if defined, indicates that the seteuid routine is available
+ * to change the effective uid of the current program.
+ */
+ /*#define HAS_SETEUID /**/
+
+ /* HAS_SETLINEBUF:
+ * This symbol, if defined, indicates that the setlinebuf routine is
+ * available to change stderr or stdout from block-buffered or unbuffered
+ * to a line-buffered mode.
+ */
+ /*#define HAS_SETLINEBUF /**/
+
+ /* HAS_SETLOCALE:
+ * This symbol, if defined, indicates that the setlocale routine is
+ * available to handle locale-specific ctype implementations.
+ */
+ #define HAS_SETLOCALE /**/
+
+ /* HAS_SETPGID:
+ * This symbol, if defined, indicates that the setpgid(pid, gpid)
+ * routine is available to set process group ID.
+ */
+ /*#define HAS_SETPGID /**/
+
+ /* HAS_SETPGRP:
+ * This symbol, if defined, indicates that the setpgrp routine is
+ * available to set the current process group.
+ */
+ /* USE_BSD_SETPGRP:
+ * This symbol, if defined, indicates that setpgrp needs two
+ * arguments whereas USG one needs none. See also HAS_SETPGID
+ * for a POSIX interface.
+ */
+ /*#define HAS_SETPGRP /**/
+ /*#define USE_BSD_SETPGRP / **/
+
+ /* HAS_SETPGRP2:
+ * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
+ * routine is available to set the current process group.
+ */
+ /*#define HAS_SETPGRP2 / **/
+
+ /* HAS_SETPRIORITY:
+ * This symbol, if defined, indicates that the setpriority routine is
+ * available to set a process's priority.
+ */
+ /*#define HAS_SETPRIORITY /**/
+
+ /* HAS_SETREGID:
+ * This symbol, if defined, indicates that the setregid routine is
+ * available to change the real and effective gid of the current
+ * process.
+ */
+ /* HAS_SETRESGID:
+ * This symbol, if defined, indicates that the setresgid routine is
+ * available to change the real, effective and saved gid of the current
+ * process.
+ */
+ /*#define HAS_SETREGID /**/
+ /*#define HAS_SETRESGID / **/
+
+ /* HAS_SETREUID:
+ * This symbol, if defined, indicates that the setreuid routine is
+ * available to change the real and effective uid of the current
+ * process.
+ */
+ /* HAS_SETRESUID:
+ * This symbol, if defined, indicates that the setresuid routine is
+ * available to change the real, effective and saved uid of the current
+ * process.
+ */
+ /*#define HAS_SETREUID /**/
+ /*#define HAS_SETRESUID / **/
+
+ /* HAS_SETRGID:
+ * This symbol, if defined, indicates that the setrgid routine is available
+ * to change the real gid of the current program.
+ */
+ /*#define HAS_SETRGID / **/
+
+ /* HAS_SETRUID:
+ * This symbol, if defined, indicates that the setruid routine is available
+ * to change the real uid of the current program.
+ */
+ /*#define HAS_SETRUID / **/
+
+ /* HAS_SETSID:
+ * This symbol, if defined, indicates that the setsid routine is
+ * available to set the process group ID.
+ */
+ /*#define HAS_SETSID /**/
+
+ /* HAS_SHM:
+ * This symbol, if defined, indicates that the entire shm*(2) library is
+ * supported.
+ */
+ /*#define HAS_SHM /**/
+
+ /* Shmat_t:
+ * This symbol holds the return type of the shmat() system call.
+ * Usually set to 'void *' or 'char *'.
+ */
+ /* HAS_SHMAT_PROTOTYPE:
+ * This symbol, if defined, indicates that the sys/shm.h includes
+ * a prototype for shmat(). Otherwise, it is up to the program to
+ * guess one. Shmat_t shmat _((int, Shmat_t, int)) is a good guess,
+ * but not always right so it should be emitted by the program only
+ * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
+ */
+ #define Shmat_t void * /**/
+ #define HAS_SHMAT_PROTOTYPE /**/
+
+ /* USE_STAT_BLOCKS:
+ * This symbol is defined if this system has a stat structure declaring
+ * st_blksize and st_blocks.
+ */
+ /*#define USE_STAT_BLOCKS /**/
+
+ /* HAS_STRCHR:
+ * This symbol is defined to indicate that the strchr()/strrchr()
+ * functions are available for string searching. If not, try the
+ * index()/rindex() pair.
+ */
+ /* HAS_INDEX:
+ * This symbol is defined to indicate that the index()/rindex()
+ * functions are available for string searching.
+ */
+ #define HAS_STRCHR /**/
+ /*#define HAS_INDEX / **/
+
+ /* HAS_STRCOLL:
+ * This symbol, if defined, indicates that the strcoll routine is
+ * available to compare strings using collating information.
+ */
+ #define HAS_STRCOLL /**/
+
+ /* USE_STRUCT_COPY:
+ * This symbol, if defined, indicates that this C compiler knows how
+ * to copy structures. If undefined, you'll need to use a block copy
+ * routine of some sort instead.
+ */
+ #define USE_STRUCT_COPY /**/
+
+ /* HAS_STRERROR:
+ * This symbol, if defined, indicates that the strerror routine is
+ * available to translate error numbers to strings. See the writeup
+ * of Strerror() in this file before you try to define your own.
+ */
+ /* HAS_SYS_ERRLIST:
+ * This symbol, if defined, indicates that the sys_errlist array is
+ * available to translate error numbers to strings. The extern int
+ * sys_nerr gives the size of that table.
+ */
+ /* Strerror:
+ * This preprocessor symbol is defined as a macro if strerror() is
+ * not available to translate error numbers to strings but sys_errlist[]
+ * array is there.
+ */
+ #define HAS_STRERROR /**/
+ #define HAS_SYS_ERRLIST /**/
+ #define Strerror(e) strerror(e)
+
+ /* HAS_STRTOD:
+ * This symbol, if defined, indicates that the strtod routine is
+ * available to provide better numeric string conversion than atof().
+ */
+ #define HAS_STRTOD /**/
+
+ /* HAS_STRTOL:
+ * This symbol, if defined, indicates that the strtol routine is available
+ * to provide better numeric string conversion than atoi() and friends.
+ */
+ #define HAS_STRTOL /**/
+
+ /* HAS_STRTOUL:
+ * This symbol, if defined, indicates that the strtoul routine is
+ * available to provide conversion of strings to unsigned long.
+ */
+ #define HAS_STRTOUL /**/
+
+ /* HAS_STRXFRM:
+ * This symbol, if defined, indicates that the strxfrm() routine is
+ * available to transform strings.
+ */
+ #define HAS_STRXFRM /**/
+
+ /* HAS_SYMLINK:
+ * This symbol, if defined, indicates that the symlink routine is available
+ * to create symbolic links.
+ */
+ #define HAS_SYMLINK /**/
+
+ /* HAS_SYSCALL:
+ * This symbol, if defined, indicates that the syscall routine is
+ * available to call arbitrary system calls. If undefined, that's tough.
+ */
+ /*#define HAS_SYSCALL /**/
+
+ /* HAS_SYSCONF:
+ * This symbol, if defined, indicates that sysconf() is available
+ * to determine system related limits and options.
+ */
+ #define HAS_SYSCONF /**/
+
+ /* HAS_SYSTEM:
+ * This symbol, if defined, indicates that the system routine is
+ * available to issue a shell command.
+ */
+ #define HAS_SYSTEM /**/
+
+ /* HAS_TCGETPGRP:
+ * This symbol, if defined, indicates that the tcgetpgrp routine is
+ * available to get foreground process group ID.
+ */
+ /*#define HAS_TCGETPGRP /**/
+
+ /* HAS_TCSETPGRP:
+ * This symbol, if defined, indicates that the tcsetpgrp routine is
+ * available to set foreground process group ID.
+ */
+ /*#define HAS_TCSETPGRP /**/
+
+ /* HAS_TRUNCATE:
+ * This symbol, if defined, indicates that the truncate routine is
+ * available to truncate files.
+ */
+ /*#define HAS_TRUNCATE /**/
+
+ /* HAS_TZNAME:
+ * This symbol, if defined, indicates that the tzname[] array is
+ * available to access timezone names.
+ */
+ #define HAS_TZNAME /**/
+
+ /* HAS_UMASK:
+ * This symbol, if defined, indicates that the umask routine is
+ * available to set and get the value of the file creation mask.
+ */
+ #define HAS_UMASK /**/
+
+ /* HAS_VFORK:
+ * This symbol, if defined, indicates that vfork() exists.
+ */
+ /*#define HAS_VFORK / **/
+
+ /* HASVOLATILE:
+ * This symbol, if defined, indicates that this C compiler knows about
+ * the volatile declaration.
+ */
+ #define HASVOLATILE /**/
+ #ifndef HASVOLATILE
+ #define volatile
+ #endif
+
+ /* HAS_WAIT4:
+ * This symbol, if defined, indicates that wait4() exists.
+ */
+ /*#define HAS_WAIT4 /**/
+
+ /* HAS_WAITPID:
+ * This symbol, if defined, indicates that the waitpid routine is
+ * available to wait for child process.
+ */
+ #define HAS_WAITPID /**/
+
+ /* HAS_WCSTOMBS:
+ * This symbol, if defined, indicates that the wcstombs routine is
+ * available to convert wide character strings to multibyte strings.
+ */
+ #define HAS_WCSTOMBS /**/
+
+ /* HAS_WCTOMB:
+ * This symbol, if defined, indicates that the wctomb routine is available
+ * to covert a wide character to a multibyte.
+ */
+ #define HAS_WCTOMB /**/
+
+ /* EBCDIC:
+ * This symbol, if defined, indicates that this system uses
+ * EBCDIC encoding.
+ */
+ /*#define EBCDIC /**/
+
+ /* I_ARPA_INET:
+ * This symbol, if defined, indicates that <arpa/inet.h> exists and should
+ * be included.
+ */
+ /*#define I_ARPA_INET /**/
+
+ /* I_DBM:
+ * This symbol, if defined, indicates that <dbm.h> exists and should
+ * be included.
+ */
+ /* I_RPCSVC_DBM:
+ * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ * should be included.
+ */
+ /*#define I_DBM /**/
+ /*#define I_RPCSVC_DBM /**/
+
+ /* I_DIRENT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <dirent.h>. Using this symbol also triggers the definition
+ * of the Direntry_t define which ends up being 'struct dirent' or
+ * 'struct direct' depending on the availability of <dirent.h>.
+ */
+ /* DIRNAMLEN:
+ * This symbol, if defined, indicates to the C program that the length
+ * of directory entry names is provided by a d_namlen field. Otherwise
+ * you need to do strlen() on the d_name field.
+ */
+ /* Direntry_t:
+ * This symbol is set to 'struct direct' or 'struct dirent' depending on
+ * whether dirent is available or not. You should use this pseudo type to
+ * portably declare your directory entries.
+ */
+ #define I_DIRENT /**/
+ /*#define DIRNAMLEN / **/
+ #define Direntry_t struct dirent
+
+ /* I_DLFCN:
+ * This symbol, if defined, indicates that <dlfcn.h> exists and should
+ * be included.
+ */
+ /*#define I_DLFCN /**/
+
+ /* I_FCNTL:
+ * This manifest constant tells the C program to include <fcntl.h>.
+ */
+ #define I_FCNTL /**/
+
+ /* I_FLOAT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <float.h> to get definition of symbols like DBL_MAX or
+ * DBL_MIN, i.e. machine dependent floating point values.
+ */
+ #define I_FLOAT /**/
+
+ /* I_GRP:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <grp.h>.
+ */
+ /* GRPASSWD:
+ * This symbol, if defined, indicates to the C program that struct group
+ * contains gr_passwd.
+ */
+ /* HAS_SETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for initializing sequential access of the group database.
+ */
+ /* HAS_GETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for sequential access of the group database.
+ */
+ /* HAS_ENDGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for finalizing sequential access of the group database.
+ */
+ /*#define I_GRP /**/
+ /*#define GRPASSWD /**/
+ /*#define HAS_SETGRENT /**/
+ /*#define HAS_GETGRENT /**/
+ /*#define HAS_ENDGRENT /**/
+
+ /* I_LIMITS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <limits.h> to get definition of symbols like WORD_BIT or
+ * LONG_MAX, i.e. machine dependant limitations.
+ */
+ #define I_LIMITS /**/
+
+ /* I_LOCALE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <locale.h>.
+ */
+ #define I_LOCALE /**/
+
+ /* I_MATH:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <math.h>.
+ */
+ #define I_MATH /**/
+
+ /* I_MEMORY:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <memory.h>.
+ */
+ /*#define I_MEMORY / **/
+
+ /* I_NDBM:
+ * This symbol, if defined, indicates that <ndbm.h> exists and should
+ * be included.
+ */
+ /*#define I_NDBM /**/
+
+ /* I_NET_ERRNO:
+ * This symbol, if defined, indicates that <net/errno.h> exists and
+ * should be included.
+ */
+ /*#define I_NET_ERRNO / **/
+
+ /* I_NETINET_IN:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
+ */
+ #define I_NETINET_IN /**/
+
+ /* I_SFIO:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sfio.h>.
+ */
+ /*#define I_SFIO / **/
+
+ /* I_STDDEF:
+ * This symbol, if defined, indicates that <stddef.h> exists and should
+ * be included.
+ */
+ #define I_STDDEF /**/
+
+ /* I_STDLIB:
+ * This symbol, if defined, indicates that <stdlib.h> exists and should
+ * be included.
+ */
+ #define I_STDLIB /**/
+
+ /* I_STRING:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <string.h> (USG systems) instead of <strings.h> (BSD systems).
+ */
+ #define I_STRING /**/
+
+ /* I_SYS_DIR:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/dir.h>.
+ */
+ /*#define I_SYS_DIR / **/
+
+ /* I_SYS_FILE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/file.h> to get definition of R_OK and friends.
+ */
+ /*#define I_SYS_FILE / **/
+
+ /* I_SYS_IOCTL:
+ * This symbol, if defined, indicates that <sys/ioctl.h> exists and should
+ * be included. Otherwise, include <sgtty.h> or <termio.h>.
+ */
+ #define I_SYS_IOCTL /**/
+
+ /* I_SYS_NDIR:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/ndir.h>.
+ */
+ /*#define I_SYS_NDIR / **/
+
+ /* I_SYS_PARAM:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/param.h>.
+ */
+ /*#define I_SYS_PARAM /**/
+
+ /* I_SYS_RESOURCE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/resource.h>.
+ */
+ /*#define I_SYS_RESOURCE /**/
+
+ /* I_SYS_SELECT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/select.h> in order to get definition of struct timeval.
+ */
+ #define I_SYS_SELECT /**/
+
+ /* I_SYS_STAT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/stat.h>.
+ */
+ #define I_SYS_STAT /**/
+
+ /* I_SYS_TIMES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/times.h>.
+ */
+ #define I_SYS_TIMES /**/
+
+ /* I_SYS_TYPES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/types.h>.
+ */
+ #define I_SYS_TYPES /**/
+
+ /* I_SYS_UN:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/un.h> to get UNIX domain socket definitions.
+ */
+ /*#define I_SYS_UN /**/
+
+ /* I_SYS_WAIT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/wait.h>.
+ */
+ #define I_SYS_WAIT /**/
+
+ /* I_TERMIO:
+ * This symbol, if defined, indicates that the program should include
+ * <termio.h> rather than <sgtty.h>. There are also differences in
+ * the ioctl() calls that depend on the value of this symbol.
+ */
+ /* I_TERMIOS:
+ * This symbol, if defined, indicates that the program should include
+ * the POSIX termios.h rather than sgtty.h or termio.h.
+ * There are also differences in the ioctl() calls that depend on the
+ * value of this symbol.
+ */
+ /* I_SGTTY:
+ * This symbol, if defined, indicates that the program should include
+ * <sgtty.h> rather than <termio.h>. There are also differences in
+ * the ioctl() calls that depend on the value of this symbol.
+ */
+ /*#define I_TERMIO / **/
+ #define I_TERMIOS /**/
+ /*#define I_SGTTY / **/
+
+ /* I_UNISTD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <unistd.h>.
+ */
+ #define I_UNISTD /**/
+
+ /* I_UTIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <utime.h>.
+ */
+ #define I_UTIME /**/
+
+ /* I_VALUES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <values.h> to get definition of symbols like MINFLOAT or
+ * MAXLONG, i.e. machine dependant limitations. Probably, you
+ * should use <limits.h> instead, if it is available.
+ */
+ #define I_VALUES /**/
+
+ /* I_STDARG:
+ * This symbol, if defined, indicates that <stdarg.h> exists and should
+ * be included.
+ */
+ /* I_VARARGS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <varargs.h>.
+ */
+ #define I_STDARG /**/
+ /*#define I_VARARGS / **/
+
+ /* I_VFORK:
+ * This symbol, if defined, indicates to the C program that it should
+ * include vfork.h.
+ */
+ /*#define I_VFORK / **/
+
+ /* CAN_PROTOTYPE:
+ * If defined, this macro indicates that the C compiler can handle
+ * function prototypes.
+ */
+ /* _:
+ * This macro is used to declare function parameters for folks who want
+ * to make declarations with prototypes using a different style than
+ * the above macros. Use double parentheses. For example:
+ *
+ * int main _((int argc, char *argv[]));
+ */
+ #define CAN_PROTOTYPE /**/
+ #ifdef CAN_PROTOTYPE
+ #define _(args) args
+ #else
+ #define _(args) ()
+ #endif
+
+ /* SH_PATH:
+ * This symbol contains the full pathname to the shell used on this
+ * on this system to execute Bourne shell scripts. Usually, this will be
+ * /bin/sh, though it's possible that some systems will have /bin/ksh,
+ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ * D:/bin/sh.exe.
+ */
+ #define SH_PATH "/bin/sh" /**/
+
+ /* STDCHAR:
+ * This symbol is defined to be the type of char used in stdio.h.
+ * It has the values "unsigned char" or "char".
+ */
+ #define STDCHAR unsigned char /**/
+
+ /* MEM_ALIGNBYTES:
+ * This symbol contains the number of bytes required to align a
+ * double. Usual values are 2, 4 and 8.
+ * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
+ * Binaries (MAB) for targets with varying alignment. This only matters
+ * for perl, where the config.h can be generated and installed on one
+ * system, and used by a different architecture to build an extension.
+ * The default is eight, for safety.
+ */
+ #define MEM_ALIGNBYTES 8 /**/
+
+ /* BYTEORDER:
+ * This symbol holds the hexadecimal constant defined in byteorder,
+ * i.e. 0x1234 or 0x4321, etc...
+ * On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
+ * Binaries (MAB) on either big endian or little endian machines.
+ * The endian-ness is available at compile-time. This only matters
+ * for perl, where the config.h can be generated and installed on
+ * one system, and used by a different architecture to build an
+ * extension. Older versions of NeXT that might not have
+ * defined either *_ENDIAN__ were all on Motorola 680x0 series,
+ * so the default case (for NeXT) is big endian to catch them.
+ * This might matter for NeXT 3.0.
+ */
+ #ifndef NeXT
+ #define BYTEORDER 0x4321 /* large digits for MSB */
+ #else /* NeXT */
+ #ifdef __LITTLE_ENDIAN__
+ #define BYTEORDER 0x1234
+ #else /* __BIG_ENDIAN__ */
+ #define BYTEORDER 0x4321
+ #endif /* ENDIAN CHECK */
+ #endif /* NeXT */
+
+ /* CASTI32:
+ * This symbol is defined if the C compiler can cast negative
+ * or large floating point numbers to 32-bit ints.
+ */
+ /*#define CASTI32 /**/
+
+ /* CASTNEGFLOAT:
+ * This symbol is defined if the C compiler can cast negative
+ * numbers to unsigned longs, ints and shorts.
+ */
+ /* CASTFLAGS:
+ * This symbol contains flags that say what difficulties the compiler
+ * has casting odd floating values to unsigned long:
+ * 0 = ok
+ * 1 = couldn't cast < 0
+ * 2 = couldn't cast >= 0x80000000
+ * 4 = couldn't cast in argument expression list
+ */
+ #define CASTNEGFLOAT /**/
+ #define CASTFLAGS 0 /**/
+
+ /* VOID_CLOSEDIR:
+ * This symbol, if defined, indicates that the closedir() routine
+ * does not return a value.
+ */
+ /*#define VOID_CLOSEDIR / **/
+
+ /* Gconvert:
+ * This preprocessor macro is defined to convert a floating point
+ * number to a string without a trailing decimal point. This
+ * emulates the behavior of sprintf("%g"), but is sometimes much more
+ * efficient. If gconvert() is not available, but gcvt() drops the
+ * trailing decimal point, then gcvt() is used. If all else fails,
+ * a macro using sprintf("%g") is used. Arguments for the Gconvert
+ * macro are: value, number of digits, whether trailing zeros should
+ * be retained, and the output buffer.
+ * Possible values are:
+ * d_Gconvert='gconvert((x),(n),(t),(b))'
+ * d_Gconvert='gcvt((x),(n),(b))'
+ * d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ * The last two assume trailing zeros should not be kept.
+ */
+ #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
+
+ /* HAS_GNULIBC:
+ * This symbol, if defined, indicates to the C program that
+ * the GNU C library is being used.
+ */
+ /*#define HAS_GNULIBC /**/
+ /* HAS_ISASCII:
+ * This manifest constant lets the C program know that isascii
+ * is available.
+ */
+ #define HAS_ISASCII /**/
+
+ /* HAS_LCHOWN:
+ * This symbol, if defined, indicates that the lchown routine is
+ * available to operate on a symbolic link (instead of following the
+ * link).
+ */
+ /*#define HAS_LCHOWN /**/
+
+ /* HAS_OPEN3:
+ * This manifest constant lets the C program know that the three
+ * argument form of open(2) is available.
+ */
+ #define HAS_OPEN3 /**/
+
+ /* HAS_SAFE_BCOPY:
+ * This symbol, if defined, indicates that the bcopy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
+ */
+ /*#define HAS_SAFE_BCOPY /**/ /* PG: VOS has bcopy; do not know if it is safe. */
+
+ /* HAS_SAFE_MEMCPY:
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
+ */
+ /*#define HAS_SAFE_MEMCPY / **/
+
+ /* HAS_SANE_MEMCMP:
+ * This symbol, if defined, indicates that the memcmp routine is available
+ * and can be used to compare relative magnitudes of chars with their high
+ * bits set. If it is not defined, roll your own version.
+ */
+ #define HAS_SANE_MEMCMP / **/ /* PG: VOS GUESS */
+
+ /* HAS_SIGACTION:
+ * This symbol, if defined, indicates that Vr4's sigaction() routine
+ * is available.
+ */
+ /*#define HAS_SIGACTION /**/
+
+ /* Sigjmp_buf:
+ * This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+ /* Sigsetjmp:
+ * This macro is used in the same way as sigsetjmp(), but will invoke
+ * traditional setjmp() if sigsetjmp isn't available.
+ * See HAS_SIGSETJMP.
+ */
+ /* Siglongjmp:
+ * This macro is used in the same way as siglongjmp(), but will invoke
+ * traditional longjmp() if siglongjmp isn't available.
+ * See HAS_SIGSETJMP.
+ */
+ /*#define HAS_SIGSETJMP /**/
+ #ifdef HAS_SIGSETJMP
+ #define Sigjmp_buf sigjmp_buf
+ #define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
+ #define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
+ #else
+ #define Sigjmp_buf jmp_buf
+ #define Sigsetjmp(buf,save_mask) setjmp((buf))
+ #define Siglongjmp(buf,retval) longjmp((buf),(retval))
+ #endif
+
+ /* USE_STDIO_PTR:
+ * This symbol is defined if the _ptr and _cnt fields (or similar)
+ * of the stdio FILE structure can be used to access the stdio buffer
+ * for a file handle. If this is defined, then the FILE_ptr(fp)
+ * and FILE_cnt(fp) macros will also be defined and should be used
+ * to access these fields.
+ */
+ /* FILE_ptr:
+ * This macro is used to access the _ptr field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+ /* STDIO_PTR_LVALUE:
+ * This symbol is defined if the FILE_ptr macro can be used as an
+ * lvalue.
+ */
+ /* FILE_cnt:
+ * This macro is used to access the _cnt field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+ /* STDIO_CNT_LVALUE:
+ * This symbol is defined if the FILE_cnt macro can be used as an
+ * lvalue.
+ */
+ #define USE_STDIO_PTR /**/
+ #ifdef USE_STDIO_PTR
+ #define FILE_ptr(fp) ((fp)->_ptr)
+ #define STDIO_PTR_LVALUE /**/
+ #define FILE_cnt(fp) ((fp)->_cnt)
+ #define STDIO_CNT_LVALUE /**/
+ #endif
+
+ /* USE_STDIO_BASE:
+ * This symbol is defined if the _base field (or similar) of the
+ * stdio FILE structure can be used to access the stdio buffer for
+ * a file handle. If this is defined, then the FILE_base(fp) macro
+ * will also be defined and should be used to access this field.
+ * Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ * to determine the number of bytes in the buffer. USE_STDIO_BASE
+ * will never be defined unless USE_STDIO_PTR is.
+ */
+ /* FILE_base:
+ * This macro is used to access the _base field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_BASE is defined.
+ */
+ /* FILE_bufsiz:
+ * This macro is used to determine the number of bytes in the I/O
+ * buffer pointed to by _base field (or equivalent) of the FILE
+ * structure pointed to its argument. This macro will always be defined
+ * if USE_STDIO_BASE is defined.
+ */
+ #define USE_STDIO_BASE /**/
+ #ifdef USE_STDIO_BASE
+ #define FILE_base(fp) ((fp)->_base)
+ #define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base)
+ #endif
+
+ /* HAS_VPRINTF:
+ * This symbol, if defined, indicates that the vprintf routine is available
+ * to printf with a pointer to an argument list. If unavailable, you
+ * may need to write your own, probably in terms of _doprnt().
+ */
+ /* USE_CHAR_VSPRINTF:
+ * This symbol is defined if this system has vsprintf() returning type
+ * (char*). The trend seems to be to declare it as "int vsprintf()". It
+ * is up to the package author to declare vsprintf correctly based on the
+ * symbol.
+ */
+ #define HAS_VPRINTF /**/
+ /*#define USE_CHAR_VSPRINTF / **/
+
+ /* DOUBLESIZE:
+ * This symbol contains the size of a double, so that the C preprocessor
+ * can make decisions based on it.
+ */
+ #define DOUBLESIZE 8 /**/
+
+ /* I_TIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <time.h>.
+ */
+ /* I_SYS_TIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h>.
+ */
+ /* I_SYS_TIME_KERNEL:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h> with KERNEL defined.
+ */
+ /*#define I_TIME / **/
+ #define I_SYS_TIME /**/
+ /*#define I_SYS_TIME_KERNEL / **/
+
+ /* INTSIZE:
+ * This symbol contains the value of sizeof(int) so that the C
+ * preprocessor can make decisions based on it.
+ */
+ /* LONGSIZE:
+ * This symbol contains the value of sizeof(long) so that the C
+ * preprocessor can make decisions based on it.
+ */
+ /* SHORTSIZE:
+ * This symbol contains the value of sizeof(short) so that the C
+ * preprocessor can make decisions based on it.
+ */
+ #define INTSIZE 4 /**/
+ #define LONGSIZE 4 /**/
+ #define SHORTSIZE 2 /**/
+
+ /* VAL_O_NONBLOCK:
+ * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ * non-blocking I/O for the file descriptor. Note that there is no way
+ * back, i.e. you cannot turn it blocking again this way. If you wish to
+ * alternatively switch between blocking and non-blocking, use the
+ * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+ /* VAL_EAGAIN:
+ * This symbol holds the errno error code set by read() when no data was
+ * present on the non-blocking file descriptor.
+ */
+ /* RD_NODATA:
+ * This symbol holds the return code from read() when no data is present
+ * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ * not defined, then you can't distinguish between no data and EOF by
+ * issuing a read(). You'll have to find another way to tell for sure!
+ */
+ /* EOF_NONBLOCK:
+ * This symbol, if defined, indicates to the C program that a read() on
+ * a non-blocking file descriptor will return 0 on EOF, and not the value
+ * held in RD_NODATA (-1 usually, in that case!).
+ */
+ #define VAL_O_NONBLOCK O_NONBLOCK
+ #define VAL_EAGAIN EAGAIN
+ #define RD_NODATA -1
+ #define EOF_NONBLOCK
+
+ /* PTRSIZE:
+ * This symbol contains the size of a pointer, so that the C preprocessor
+ * can make decisions based on it. It will be sizeof(void *) if
+ * the compiler supports (void *); otherwise it will be
+ * sizeof(char *).
+ */
+ #define PTRSIZE 4 /**/
+
+ /* RANDBITS:
+ * This symbol contains the number of bits of random number the rand()
+ * function produces. Usual values are 15, 16, and 31.
+ */
+ #define RANDBITS 15 /**/
+
+ /* SSize_t:
+ * This symbol holds the type used by functions that return
+ * a count of bytes or an error condition. It must be a signed type.
+ * It is usually ssize_t, but may be long or int, etc.
+ * It may be necessary to include <sys/types.h> or <unistd.h>
+ * to get any typedef'ed information.
+ * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+ #define SSize_t ssize_t /* signed count of bytes */
+
+ /* OSNAME:
+ * This symbol contains the name of the operating system, as determined
+ * by Configure. You shouldn't rely on it too much; the specific
+ * feature tests from Configure are generally more reliable.
+ */
+ #define OSNAME "VOS" /**/
+
+ /* CAT2:
+ * This macro catenates 2 tokens together.
+ */
+ /* STRINGIFY:
+ * This macro surrounds its token with double quotes.
+ */
+ #if 42 == 1
+ #define CAT2(a,b)a/**/b
+ #define STRINGIFY(a)"a"
+ /* If you can get stringification with catify, tell me how! */
+ #endif
+ #if 42 == 42
+ #define CAT2(a,b)a ## b
+ #define StGiFy(a)# a
+ #define STRINGIFY(a)StGiFy(a)
+ #endif
+ #if 42 != 1 && 42 != 42
+ #include "Bletch: How does this C preprocessor catenate tokens?"
+ #endif
+
+ /* CSH:
+ * This symbol, if defined, contains the full pathname of csh.
+ */
+ /*#define HAS_CSH /**/
+ #ifdef HAS_CSH
+ /*#define CSH "/bin/csh" /**/
+ #endif
+
+ /* HAS_ENDHOSTENT:
+ * This symbol, if defined, indicates that the endhostent() routine is
+ * available to close whatever was being used for host queries.
+ */
+ #define HAS_ENDHOSTENT /**/
+
+ /* HAS_ENDNETENT:
+ * This symbol, if defined, indicates that the endnetent() routine is
+ * available to close whatever was being used for network queries.
+ */
+ #define HAS_ENDNETENT /**/
+
+ /* HAS_ENDPROTOENT:
+ * This symbol, if defined, indicates that the endprotoent() routine is
+ * available to close whatever was being used for protocol queries.
+ */
+ #define HAS_ENDPROTOENT /**/
+
+ /* HAS_ENDSERVENT:
+ * This symbol, if defined, indicates that the endservent() routine is
+ * available to close whatever was being used for service queries.
+ */
+ #define HAS_ENDSERVENT /**/
+
+ /* HAS_GETHOSTBYADDR:
+ * This symbol, if defined, indicates that the gethostbyaddr() routine is
+ * available to look up hosts by their IP addresses.
+ */
+ #define HAS_GETHOSTBYADDR /**/
+
+ /* HAS_GETHOSTBYNAME:
+ * This symbol, if defined, indicates that the gethostbyname() routine is
+ * available to look up host names in some data base or other.
+ */
+ #define HAS_GETHOSTBYNAME /**/
+
+ /* HAS_GETHOSTENT:
+ * This symbol, if defined, indicates that the gethostent() routine is
+ * available to look up host names in some data base or another.
+ */
+ #define HAS_GETHOSTENT /**/
+
+ /* HAS_GETNETBYADDR:
+ * This symbol, if defined, indicates that the getnetbyaddr() routine is
+ * available to look up networks by their IP addresses.
+ */
+ #define HAS_GETNETBYADDR /**/
+
+ /* HAS_GETNETBYNAME:
+ * This symbol, if defined, indicates that the getnetbyname() routine is
+ * available to look up networks by their names.
+ */
+ #define HAS_GETNETBYNAME /**/
+
+ /* HAS_GETNETENT:
+ * This symbol, if defined, indicates that the getnetent() routine is
+ * available to look up network names in some data base or another.
+ */
+ #define HAS_GETNETENT /**/
+
+ /* HAS_GETPROTOENT:
+ * This symbol, if defined, indicates that the getprotoent() routine is
+ * available to look up protocols in some data base or another.
+ */
+ #define HAS_GETPROTOENT /**/
+
+ /* HAS_GETPROTOBYNAME:
+ * This symbol, if defined, indicates that the getprotobyname()
+ * routine is available to look up protocols by their name.
+ */
+ /* HAS_GETPROTOBYNUMBER:
+ * This symbol, if defined, indicates that the getprotobynumber()
+ * routine is available to look up protocols by their number.
+ */
+ #define HAS_GETPROTOBYNAME /**/
+ #define HAS_GETPROTOBYNUMBER /**/
+
+ /* HAS_GETSERVENT:
+ * This symbol, if defined, indicates that the getservent() routine is
+ * available to look up network services in some data base or another.
+ */
+ #define HAS_GETSERVENT /**/
+
+ /* HAS_GETSERVBYNAME:
+ * This symbol, if defined, indicates that the getservbyname()
+ * routine is available to look up services by their name.
+ */
+ /* HAS_GETSERVBYPORT:
+ * This symbol, if defined, indicates that the getservbyport()
+ * routine is available to look up services by their port.
+ */
+ #define HAS_GETSERVBYNAME /**/
+ #define HAS_GETSERVBYPORT /**/
+
+ /* HAS_LONG_DOUBLE:
+ * This symbol will be defined if the C compiler supports long
+ * doubles.
+ */
+ /* LONG_DOUBLESIZE:
+ * This symbol contains the size of a long double, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long doubles.
+ */
+ #define HAS_LONG_DOUBLE /**/
+ #ifdef HAS_LONG_DOUBLE
+ #define LONG_DOUBLESIZE 8 /**/
+ #endif
+
+ /* HAS_LONG_LONG:
+ * This symbol will be defined if the C compiler supports
+ * long long.
+ */
+ /* LONGLONGSIZE:
+ * This symbol contains the size of a long long, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long long.
+ */
+ /*#define HAS_LONG_LONG /**/
+ #ifdef HAS_LONG_LONG
+ /*#define LONGLONGSIZE $longlongsize /**/
+ #endif
+
+ /* HAS_SETGROUPS:
+ * This symbol, if defined, indicates that the setgroups() routine is
+ * available to set the list of process groups. If unavailable, multiple
+ * groups are probably not supported.
+ */
+ /*#define HAS_SETGROUPS /**/
+
+ /* HAS_SETHOSTENT:
+ * This symbol, if defined, indicates that the sethostent() routine is
+ * available.
+ */
+ #define HAS_SETHOSTENT /**/
+
+ /* HAS_SETNETENT:
+ * This symbol, if defined, indicates that the setnetent() routine is
+ * available.
+ */
+ #define HAS_SETNETENT /**/
+
+ /* HAS_SETPROTOENT:
+ * This symbol, if defined, indicates that the setprotoent() routine is
+ * available.
+ */
+ #define HAS_SETPROTOENT /**/
+
+ /* HAS_SETSERVENT:
+ * This symbol, if defined, indicates that the setservent() routine is
+ * available.
+ */
+ #define HAS_SETSERVENT /**/
+
+ /* HAS_SETVBUF:
+ * This symbol, if defined, indicates that the setvbuf routine is
+ * available to change buffering on an open stdio stream.
+ * to a line-buffered mode.
+ */
+ #define HAS_SETVBUF /**/
+
+ /* HAS_SOCKET:
+ * This symbol, if defined, indicates that the BSD socket interface is
+ * supported.
+ */
+ /* HAS_SOCKETPAIR:
+ * This symbol, if defined, indicates that the BSD socketpair() call is
+ * supported.
+ */
+ #define HAS_SOCKET /**/
+ /*#define HAS_SOCKETPAIR / **/
+
+ /* HAS_UNION_SEMUN:
+ * This symbol, if defined, indicates that the union semun is
+ * defined by including <sys/sem.h>. If not, the user code
+ * probably needs to define it as:
+ * union semun {
+ * int val;
+ * struct semid_ds *buf;
+ * unsigned short *array;
+ * }
+ */
+ /* USE_SEMCTL_SEMUN:
+ * This symbol, if defined, indicates that union semun is
+ * used for semctl IPC_STAT.
+ */
+ /* USE_SEMCTL_SEMID_DS:
+ * This symbol, if defined, indicates that struct semid_ds * is
+ * used for semctl IPC_STAT.
+ */
+ /*#define HAS_UNION_SEMUN /**/
+ /*#define USE_SEMCTL_SEMUN /**/
+ /*#define USE_SEMCTL_SEMID_DS /**/
+
+ /* Signal_t:
+ * This symbol's value is either "void" or "int", corresponding to the
+ * appropriate return type of a signal handler. Thus, you can declare
+ * a signal handler using "Signal_t (*handler)()", and define the
+ * handler using "Signal_t handler(sig)".
+ */
+ #define Signal_t void /* Signal handler's return type */
+
+ /* Groups_t:
+ * This symbol holds the type used for the second argument to
+ * getgroups() and setgropus(). Usually, this is the same as
+ * gidtype (gid_t) , but sometimes it isn't.
+ * It can be int, ushort, uid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
+ * typedef'ed information. This is only required if you have
+ * getgroups() or setgropus()..
+ */
+ #if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+ #define Groups_t gid_t /* Type for 2nd arg to [gs]etgroups() */
+ #endif
+
+ /* I_NETDB:
+ * This symbol, if defined, indicates that <netdb.h> exists and
+ * should be included.
+ */
+ #define I_NETDB /**/
+
+ /* I_PWD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <pwd.h>.
+ */
+ /* PWQUOTA:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_quota.
+ */
+ /* PWAGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_age.
+ */
+ /* PWCHANGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_change.
+ */
+ /* PWCLASS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_class.
+ */
+ /* PWEXPIRE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_expire.
+ */
+ /* PWCOMMENT:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_comment.
+ */
+ /* PWGECOS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_gecos.
+ */
+ /* PWPASSWD:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_passwd.
+ */
+ /* HAS_SETPWENT:
+ * This symbol, if defined, indicates that the getpwrent routine is
+ * available for initializing sequential access of the passwd database.
+ */
+ /* HAS_GETPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for sequential access of the password database.
+ */
+ /* HAS_ENDPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for finalizing sequential access of the passwd database.
+ */
+ /*#define I_PWD /**/
+ /*#define PWQUOTA / **/
+ /*#define PWAGE /**/
+ /*#define PWCHANGE / **/
+ /*#define PWCLASS / **/
+ /*#define PWEXPIRE / **/
+ /*#define PWCOMMENT /**/
+ /*#define PWGECOS /**/
+ /*#define PWPASSWD /**/
+ /*#define HAS_SETPWENT /**/
+ /*#define HAS_GETPWENT /**/
+ /*#define HAS_ENDPWENT /**/
+
+ /* Free_t:
+ * This variable contains the return type of free(). It is usually
+ * void, but occasionally int.
+ */
+ /* Malloc_t:
+ * This symbol is the type of pointer returned by malloc and realloc.
+ */
+ #define Malloc_t void * /**/
+ #define Free_t void /**/
+
+ /* MYMALLOC:
+ * This symbol, if defined, indicates that we're using our own malloc.
+ */
+ /*#define MYMALLOC /**/
+
+ /* SIG_NAME:
+ * This symbol contains a list of signal names in order of
+ * signal number. This is intended
+ * to be used as a static array initialization, like this:
+ * char *sig_name[] = { SIG_NAME };
+ * The signals in the list are separated with commas, and each signal
+ * is surrounded by double quotes. There is no leading SIG in the signal
+ * name, i.e. SIGQUIT is known as "QUIT".
+ * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
+ * etc., where nn is the actual signal number (e.g. NUM37).
+ * The signal number for sig_name[i] is stored in sig_num[i].
+ * The last element is 0 to terminate the list with a NULL. This
+ * corresponds to the 0 at the end of the sig_num list.
+ */
+ /* SIG_NUM:
+ * This symbol contains a list of signal numbers, in the same order as the
+ * SIG_NAME list. It is suitable for static array initialization, as in:
+ * int sig_num[] = { SIG_NUM };
+ * The signals in the list are separated with commas, and the indices
+ * within that list and the SIG_NAME list match, so it's easy to compute
+ * the signal name from a number or vice versa at the price of a small
+ * dynamic linear lookup.
+ * Duplicates are allowed, but are moved to the end of the list.
+ * The signal number corresponding to sig_name[i] is sig_number[i].
+ * if (i < NSIG) then sig_number[i] == i.
+ * The last element is 0, corresponding to the 0 at the end of
+ * the sig_name list.
+ */
+ /*#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CHLD","PWR","WINCH","URG","IO","STOP","TSTP","CONT","TTIN","TTOU","VTALRM","PROF","XCPU","XFSZ","WAITING","LWP","FREEZE","THAW","CANCEL","RTMIN","NUM38","NUM39","NUM40","NUM41","NUM42","NUM43","RTMAX","IOT","CLD","POLL",0 /**/
+ /*#define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,6,18,22,0 /**/
+
+ #define SIG_NAME "ZERO","ABRT","FPE","ILL","INT","SEGV","TERM","USR1","USR2","IO","POLL","HUP","URG","ALRM","KILL","PIPE","QUIT","CHLD","CONT","STOP","TSTP","TTIN","TTOU","BUS","RT1","RT2","RT3","RT4","RT5","RT6","RT7","RT8",0
+ #define SIG_NUM 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,0
+
+ /* VOIDFLAGS:
+ * This symbol indicates how much support of the void type is given by this
+ * compiler. What various bits mean:
+ *
+ * 1 = supports declaration of void
+ * 2 = supports arrays of pointers to functions returning void
+ * 4 = supports comparisons between pointers to void functions and
+ * addresses of void functions
+ * 8 = suports declaration of generic void pointers
+ *
+ * The package designer should define VOIDUSED to indicate the requirements
+ * of the package. This can be done either by #defining VOIDUSED before
+ * including config.h, or by defining defvoidused in Myinit.U. If the
+ * latter approach is taken, only those flags will be tested. If the
+ * level of void support necessary is not present, defines void to int.
+ */
+ #ifndef VOIDUSED
+ #define VOIDUSED 15
+ #endif
+ #define VOIDFLAGS 15
+ #if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+ #define void int /* is void to be avoided? */
+ #define M_VOID /* Xenix strikes again */
+ #endif
+
+ /* ARCHLIB:
+ * This variable, if defined, holds the name of the directory in
+ * which the user wants to put architecture-dependent public
+ * library files for perl5. It is most often a local directory
+ * such as /usr/local/lib. Programs using this variable must be
+ * prepared to deal with filename expansion. If ARCHLIB is the
+ * same as PRIVLIB, it is not defined, since presumably the
+ * program already searches PRIVLIB.
+ */
+ /* ARCHLIB_EXP:
+ * This symbol contains the ~name expanded version of ARCHLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ /*#define ARCHLIB "/system/ported/perl/lib/5.005.{68k,860,7100,8000}" /* See build macro */
+ /*#define ARCHLIB_EXP "/system/ported/perl/lib/5.005.{68k,860,7100,8000}" /* See build macro */
+
+ /* DLSYM_NEEDS_UNDERSCORE:
+ * This symbol, if defined, indicates that we need to prepend an
+ * underscore to the symbol name before calling dlsym(). This only
+ * makes sense if you *have* dlsym, which we will presume is the
+ * case if you're using dl_dlopen.xs.
+ */
+ /*#define DLSYM_NEEDS_UNDERSCORE /**/
+
+ /* USE_SFIO:
+ * This symbol, if defined, indicates that sfio should
+ * be used.
+ */
+ /*#define USE_SFIO /**/
+
+ /* USE_DYNAMIC_LOADING:
+ * This symbol, if defined, indicates that dynamic loading of
+ * some sort is available.
+ */
+ /*#define USE_DYNAMIC_LOADING /**/
+
+ /* DB_Prefix_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is u_int32_t.
+ */
+ /* DB_Hash_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is size_t.
+ */
+ /*#define DB_Hash_t int /**/
+ /*#define DB_Prefix_t int /**/
+
+ /* PRIVLIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ */
+ /* PRIVLIB_EXP:
+ * This symbol contains the ~name expanded version of PRIVLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ #define PRIVLIB "/system/ported/perl/lib/5.005" /**/
+ #define PRIVLIB_EXP "/system/ported/perl/lib/5.005" /**/
+
+ /* SELECT_MIN_BITS:
+ * This symbol holds the minimum number of bits operated by select.
+ * That is, if you do select(n, ...), how many bits at least will be
+ * cleared in the masks if some activity is detected. Usually this
+ * is either n or 32*ceil(n/32), especially many little-endians do
+ * the latter. This is only useful if you have select(), naturally.
+ */
+ #define SELECT_MIN_BITS 1 /**/
+
+ /* SITEARCH:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ * The standard distribution will put nothing in this directory.
+ * Individual sites may place their own extensions and modules in
+ * this directory.
+ */
+ /* SITEARCH_EXP:
+ * This symbol contains the ~name expanded version of SITEARCH, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ /*#define SITEARCH "/system/ported/perl/lib/site/5.005.{68k,860,7100,8000}" /* See build macro */
+ /*#define SITEARCH_EXP "/system/ported/perl/lib/site/5.005.{68k,860,7100,8000}" /* See build macro */
+
+ /* SITELIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ * The standard distribution will put nothing in this directory.
+ * Individual sites may place their own extensions and modules in
+ * this directory.
+ */
+ /* SITELIB_EXP:
+ * This symbol contains the ~name expanded version of SITELIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ #define SITELIB "/system/ported/perl/lib/site/5.005" /**/
+ #define SITELIB_EXP "/system/ported/perl/lib/site/5.005" /**/
+
+ /* STARTPERL:
+ * This variable contains the string to put in front of a perl
+ * script to make sure (one hopes) that it runs with perl and not
+ * some shell.
+ */
+ #define STARTPERL "!perl.pm" /**/
+
+ /* USE_PERLIO:
+ * This symbol, if defined, indicates that the PerlIO abstraction should
+ * be used throughout. If not defined, stdio should be
+ * used in a fully backward compatible manner.
+ */
+ /*#define USE_PERLIO / **/
+
+ /* HAS_GETHOST_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for gethostent(), gethostbyname(), and
+ * gethostbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #define HAS_GETHOST_PROTOS /**/
+
+ /* HAS_GETNET_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getnetent(), getnetbyname(), and
+ * getnetbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #define HAS_GETNET_PROTOS /**/
+
+ /* HAS_GETPROTO_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getprotoent(), getprotobyname(), and
+ * getprotobyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #define HAS_GETPROTO_PROTOS /**/
+
+ /* HAS_GETSERV_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getservent(), getservbyname(), and
+ * getservbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #define HAS_GETSERV_PROTOS /**/
+
+ /* Netdb_host_t:
+ * This symbol holds the type used for the 1st argument
+ * to gethostbyaddr().
+ */
+ /* Netdb_hlen_t:
+ * This symbol holds the type used for the 2nd argument
+ * to gethostbyaddr().
+ */
+ /* Netdb_name_t:
+ * This symbol holds the type used for the argument to
+ * gethostbyname().
+ */
+ /* Netdb_net_t:
+ * This symbol holds the type used for the 1st argument to
+ * getnetbyaddr().
+ */
+ #define Netdb_host_t char * /**/
+ #define Netdb_hlen_t int /**/
+ #define Netdb_name_t char * /**/
+ #define Netdb_net_t long /**/
+
+ /* Select_fd_set_t:
+ * This symbol holds the type used for the 2nd, 3rd, and 4th
+ * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
+ * is defined, and 'int *' otherwise. This is only useful if you
+ * have select(), of course.
+ */
+ #define Select_fd_set_t fd_set * /**/
+
+ /* ARCHNAME:
+ * This symbol holds a string representing the architecture name.
+ * It may be used to construct an architecture-dependant pathname
+ * where library files may be held under a private library, for
+ * instance.
+ */
+ #define ARCHNAME "vos" /**/
+
+ /* I_MACH_CTHREADS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mach/cthreads.h>.
+ */
+ /*#define I_MACH_CTHREADS /**/
+
+ /* I_PTHREAD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <pthread.h>.
+ */
+ /*#define I_PTHREAD /**/
+
+ /* HAS_PTHREAD_YIELD:
+ * This symbol, if defined, indicates that the pthread_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+ /* HAS_SCHED_YIELD:
+ * This symbol, if defined, indicates that the sched_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+ /*#define HAS_PTHREAD_YIELD /**/
+ /*#define HAS_SCHED_YIELD /**/
+
+ /* PTHREADS_CREATED_JOINABLE:
+ * This symbol, if defined, indicates that pthreads are created
+ * in the joinable (aka undetached) state.
+ */
+ /*#define PTHREADS_CREATED_JOINABLE /**/
+
+ /* USE_THREADS:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use threads.
+ */
+ /* OLD_PTHREADS_API:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use the old draft POSIX threads API.
+ */
+ /*#define USE_THREADS /**/
+ /*#define OLD_PTHREADS_API /**/
+
+ /* Time_t:
+ * This symbol holds the type returned by time(). It can be long,
+ * or time_t on BSD sites (in which case <sys/types.h> should be
+ * included).
+ */
+ #define Time_t time_t /* Time type */
+
+ /* HAS_TIMES:
+ * This symbol, if defined, indicates that the times() routine exists.
+ * Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+ #define HAS_TIMES /**/
+
+ /* Fpos_t:
+ * This symbol holds the type used to declare file positions in libc.
+ * It can be fpos_t, long, uint, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Fpos_t fpos_t /* File position type */
+
+ /* Gid_t:
+ * This symbol holds the return type of getgid() and the type of
+ * argument to setrgid() and related functions. Typically,
+ * it is the type of group ids in the kernel. It can be int, ushort,
+ * uid_t, etc... It may be necessary to include <sys/types.h> to get
+ * any typedef'ed information.
+ */
+ #define Gid_t gid_t /* Type for getgid(), etc... */
+
+ /* Off_t:
+ * This symbol holds the type used to declare offsets in the kernel.
+ * It can be int, long, off_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Off_t off_t /* <offset> type */
+
+ /* Mode_t:
+ * This symbol holds the type used to declare file modes
+ * for systems calls. It is usually mode_t, but may be
+ * int or unsigned short. It may be necessary to include <sys/types.h>
+ * to get any typedef'ed information.
+ */
+ #define Mode_t mode_t /* file mode parameter for system calls */
+
+ /* Pid_t:
+ * This symbol holds the type used to declare process ids in the kernel.
+ * It can be int, uint, pid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Pid_t pid_t /* PID type */
+
+ /* Size_t:
+ * This symbol holds the type used to declare length parameters
+ * for string functions. It is usually size_t, but may be
+ * unsigned long, int, etc. It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Size_t size_t /* length paramater for string functions */
+
+ /* Uid_t:
+ * This symbol holds the type used to declare user ids in the kernel.
+ * It can be int, ushort, uid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Uid_t uid_t /* UID type */
+
+ /* _POSIX_C_SOURCE:
+ * VOS must have this symbol defined before we include any of the
+ * standard headers (e.g., sys/types.h).
+ */
+ #ifndef _POSIX_C_SOURCE
+ #define _POSIX_C_SOURCE 199309L
+ #endif
+
+ #endif
diff -c /dev/null 'perl5.005_03/vos/config_h.SH_orig'
Index: vos/config_h.SH_orig
*** vos/config_h.SH_orig Wed Dec 31 18:00:00 1969
--- vos/config_h.SH_orig Sat Mar 6 08:48:49 1999
***************
*** 0 ****
--- 1,2187 ----
+ case $CONFIG in
+ '')
+ if test -f config.sh; then TOP=.;
+ elif test -f ../config.sh; then TOP=..;
+ elif test -f ../../config.sh; then TOP=../..;
+ elif test -f ../../../config.sh; then TOP=../../..;
+ elif test -f ../../../../config.sh; then TOP=../../../..;
+ else
+ echo "Can't find config.sh."; exit 1
+ fi
+ . $TOP/config.sh
+ ;;
+ esac
+ case "$0" in
+ */*) cd `expr X$0 : 'X\(.*\)/'` ;;
+ esac
+ echo "Extracting config.h (with variable substitutions)"
+ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-def!#undef!'
+ /*
+ * This file was produced by running the config_h.SH script, which
+ * gets its values from config.sh, which is generally produced by
+ * running Configure.
+ *
+ * Feel free to modify any of this as the need arises. Note, however,
+ * that running config_h.SH again will wipe out any changes you've made.
+ * For a more permanent change edit config.sh and rerun config_h.SH.
+ *
+ * \$Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $
+ */
+
+ /*
+ * Package name : $package
+ * Source directory : $src
+ * Configuration time: $cf_time
+ * Configured by : $cf_by
+ * Target system : $myuname
+ */
+
+ #ifndef _config_h_
+ #define _config_h_
+
+ /* LOC_SED:
+ * This symbol holds the complete pathname to the sed program.
+ */
+ #define LOC_SED "$full_sed" /**/
+
+ /* BIN:
+ * This symbol holds the path of the bin directory where the package will
+ * be installed. Program must be prepared to deal with ~name substitution.
+ */
+ /* BIN_EXP:
+ * This symbol is the filename expanded version of the BIN symbol, for
+ * programs that do not want to deal with that at run-time.
+ */
+ #define BIN "$bin" /**/
+ #define BIN_EXP "$binexp" /**/
+
+ /* CPPSTDIN:
+ * This symbol contains the first part of the string which will invoke
+ * the C preprocessor on the standard input and produce to standard
+ * output. Typical value of "cc -E" or "/lib/cpp", but it can also
+ * call a wrapper. See CPPRUN.
+ */
+ /* CPPMINUS:
+ * This symbol contains the second part of the string which will invoke
+ * the C preprocessor on the standard input and produce to standard
+ * output. This symbol will have the value "-" if CPPSTDIN needs a minus
+ * to specify standard input, otherwise the value is "".
+ */
+ #define CPPSTDIN "$cppstdin"
+ #define CPPMINUS "$cppminus"
+
+ /* HAS_ALARM:
+ * This symbol, if defined, indicates that the alarm routine is
+ * available.
+ */
+ #$d_alarm HAS_ALARM /**/
+
+ /* HASATTRIBUTE:
+ * This symbol indicates the C compiler can check for function attributes,
+ * such as printf formats. This is normally only supported by GNU cc.
+ */
+ #$d_attribut HASATTRIBUTE /**/
+ #ifndef HASATTRIBUTE
+ #define __attribute__(_arg_)
+ #endif
+
+ /* HAS_BCMP:
+ * This symbol is defined if the bcmp() routine is available to
+ * compare blocks of memory.
+ */
+ #$d_bcmp HAS_BCMP /**/
+
+ /* HAS_BCOPY:
+ * This symbol is defined if the bcopy() routine is available to
+ * copy blocks of memory.
+ */
+ #$d_bcopy HAS_BCOPY /**/
+
+ /* HAS_BZERO:
+ * This symbol is defined if the bzero() routine is available to
+ * set a memory block to 0.
+ */
+ #$d_bzero HAS_BZERO /**/
+
+ /* HAS_CHOWN:
+ * This symbol, if defined, indicates that the chown routine is
+ * available.
+ */
+ #$d_chown HAS_CHOWN /**/
+
+ /* HAS_CHROOT:
+ * This symbol, if defined, indicates that the chroot routine is
+ * available.
+ */
+ #$d_chroot HAS_CHROOT /**/
+
+ /* HAS_CHSIZE:
+ * This symbol, if defined, indicates that the chsize routine is available
+ * to truncate files. You might need a -lx to get this routine.
+ */
+ #$d_chsize HAS_CHSIZE /**/
+
+ /* HASCONST:
+ * This symbol, if defined, indicates that this C compiler knows about
+ * the const type. There is no need to actually test for that symbol
+ * within your programs. The mere use of the "const" keyword will
+ * trigger the necessary tests.
+ */
+ #$d_const HASCONST /**/
+ #ifndef HASCONST
+ #define const
+ #endif
+
+ /* HAS_CRYPT:
+ * This symbol, if defined, indicates that the crypt routine is available
+ * to encrypt passwords and the like.
+ */
+ #$d_crypt HAS_CRYPT /**/
+
+ /* HAS_CUSERID:
+ * This symbol, if defined, indicates that the cuserid routine is
+ * available to get character login names.
+ */
+ #$d_cuserid HAS_CUSERID /**/
+
+ /* HAS_DBL_DIG:
+ * This symbol, if defined, indicates that this system's <float.h>
+ * or <limits.h> defines the symbol DBL_DIG, which is the number
+ * of significant digits in a double precision number. If this
+ * symbol is not defined, a guess of 15 is usually pretty good.
+ */
+ #$d_dbl_dig HAS_DBL_DIG /* */
+
+ /* HAS_DIFFTIME:
+ * This symbol, if defined, indicates that the difftime routine is
+ * available.
+ */
+ #$d_difftime HAS_DIFFTIME /**/
+
+ /* HAS_DLERROR:
+ * This symbol, if defined, indicates that the dlerror routine is
+ * available to return a string describing the last error that
+ * occurred from a call to dlopen(), dlclose() or dlsym().
+ */
+ #$d_dlerror HAS_DLERROR /**/
+
+ /* SETUID_SCRIPTS_ARE_SECURE_NOW:
+ * This symbol, if defined, indicates that the bug that prevents
+ * setuid scripts from being secure is not present in this kernel.
+ */
+ /* DOSUID:
+ * This symbol, if defined, indicates that the C program should
+ * check the script that it is executing for setuid/setgid bits, and
+ * attempt to emulate setuid/setgid on systems that have disabled
+ * setuid #! scripts because the kernel can't do it securely.
+ * It is up to the package designer to make sure that this emulation
+ * is done securely. Among other things, it should do an fstat on
+ * the script it just opened to make sure it really is a setuid/setgid
+ * script, it should make sure the arguments passed correspond exactly
+ * to the argument on the #! line, and it should not trust any
+ * subprocesses to which it must pass the filename rather than the
+ * file descriptor of the script to be executed.
+ */
+ #$d_suidsafe SETUID_SCRIPTS_ARE_SECURE_NOW /**/
+ #$d_dosuid DOSUID /**/
+
+ /* HAS_DUP2:
+ * This symbol, if defined, indicates that the dup2 routine is
+ * available to duplicate file descriptors.
+ */
+ #$d_dup2 HAS_DUP2 /**/
+
+ /* HAS_FCHMOD:
+ * This symbol, if defined, indicates that the fchmod routine is available
+ * to change mode of opened files. If unavailable, use chmod().
+ */
+ #$d_fchmod HAS_FCHMOD /**/
+
+ /* HAS_FCHOWN:
+ * This symbol, if defined, indicates that the fchown routine is available
+ * to change ownership of opened files. If unavailable, use chown().
+ */
+ #$d_fchown HAS_FCHOWN /**/
+
+ /* HAS_FCNTL:
+ * This symbol, if defined, indicates to the C program that
+ * the fcntl() function exists.
+ */
+ #$d_fcntl HAS_FCNTL /**/
+
+ /* HAS_FGETPOS:
+ * This symbol, if defined, indicates that the fgetpos routine is
+ * available to get the file position indicator, similar to ftell().
+ */
+ #$d_fgetpos HAS_FGETPOS /**/
+
+ /* FLEXFILENAMES:
+ * This symbol, if defined, indicates that the system supports filenames
+ * longer than 14 characters.
+ */
+ #$d_flexfnam FLEXFILENAMES /**/
+
+ /* HAS_FLOCK:
+ * This symbol, if defined, indicates that the flock routine is
+ * available to do file locking.
+ */
+ #$d_flock HAS_FLOCK /**/
+
+ /* HAS_FORK:
+ * This symbol, if defined, indicates that the fork routine is
+ * available.
+ */
+ #$d_fork HAS_FORK /**/
+
+ /* HAS_FSETPOS:
+ * This symbol, if defined, indicates that the fsetpos routine is
+ * available to set the file position indicator, similar to fseek().
+ */
+ #$d_fsetpos HAS_FSETPOS /**/
+
+ /* I_SYS_MOUNT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/mount.h>.
+ */
+ #$i_sysmount I_SYS_MOUNT /**/
+
+ /* HAS_FSTATFS:
+ * This symbol, if defined, indicates that the fstatfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+ #$d_fstatfs HAS_FSTATFS /**/
+
+ /* HAS_STRUCT_STATFS_FLAGS:
+ * This symbol, if defined, indicates that the struct statfs has
+ * the f_flags member for mount flags.
+ */
+ #$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/
+
+ /* I_SYS_STATVFS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/statvfs.h>.
+ */
+ #$i_sysstatvfs I_SYS_STATVFS /**/
+
+ /* HAS_FSTATVFS:
+ * This symbol, if defined, indicates that the fstatvfs routine is
+ * available to stat the filesystem of a file descriptor.
+ */
+ #$d_fstatvfs HAS_FSTATVFS /**/
+
+ /* I_MNTENT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mntent.h>.
+ */
+ #$i_mntent I_MNTENT /**/
+
+ /* HAS_GETMNTENT:
+ * This symbol, if defined, indicates that the getmntent routine is
+ * available to lookup mount entries in some data base or other.
+ */
+ #$d_getmntent HAS_GETMNTENT /**/
+
+ /* HAS_HASMNTOPT:
+ * This symbol, if defined, indicates that the hasmntopt routine is
+ * available to query mount entries returned by getmntent.
+ */
+ #$d_hasmntopt HAS_HASMNTOPT /**/
+
+ /* HAS_GETTIMEOFDAY:
+ * This symbol, if defined, indicates that the gettimeofday() system
+ * call is available for a sub-second accuracy clock. Usually, the file
+ * <sys/resource.h> needs to be included (see I_SYS_RESOURCE).
+ * The type "Timeval" should be used to refer to "struct timeval".
+ */
+ #$d_gettimeod HAS_GETTIMEOFDAY /**/
+ #ifdef HAS_GETTIMEOFDAY
+ #define Timeval struct timeval /* Structure used by gettimeofday() */
+ #endif
+
+ /* HAS_GETGROUPS:
+ * This symbol, if defined, indicates that the getgroups() routine is
+ * available to get the list of process groups. If unavailable, multiple
+ * groups are probably not supported.
+ */
+ #$d_getgrps HAS_GETGROUPS /**/
+
+ /* HAS_UNAME:
+ * This symbol, if defined, indicates that the C program may use the
+ * uname() routine to derive the host name. See also HAS_GETHOSTNAME
+ * and PHOSTNAME.
+ */
+ #$d_uname HAS_UNAME /**/
+
+ /* HAS_GETLOGIN:
+ * This symbol, if defined, indicates that the getlogin routine is
+ * available to get the login name.
+ */
+ #$d_getlogin HAS_GETLOGIN /**/
+
+ /* HAS_GETPGID:
+ * This symbol, if defined, indicates to the C program that
+ * the getpgid(pid) function is available to get the
+ * process group id.
+ */
+ #$d_getpgid HAS_GETPGID /**/
+
+ /* HAS_GETPGRP:
+ * This symbol, if defined, indicates that the getpgrp routine is
+ * available to get the current process group.
+ */
+ /* USE_BSD_GETPGRP:
+ * This symbol, if defined, indicates that getpgrp needs one
+ * arguments whereas USG one needs none.
+ */
+ #$d_getpgrp HAS_GETPGRP /**/
+ #$d_bsdgetpgrp USE_BSD_GETPGRP /**/
+
+ /* HAS_GETPGRP2:
+ * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX)
+ * routine is available to get the current process group.
+ */
+ #$d_getpgrp2 HAS_GETPGRP2 /**/
+
+ /* HAS_GETPPID:
+ * This symbol, if defined, indicates that the getppid routine is
+ * available to get the parent process ID.
+ */
+ #$d_getppid HAS_GETPPID /**/
+
+ /* HAS_GETPRIORITY:
+ * This symbol, if defined, indicates that the getpriority routine is
+ * available to get a process's priority.
+ */
+ #$d_getprior HAS_GETPRIORITY /**/
+
+ /* HAS_HTONL:
+ * This symbol, if defined, indicates that the htonl() routine (and
+ * friends htons() ntohl() ntohs()) are available to do network
+ * order byte swapping.
+ */
+ /* HAS_HTONS:
+ * This symbol, if defined, indicates that the htons() routine (and
+ * friends htonl() ntohl() ntohs()) are available to do network
+ * order byte swapping.
+ */
+ /* HAS_NTOHL:
+ * This symbol, if defined, indicates that the ntohl() routine (and
+ * friends htonl() htons() ntohs()) are available to do network
+ * order byte swapping.
+ */
+ /* HAS_NTOHS:
+ * This symbol, if defined, indicates that the ntohs() routine (and
+ * friends htonl() htons() ntohl()) are available to do network
+ * order byte swapping.
+ */
+ #$d_htonl HAS_HTONL /**/
+ #$d_htonl HAS_HTONS /**/
+ #$d_htonl HAS_NTOHL /**/
+ #$d_htonl HAS_NTOHS /**/
+
+ /* HAS_INET_ATON:
+ * This symbol, if defined, indicates to the C program that the
+ * inet_aton() function is available to parse IP address "dotted-quad"
+ * strings.
+ */
+ #$d_inetaton HAS_INET_ATON /**/
+
+ /* HAS_KILLPG:
+ * This symbol, if defined, indicates that the killpg routine is available
+ * to kill process groups. If unavailable, you probably should use kill
+ * with a negative process number.
+ */
+ #$d_killpg HAS_KILLPG /**/
+
+ /* HAS_LINK:
+ * This symbol, if defined, indicates that the link routine is
+ * available to create hard links.
+ */
+ #$d_link HAS_LINK /**/
+
+ /* HAS_LOCALECONV:
+ * This symbol, if defined, indicates that the localeconv routine is
+ * available for numeric and monetary formatting conventions.
+ */
+ #$d_locconv HAS_LOCALECONV /**/
+
+ /* HAS_LOCKF:
+ * This symbol, if defined, indicates that the lockf routine is
+ * available to do file locking.
+ */
+ #$d_lockf HAS_LOCKF /**/
+
+ /* HAS_LSTAT:
+ * This symbol, if defined, indicates that the lstat routine is
+ * available to do file stats on symbolic links.
+ */
+ #$d_lstat HAS_LSTAT /**/
+
+ /* HAS_MBLEN:
+ * This symbol, if defined, indicates that the mblen routine is available
+ * to find the number of bytes in a multibye character.
+ */
+ #$d_mblen HAS_MBLEN /**/
+
+ /* HAS_MBSTOWCS:
+ * This symbol, if defined, indicates that the mbstowcs routine is
+ * available to covert a multibyte string into a wide character string.
+ */
+ #$d_mbstowcs HAS_MBSTOWCS /**/
+
+ /* HAS_MBTOWC:
+ * This symbol, if defined, indicates that the mbtowc routine is available
+ * to covert a multibyte to a wide character.
+ */
+ #$d_mbtowc HAS_MBTOWC /**/
+
+ /* HAS_MEMCMP:
+ * This symbol, if defined, indicates that the memcmp routine is available
+ * to compare blocks of memory.
+ */
+ #$d_memcmp HAS_MEMCMP /**/
+
+ /* HAS_MEMCPY:
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy blocks of memory.
+ */
+ #$d_memcpy HAS_MEMCPY /**/
+
+ /* HAS_MEMMOVE:
+ * This symbol, if defined, indicates that the memmove routine is available
+ * to copy potentially overlapping blocks of memory. This should be used
+ * only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your
+ * own version.
+ */
+ #$d_memmove HAS_MEMMOVE /**/
+
+ /* HAS_MEMSET:
+ * This symbol, if defined, indicates that the memset routine is available
+ * to set blocks of memory.
+ */
+ #$d_memset HAS_MEMSET /**/
+
+ /* HAS_MKDIR:
+ * This symbol, if defined, indicates that the mkdir routine is available
+ * to create directories. Otherwise you should fork off a new process to
+ * exec /bin/mkdir.
+ */
+ #$d_mkdir HAS_MKDIR /**/
+
+ /* HAS_MKFIFO:
+ * This symbol, if defined, indicates that the mkfifo routine is
+ * available to create FIFOs. Otherwise, mknod should be able to
+ * do it for you. However, if mkfifo is there, mknod might require
+ * super-user privileges which mkfifo will not.
+ */
+ #$d_mkfifo HAS_MKFIFO /**/
+
+ /* HAS_MKTIME:
+ * This symbol, if defined, indicates that the mktime routine is
+ * available.
+ */
+ #$d_mktime HAS_MKTIME /**/
+
+ /* HAS_MSG:
+ * This symbol, if defined, indicates that the entire msg*(2) library is
+ * supported (IPC mechanism based on message queues).
+ */
+ #$d_msg HAS_MSG /**/
+
+ /* HAS_NICE:
+ * This symbol, if defined, indicates that the nice routine is
+ * available.
+ */
+ #$d_nice HAS_NICE /**/
+
+ /* HAS_PATHCONF:
+ * This symbol, if defined, indicates that pathconf() is available
+ * to determine file-system related limits and options associated
+ * with a given filename.
+ */
+ /* HAS_FPATHCONF:
+ * This symbol, if defined, indicates that pathconf() is available
+ * to determine file-system related limits and options associated
+ * with a given open file descriptor.
+ */
+ #$d_pathconf HAS_PATHCONF /**/
+ #$d_fpathconf HAS_FPATHCONF /**/
+
+ /* HAS_PAUSE:
+ * This symbol, if defined, indicates that the pause routine is
+ * available to suspend a process until a signal is received.
+ */
+ #$d_pause HAS_PAUSE /**/
+
+ /* HAS_PIPE:
+ * This symbol, if defined, indicates that the pipe routine is
+ * available to create an inter-process channel.
+ */
+ #$d_pipe HAS_PIPE /**/
+
+ /* HAS_POLL:
+ * This symbol, if defined, indicates that the poll routine is
+ * available to poll active file descriptors. You may safely
+ * include <poll.h> when this symbol is defined.
+ */
+ #$d_poll HAS_POLL /**/
+
+ /* HAS_READDIR:
+ * This symbol, if defined, indicates that the readdir routine is
+ * available to read directory entries. You may have to include
+ * <dirent.h>. See I_DIRENT.
+ */
+ #$d_readdir HAS_READDIR /**/
+
+ /* HAS_SEEKDIR:
+ * This symbol, if defined, indicates that the seekdir routine is
+ * available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+ #$d_seekdir HAS_SEEKDIR /**/
+
+ /* HAS_TELLDIR:
+ * This symbol, if defined, indicates that the telldir routine is
+ * available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+ #$d_telldir HAS_TELLDIR /**/
+
+ /* HAS_REWINDDIR:
+ * This symbol, if defined, indicates that the rewinddir routine is
+ * available. You may have to include <dirent.h>. See I_DIRENT.
+ */
+ #$d_rewinddir HAS_REWINDDIR /**/
+
+ /* HAS_READLINK:
+ * This symbol, if defined, indicates that the readlink routine is
+ * available to read the value of a symbolic link.
+ */
+ #$d_readlink HAS_READLINK /**/
+
+ /* HAS_RENAME:
+ * This symbol, if defined, indicates that the rename routine is available
+ * to rename files. Otherwise you should do the unlink(), link(), unlink()
+ * trick.
+ */
+ #$d_rename HAS_RENAME /**/
+
+ /* HAS_RMDIR:
+ * This symbol, if defined, indicates that the rmdir routine is
+ * available to remove directories. Otherwise you should fork off a
+ * new process to exec /bin/rmdir.
+ */
+ #$d_rmdir HAS_RMDIR /**/
+
+ /* HAS_SELECT:
+ * This symbol, if defined, indicates that the select routine is
+ * available to select active file descriptors. If the timeout field
+ * is used, <sys/time.h> may need to be included.
+ */
+ #$d_select HAS_SELECT /**/
+
+ /* HAS_SEM:
+ * This symbol, if defined, indicates that the entire sem*(2) library is
+ * supported.
+ */
+ #$d_sem HAS_SEM /**/
+
+ /* HAS_SETEGID:
+ * This symbol, if defined, indicates that the setegid routine is available
+ * to change the effective gid of the current program.
+ */
+ #$d_setegid HAS_SETEGID /**/
+
+ /* HAS_SETEUID:
+ * This symbol, if defined, indicates that the seteuid routine is available
+ * to change the effective uid of the current program.
+ */
+ #$d_seteuid HAS_SETEUID /**/
+
+ /* HAS_SETLINEBUF:
+ * This symbol, if defined, indicates that the setlinebuf routine is
+ * available to change stderr or stdout from block-buffered or unbuffered
+ * to a line-buffered mode.
+ */
+ #$d_setlinebuf HAS_SETLINEBUF /**/
+
+ /* HAS_SETLOCALE:
+ * This symbol, if defined, indicates that the setlocale routine is
+ * available to handle locale-specific ctype implementations.
+ */
+ #$d_setlocale HAS_SETLOCALE /**/
+
+ /* HAS_SETPGID:
+ * This symbol, if defined, indicates that the setpgid(pid, gpid)
+ * routine is available to set process group ID.
+ */
+ #$d_setpgid HAS_SETPGID /**/
+
+ /* HAS_SETPGRP:
+ * This symbol, if defined, indicates that the setpgrp routine is
+ * available to set the current process group.
+ */
+ /* USE_BSD_SETPGRP:
+ * This symbol, if defined, indicates that setpgrp needs two
+ * arguments whereas USG one needs none. See also HAS_SETPGID
+ * for a POSIX interface.
+ */
+ #$d_setpgrp HAS_SETPGRP /**/
+ #$d_bsdsetpgrp USE_BSD_SETPGRP /**/
+
+ /* HAS_SETPGRP2:
+ * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX)
+ * routine is available to set the current process group.
+ */
+ #$d_setpgrp2 HAS_SETPGRP2 /**/
+
+ /* HAS_SETPRIORITY:
+ * This symbol, if defined, indicates that the setpriority routine is
+ * available to set a process's priority.
+ */
+ #$d_setprior HAS_SETPRIORITY /**/
+
+ /* HAS_SETREGID:
+ * This symbol, if defined, indicates that the setregid routine is
+ * available to change the real and effective gid of the current
+ * process.
+ */
+ /* HAS_SETRESGID:
+ * This symbol, if defined, indicates that the setresgid routine is
+ * available to change the real, effective and saved gid of the current
+ * process.
+ */
+ #$d_setregid HAS_SETREGID /**/
+ #$d_setresgid HAS_SETRESGID /**/
+
+ /* HAS_SETREUID:
+ * This symbol, if defined, indicates that the setreuid routine is
+ * available to change the real and effective uid of the current
+ * process.
+ */
+ /* HAS_SETRESUID:
+ * This symbol, if defined, indicates that the setresuid routine is
+ * available to change the real, effective and saved uid of the current
+ * process.
+ */
+ #$d_setreuid HAS_SETREUID /**/
+ #$d_setresuid HAS_SETRESUID /**/
+
+ /* HAS_SETRGID:
+ * This symbol, if defined, indicates that the setrgid routine is available
+ * to change the real gid of the current program.
+ */
+ #$d_setrgid HAS_SETRGID /**/
+
+ /* HAS_SETRUID:
+ * This symbol, if defined, indicates that the setruid routine is available
+ * to change the real uid of the current program.
+ */
+ #$d_setruid HAS_SETRUID /**/
+
+ /* HAS_SETSID:
+ * This symbol, if defined, indicates that the setsid routine is
+ * available to set the process group ID.
+ */
+ #$d_setsid HAS_SETSID /**/
+
+ /* HAS_SHM:
+ * This symbol, if defined, indicates that the entire shm*(2) library is
+ * supported.
+ */
+ #$d_shm HAS_SHM /**/
+
+ /* Shmat_t:
+ * This symbol holds the return type of the shmat() system call.
+ * Usually set to 'void *' or 'char *'.
+ */
+ /* HAS_SHMAT_PROTOTYPE:
+ * This symbol, if defined, indicates that the sys/shm.h includes
+ * a prototype for shmat(). Otherwise, it is up to the program to
+ * guess one. Shmat_t shmat _((int, Shmat_t, int)) is a good guess,
+ * but not always right so it should be emitted by the program only
+ * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs.
+ */
+ #define Shmat_t $shmattype /**/
+ #$d_shmatprototype HAS_SHMAT_PROTOTYPE /**/
+
+ /* USE_STAT_BLOCKS:
+ * This symbol is defined if this system has a stat structure declaring
+ * st_blksize and st_blocks.
+ */
+ #$d_statblks USE_STAT_BLOCKS /**/
+
+ /* HAS_STRCHR:
+ * This symbol is defined to indicate that the strchr()/strrchr()
+ * functions are available for string searching. If not, try the
+ * index()/rindex() pair.
+ */
+ /* HAS_INDEX:
+ * This symbol is defined to indicate that the index()/rindex()
+ * functions are available for string searching.
+ */
+ #$d_strchr HAS_STRCHR /**/
+ #$d_index HAS_INDEX /**/
+
+ /* HAS_STRCOLL:
+ * This symbol, if defined, indicates that the strcoll routine is
+ * available to compare strings using collating information.
+ */
+ #$d_strcoll HAS_STRCOLL /**/
+
+ /* USE_STRUCT_COPY:
+ * This symbol, if defined, indicates that this C compiler knows how
+ * to copy structures. If undefined, you'll need to use a block copy
+ * routine of some sort instead.
+ */
+ #$d_strctcpy USE_STRUCT_COPY /**/
+
+ /* HAS_STRERROR:
+ * This symbol, if defined, indicates that the strerror routine is
+ * available to translate error numbers to strings. See the writeup
+ * of Strerror() in this file before you try to define your own.
+ */
+ /* HAS_SYS_ERRLIST:
+ * This symbol, if defined, indicates that the sys_errlist array is
+ * available to translate error numbers to strings. The extern int
+ * sys_nerr gives the size of that table.
+ */
+ /* Strerror:
+ * This preprocessor symbol is defined as a macro if strerror() is
+ * not available to translate error numbers to strings but sys_errlist[]
+ * array is there.
+ */
+ #$d_strerror HAS_STRERROR /**/
+ #$d_syserrlst HAS_SYS_ERRLIST /**/
+ #define Strerror(e) $d_strerrm
+
+ /* HAS_STRTOD:
+ * This symbol, if defined, indicates that the strtod routine is
+ * available to provide better numeric string conversion than atof().
+ */
+ #$d_strtod HAS_STRTOD /**/
+
+ /* HAS_STRTOL:
+ * This symbol, if defined, indicates that the strtol routine is available
+ * to provide better numeric string conversion than atoi() and friends.
+ */
+ #$d_strtol HAS_STRTOL /**/
+
+ /* HAS_STRTOUL:
+ * This symbol, if defined, indicates that the strtoul routine is
+ * available to provide conversion of strings to unsigned long.
+ */
+ #$d_strtoul HAS_STRTOUL /**/
+
+ /* HAS_STRXFRM:
+ * This symbol, if defined, indicates that the strxfrm() routine is
+ * available to transform strings.
+ */
+ #$d_strxfrm HAS_STRXFRM /**/
+
+ /* HAS_SYMLINK:
+ * This symbol, if defined, indicates that the symlink routine is available
+ * to create symbolic links.
+ */
+ #$d_symlink HAS_SYMLINK /**/
+
+ /* HAS_SYSCALL:
+ * This symbol, if defined, indicates that the syscall routine is
+ * available to call arbitrary system calls. If undefined, that's tough.
+ */
+ #$d_syscall HAS_SYSCALL /**/
+
+ /* HAS_SYSCONF:
+ * This symbol, if defined, indicates that sysconf() is available
+ * to determine system related limits and options.
+ */
+ #$d_sysconf HAS_SYSCONF /**/
+
+ /* HAS_SYSTEM:
+ * This symbol, if defined, indicates that the system routine is
+ * available to issue a shell command.
+ */
+ #$d_system HAS_SYSTEM /**/
+
+ /* HAS_TCGETPGRP:
+ * This symbol, if defined, indicates that the tcgetpgrp routine is
+ * available to get foreground process group ID.
+ */
+ #$d_tcgetpgrp HAS_TCGETPGRP /**/
+
+ /* HAS_TCSETPGRP:
+ * This symbol, if defined, indicates that the tcsetpgrp routine is
+ * available to set foreground process group ID.
+ */
+ #$d_tcsetpgrp HAS_TCSETPGRP /**/
+
+ /* HAS_TRUNCATE:
+ * This symbol, if defined, indicates that the truncate routine is
+ * available to truncate files.
+ */
+ #$d_truncate HAS_TRUNCATE /**/
+
+ /* HAS_TZNAME:
+ * This symbol, if defined, indicates that the tzname[] array is
+ * available to access timezone names.
+ */
+ #$d_tzname HAS_TZNAME /**/
+
+ /* HAS_UMASK:
+ * This symbol, if defined, indicates that the umask routine is
+ * available to set and get the value of the file creation mask.
+ */
+ #$d_umask HAS_UMASK /**/
+
+ /* HAS_VFORK:
+ * This symbol, if defined, indicates that vfork() exists.
+ */
+ #$d_vfork HAS_VFORK /**/
+
+ /* HASVOLATILE:
+ * This symbol, if defined, indicates that this C compiler knows about
+ * the volatile declaration.
+ */
+ #$d_volatile HASVOLATILE /**/
+ #ifndef HASVOLATILE
+ #define volatile
+ #endif
+
+ /* HAS_WAIT4:
+ * This symbol, if defined, indicates that wait4() exists.
+ */
+ #$d_wait4 HAS_WAIT4 /**/
+
+ /* HAS_WAITPID:
+ * This symbol, if defined, indicates that the waitpid routine is
+ * available to wait for child process.
+ */
+ #$d_waitpid HAS_WAITPID /**/
+
+ /* HAS_WCSTOMBS:
+ * This symbol, if defined, indicates that the wcstombs routine is
+ * available to convert wide character strings to multibyte strings.
+ */
+ #$d_wcstombs HAS_WCSTOMBS /**/
+
+ /* HAS_WCTOMB:
+ * This symbol, if defined, indicates that the wctomb routine is available
+ * to covert a wide character to a multibyte.
+ */
+ #$d_wctomb HAS_WCTOMB /**/
+
+ /* EBCDIC:
+ * This symbol, if defined, indicates that this system uses
+ * EBCDIC encoding.
+ */
+ #$ebcdic EBCDIC /**/
+
+ /* I_ARPA_INET:
+ * This symbol, if defined, indicates that <arpa/inet.h> exists and should
+ * be included.
+ */
+ #$i_arpainet I_ARPA_INET /**/
+
+ /* I_DBM:
+ * This symbol, if defined, indicates that <dbm.h> exists and should
+ * be included.
+ */
+ /* I_RPCSVC_DBM:
+ * This symbol, if defined, indicates that <rpcsvc/dbm.h> exists and
+ * should be included.
+ */
+ #$i_dbm I_DBM /**/
+ #$i_rpcsvcdbm I_RPCSVC_DBM /**/
+
+ /* I_DIRENT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <dirent.h>. Using this symbol also triggers the definition
+ * of the Direntry_t define which ends up being 'struct dirent' or
+ * 'struct direct' depending on the availability of <dirent.h>.
+ */
+ /* DIRNAMLEN:
+ * This symbol, if defined, indicates to the C program that the length
+ * of directory entry names is provided by a d_namlen field. Otherwise
+ * you need to do strlen() on the d_name field.
+ */
+ /* Direntry_t:
+ * This symbol is set to 'struct direct' or 'struct dirent' depending on
+ * whether dirent is available or not. You should use this pseudo type to
+ * portably declare your directory entries.
+ */
+ #$i_dirent I_DIRENT /**/
+ #$d_dirnamlen DIRNAMLEN /**/
+ #define Direntry_t $direntrytype
+
+ /* I_DLFCN:
+ * This symbol, if defined, indicates that <dlfcn.h> exists and should
+ * be included.
+ */
+ #$i_dlfcn I_DLFCN /**/
+
+ /* I_FCNTL:
+ * This manifest constant tells the C program to include <fcntl.h>.
+ */
+ #$i_fcntl I_FCNTL /**/
+
+ /* I_FLOAT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <float.h> to get definition of symbols like DBL_MAX or
+ * DBL_MIN, i.e. machine dependent floating point values.
+ */
+ #$i_float I_FLOAT /**/
+
+ /* I_GRP:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <grp.h>.
+ */
+ /* GRPASSWD:
+ * This symbol, if defined, indicates to the C program that struct group
+ * contains gr_passwd.
+ */
+ /* HAS_SETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for initializing sequential access of the group database.
+ */
+ /* HAS_GETGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for sequential access of the group database.
+ */
+ /* HAS_ENDGRENT:
+ * This symbol, if defined, indicates that the getgrent routine is
+ * available for finalizing sequential access of the group database.
+ */
+ #$i_grp I_GRP /**/
+ #$d_grpasswd GRPASSWD /**/
+ #$d_setgrent HAS_SETGRENT /**/
+ #$d_getgrent HAS_GETGRENT /**/
+ #$d_endgrent HAS_ENDGRENT /**/
+
+ /* I_LIMITS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <limits.h> to get definition of symbols like WORD_BIT or
+ * LONG_MAX, i.e. machine dependant limitations.
+ */
+ #$i_limits I_LIMITS /**/
+
+ /* I_LOCALE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <locale.h>.
+ */
+ #$i_locale I_LOCALE /**/
+
+ /* I_MATH:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <math.h>.
+ */
+ #$i_math I_MATH /**/
+
+ /* I_MEMORY:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <memory.h>.
+ */
+ #$i_memory I_MEMORY /**/
+
+ /* I_NDBM:
+ * This symbol, if defined, indicates that <ndbm.h> exists and should
+ * be included.
+ */
+ #$i_ndbm I_NDBM /**/
+
+ /* I_NET_ERRNO:
+ * This symbol, if defined, indicates that <net/errno.h> exists and
+ * should be included.
+ */
+ #$i_neterrno I_NET_ERRNO /**/
+
+ /* I_NETINET_IN:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <netinet/in.h>. Otherwise, you may try <sys/in.h>.
+ */
+ #$i_niin I_NETINET_IN /**/
+
+ /* I_SFIO:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sfio.h>.
+ */
+ #$i_sfio I_SFIO /**/
+
+ /* I_STDDEF:
+ * This symbol, if defined, indicates that <stddef.h> exists and should
+ * be included.
+ */
+ #$i_stddef I_STDDEF /**/
+
+ /* I_STDLIB:
+ * This symbol, if defined, indicates that <stdlib.h> exists and should
+ * be included.
+ */
+ #$i_stdlib I_STDLIB /**/
+
+ /* I_STRING:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <string.h> (USG systems) instead of <strings.h> (BSD systems).
+ */
+ #$i_string I_STRING /**/
+
+ /* I_SYS_DIR:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/dir.h>.
+ */
+ #$i_sysdir I_SYS_DIR /**/
+
+ /* I_SYS_FILE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/file.h> to get definition of R_OK and friends.
+ */
+ #$i_sysfile I_SYS_FILE /**/
+
+ /* I_SYS_IOCTL:
+ * This symbol, if defined, indicates that <sys/ioctl.h> exists and should
+ * be included. Otherwise, include <sgtty.h> or <termio.h>.
+ */
+ #$i_sysioctl I_SYS_IOCTL /**/
+
+ /* I_SYS_NDIR:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/ndir.h>.
+ */
+ #$i_sysndir I_SYS_NDIR /**/
+
+ /* I_SYS_PARAM:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/param.h>.
+ */
+ #$i_sysparam I_SYS_PARAM /**/
+
+ /* I_SYS_RESOURCE:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/resource.h>.
+ */
+ #$i_sysresrc I_SYS_RESOURCE /**/
+
+ /* I_SYS_SELECT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/select.h> in order to get definition of struct timeval.
+ */
+ #$i_sysselct I_SYS_SELECT /**/
+
+ /* I_SYS_STAT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/stat.h>.
+ */
+ #$i_sysstat I_SYS_STAT /**/
+
+ /* I_SYS_TIMES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/times.h>.
+ */
+ #$i_systimes I_SYS_TIMES /**/
+
+ /* I_SYS_TYPES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/types.h>.
+ */
+ #$i_systypes I_SYS_TYPES /**/
+
+ /* I_SYS_UN:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/un.h> to get UNIX domain socket definitions.
+ */
+ #$i_sysun I_SYS_UN /**/
+
+ /* I_SYS_WAIT:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/wait.h>.
+ */
+ #$i_syswait I_SYS_WAIT /**/
+
+ /* I_TERMIO:
+ * This symbol, if defined, indicates that the program should include
+ * <termio.h> rather than <sgtty.h>. There are also differences in
+ * the ioctl() calls that depend on the value of this symbol.
+ */
+ /* I_TERMIOS:
+ * This symbol, if defined, indicates that the program should include
+ * the POSIX termios.h rather than sgtty.h or termio.h.
+ * There are also differences in the ioctl() calls that depend on the
+ * value of this symbol.
+ */
+ /* I_SGTTY:
+ * This symbol, if defined, indicates that the program should include
+ * <sgtty.h> rather than <termio.h>. There are also differences in
+ * the ioctl() calls that depend on the value of this symbol.
+ */
+ #$i_termio I_TERMIO /**/
+ #$i_termios I_TERMIOS /**/
+ #$i_sgtty I_SGTTY /**/
+
+ /* I_UNISTD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <unistd.h>.
+ */
+ #$i_unistd I_UNISTD /**/
+
+ /* I_UTIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <utime.h>.
+ */
+ #$i_utime I_UTIME /**/
+
+ /* I_VALUES:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <values.h> to get definition of symbols like MINFLOAT or
+ * MAXLONG, i.e. machine dependant limitations. Probably, you
+ * should use <limits.h> instead, if it is available.
+ */
+ #$i_values I_VALUES /**/
+
+ /* I_STDARG:
+ * This symbol, if defined, indicates that <stdarg.h> exists and should
+ * be included.
+ */
+ /* I_VARARGS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <varargs.h>.
+ */
+ #$i_stdarg I_STDARG /**/
+ #$i_varargs I_VARARGS /**/
+
+ /* I_VFORK:
+ * This symbol, if defined, indicates to the C program that it should
+ * include vfork.h.
+ */
+ #$i_vfork I_VFORK /**/
+
+ /* CAN_PROTOTYPE:
+ * If defined, this macro indicates that the C compiler can handle
+ * function prototypes.
+ */
+ /* _:
+ * This macro is used to declare function parameters for folks who want
+ * to make declarations with prototypes using a different style than
+ * the above macros. Use double parentheses. For example:
+ *
+ * int main _((int argc, char *argv[]));
+ */
+ #$prototype CAN_PROTOTYPE /**/
+ #ifdef CAN_PROTOTYPE
+ #define _(args) args
+ #else
+ #define _(args) ()
+ #endif
+
+ /* SH_PATH:
+ * This symbol contains the full pathname to the shell used on this
+ * on this system to execute Bourne shell scripts. Usually, this will be
+ * /bin/sh, though it's possible that some systems will have /bin/ksh,
+ * /bin/pdksh, /bin/ash, /bin/bash, or even something such as
+ * D:/bin/sh.exe.
+ */
+ #define SH_PATH "$sh" /**/
+
+ /* STDCHAR:
+ * This symbol is defined to be the type of char used in stdio.h.
+ * It has the values "unsigned char" or "char".
+ */
+ #define STDCHAR $stdchar /**/
+
+ /* MEM_ALIGNBYTES:
+ * This symbol contains the number of bytes required to align a
+ * double. Usual values are 2, 4 and 8.
+ * On NeXT starting with 3.2, you can build "Fat" Multiple Architecture
+ * Binaries (MAB) for targets with varying alignment. This only matters
+ * for perl, where the config.h can be generated and installed on one
+ * system, and used by a different architecture to build an extension.
+ * The default is eight, for safety.
+ */
+ #define MEM_ALIGNBYTES $alignbytes /**/
+
+ /* BYTEORDER:
+ * This symbol holds the hexadecimal constant defined in byteorder,
+ * i.e. 0x1234 or 0x4321, etc...
+ * On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture
+ * Binaries (MAB) on either big endian or little endian machines.
+ * The endian-ness is available at compile-time. This only matters
+ * for perl, where the config.h can be generated and installed on
+ * one system, and used by a different architecture to build an
+ * extension. Older versions of NeXT that might not have
+ * defined either *_ENDIAN__ were all on Motorola 680x0 series,
+ * so the default case (for NeXT) is big endian to catch them.
+ * This might matter for NeXT 3.0.
+ */
+ #ifndef NeXT
+ #define BYTEORDER 0x$byteorder /* large digits for MSB */
+ #else /* NeXT */
+ #ifdef __LITTLE_ENDIAN__
+ #define BYTEORDER 0x1234
+ #else /* __BIG_ENDIAN__ */
+ #define BYTEORDER 0x4321
+ #endif /* ENDIAN CHECK */
+ #endif /* NeXT */
+
+ /* CASTI32:
+ * This symbol is defined if the C compiler can cast negative
+ * or large floating point numbers to 32-bit ints.
+ */
+ #$d_casti32 CASTI32 /**/
+
+ /* CASTNEGFLOAT:
+ * This symbol is defined if the C compiler can cast negative
+ * numbers to unsigned longs, ints and shorts.
+ */
+ /* CASTFLAGS:
+ * This symbol contains flags that say what difficulties the compiler
+ * has casting odd floating values to unsigned long:
+ * 0 = ok
+ * 1 = couldn't cast < 0
+ * 2 = couldn't cast >= 0x80000000
+ * 4 = couldn't cast in argument expression list
+ */
+ #$d_castneg CASTNEGFLOAT /**/
+ #define CASTFLAGS $castflags /**/
+
+ /* VOID_CLOSEDIR:
+ * This symbol, if defined, indicates that the closedir() routine
+ * does not return a value.
+ */
+ #$d_void_closedir VOID_CLOSEDIR /**/
+
+ /* Gconvert:
+ * This preprocessor macro is defined to convert a floating point
+ * number to a string without a trailing decimal point. This
+ * emulates the behavior of sprintf("%g"), but is sometimes much more
+ * efficient. If gconvert() is not available, but gcvt() drops the
+ * trailing decimal point, then gcvt() is used. If all else fails,
+ * a macro using sprintf("%g") is used. Arguments for the Gconvert
+ * macro are: value, number of digits, whether trailing zeros should
+ * be retained, and the output buffer.
+ * Possible values are:
+ * d_Gconvert='gconvert((x),(n),(t),(b))'
+ * d_Gconvert='gcvt((x),(n),(b))'
+ * d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+ * The last two assume trailing zeros should not be kept.
+ */
+ #define Gconvert(x,n,t,b) $d_Gconvert
+
+ /* HAS_GNULIBC:
+ * This symbol, if defined, indicates to the C program that
+ * the GNU C library is being used.
+ */
+ #$d_gnulibc HAS_GNULIBC /**/
+ /* HAS_ISASCII:
+ * This manifest constant lets the C program know that isascii
+ * is available.
+ */
+ #$d_isascii HAS_ISASCII /**/
+
+ /* HAS_LCHOWN:
+ * This symbol, if defined, indicates that the lchown routine is
+ * available to operate on a symbolic link (instead of following the
+ * link).
+ */
+ #$d_lchown HAS_LCHOWN /**/
+
+ /* HAS_OPEN3:
+ * This manifest constant lets the C program know that the three
+ * argument form of open(2) is available.
+ */
+ #$d_open3 HAS_OPEN3 /**/
+
+ /* HAS_SAFE_BCOPY:
+ * This symbol, if defined, indicates that the bcopy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
+ */
+ #$d_safebcpy HAS_SAFE_BCOPY /**/
+
+ /* HAS_SAFE_MEMCPY:
+ * This symbol, if defined, indicates that the memcpy routine is available
+ * to copy potentially overlapping memory blocks. Otherwise you should
+ * probably use memmove() or memcpy(). If neither is defined, roll your
+ * own version.
+ */
+ #$d_safemcpy HAS_SAFE_MEMCPY /**/
+
+ /* HAS_SANE_MEMCMP:
+ * This symbol, if defined, indicates that the memcmp routine is available
+ * and can be used to compare relative magnitudes of chars with their high
+ * bits set. If it is not defined, roll your own version.
+ */
+ #$d_sanemcmp HAS_SANE_MEMCMP /**/
+
+ /* HAS_SIGACTION:
+ * This symbol, if defined, indicates that Vr4's sigaction() routine
+ * is available.
+ */
+ #$d_sigaction HAS_SIGACTION /**/
+
+ /* Sigjmp_buf:
+ * This is the buffer type to be used with Sigsetjmp and Siglongjmp.
+ */
+ /* Sigsetjmp:
+ * This macro is used in the same way as sigsetjmp(), but will invoke
+ * traditional setjmp() if sigsetjmp isn't available.
+ * See HAS_SIGSETJMP.
+ */
+ /* Siglongjmp:
+ * This macro is used in the same way as siglongjmp(), but will invoke
+ * traditional longjmp() if siglongjmp isn't available.
+ * See HAS_SIGSETJMP.
+ */
+ #$d_sigsetjmp HAS_SIGSETJMP /**/
+ #ifdef HAS_SIGSETJMP
+ #define Sigjmp_buf sigjmp_buf
+ #define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask))
+ #define Siglongjmp(buf,retval) siglongjmp((buf),(retval))
+ #else
+ #define Sigjmp_buf jmp_buf
+ #define Sigsetjmp(buf,save_mask) setjmp((buf))
+ #define Siglongjmp(buf,retval) longjmp((buf),(retval))
+ #endif
+
+ /* USE_STDIO_PTR:
+ * This symbol is defined if the _ptr and _cnt fields (or similar)
+ * of the stdio FILE structure can be used to access the stdio buffer
+ * for a file handle. If this is defined, then the FILE_ptr(fp)
+ * and FILE_cnt(fp) macros will also be defined and should be used
+ * to access these fields.
+ */
+ /* FILE_ptr:
+ * This macro is used to access the _ptr field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+ /* STDIO_PTR_LVALUE:
+ * This symbol is defined if the FILE_ptr macro can be used as an
+ * lvalue.
+ */
+ /* FILE_cnt:
+ * This macro is used to access the _cnt field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_PTR is defined.
+ */
+ /* STDIO_CNT_LVALUE:
+ * This symbol is defined if the FILE_cnt macro can be used as an
+ * lvalue.
+ */
+ #$d_stdstdio USE_STDIO_PTR /**/
+ #ifdef USE_STDIO_PTR
+ #define FILE_ptr(fp) $stdio_ptr
+ #$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/
+ #define FILE_cnt(fp) $stdio_cnt
+ #$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/
+ #endif
+
+ /* USE_STDIO_BASE:
+ * This symbol is defined if the _base field (or similar) of the
+ * stdio FILE structure can be used to access the stdio buffer for
+ * a file handle. If this is defined, then the FILE_base(fp) macro
+ * will also be defined and should be used to access this field.
+ * Also, the FILE_bufsiz(fp) macro will be defined and should be used
+ * to determine the number of bytes in the buffer. USE_STDIO_BASE
+ * will never be defined unless USE_STDIO_PTR is.
+ */
+ /* FILE_base:
+ * This macro is used to access the _base field (or equivalent) of the
+ * FILE structure pointed to by its argument. This macro will always be
+ * defined if USE_STDIO_BASE is defined.
+ */
+ /* FILE_bufsiz:
+ * This macro is used to determine the number of bytes in the I/O
+ * buffer pointed to by _base field (or equivalent) of the FILE
+ * structure pointed to its argument. This macro will always be defined
+ * if USE_STDIO_BASE is defined.
+ */
+ #$d_stdiobase USE_STDIO_BASE /**/
+ #ifdef USE_STDIO_BASE
+ #define FILE_base(fp) $stdio_base
+ #define FILE_bufsiz(fp) $stdio_bufsiz
+ #endif
+
+ /* HAS_VPRINTF:
+ * This symbol, if defined, indicates that the vprintf routine is available
+ * to printf with a pointer to an argument list. If unavailable, you
+ * may need to write your own, probably in terms of _doprnt().
+ */
+ /* USE_CHAR_VSPRINTF:
+ * This symbol is defined if this system has vsprintf() returning type
+ * (char*). The trend seems to be to declare it as "int vsprintf()". It
+ * is up to the package author to declare vsprintf correctly based on the
+ * symbol.
+ */
+ #$d_vprintf HAS_VPRINTF /**/
+ #$d_charvspr USE_CHAR_VSPRINTF /**/
+
+ /* DOUBLESIZE:
+ * This symbol contains the size of a double, so that the C preprocessor
+ * can make decisions based on it.
+ */
+ #define DOUBLESIZE $doublesize /**/
+
+ /* I_TIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <time.h>.
+ */
+ /* I_SYS_TIME:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h>.
+ */
+ /* I_SYS_TIME_KERNEL:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <sys/time.h> with KERNEL defined.
+ */
+ #$i_time I_TIME /**/
+ #$i_systime I_SYS_TIME /**/
+ #$i_systimek I_SYS_TIME_KERNEL /**/
+
+ /* INTSIZE:
+ * This symbol contains the value of sizeof(int) so that the C
+ * preprocessor can make decisions based on it.
+ */
+ /* LONGSIZE:
+ * This symbol contains the value of sizeof(long) so that the C
+ * preprocessor can make decisions based on it.
+ */
+ /* SHORTSIZE:
+ * This symbol contains the value of sizeof(short) so that the C
+ * preprocessor can make decisions based on it.
+ */
+ #define INTSIZE $intsize /**/
+ #define LONGSIZE $longsize /**/
+ #define SHORTSIZE $shortsize /**/
+
+ /* VAL_O_NONBLOCK:
+ * This symbol is to be used during open() or fcntl(F_SETFL) to turn on
+ * non-blocking I/O for the file descriptor. Note that there is no way
+ * back, i.e. you cannot turn it blocking again this way. If you wish to
+ * alternatively switch between blocking and non-blocking, use the
+ * ioctl(FIOSNBIO) call instead, but that is not supported by all devices.
+ */
+ /* VAL_EAGAIN:
+ * This symbol holds the errno error code set by read() when no data was
+ * present on the non-blocking file descriptor.
+ */
+ /* RD_NODATA:
+ * This symbol holds the return code from read() when no data is present
+ * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is
+ * not defined, then you can't distinguish between no data and EOF by
+ * issuing a read(). You'll have to find another way to tell for sure!
+ */
+ /* EOF_NONBLOCK:
+ * This symbol, if defined, indicates to the C program that a read() on
+ * a non-blocking file descriptor will return 0 on EOF, and not the value
+ * held in RD_NODATA (-1 usually, in that case!).
+ */
+ #define VAL_O_NONBLOCK $o_nonblock
+ #define VAL_EAGAIN $eagain
+ #define RD_NODATA $rd_nodata
+ #$d_eofnblk EOF_NONBLOCK
+
+ /* PTRSIZE:
+ * This symbol contains the size of a pointer, so that the C preprocessor
+ * can make decisions based on it. It will be sizeof(void *) if
+ * the compiler supports (void *); otherwise it will be
+ * sizeof(char *).
+ */
+ #define PTRSIZE $ptrsize /**/
+
+ /* RANDBITS:
+ * This symbol contains the number of bits of random number the rand()
+ * function produces. Usual values are 15, 16, and 31.
+ */
+ #define RANDBITS $randbits /**/
+
+ /* SSize_t:
+ * This symbol holds the type used by functions that return
+ * a count of bytes or an error condition. It must be a signed type.
+ * It is usually ssize_t, but may be long or int, etc.
+ * It may be necessary to include <sys/types.h> or <unistd.h>
+ * to get any typedef'ed information.
+ * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t).
+ */
+ #define SSize_t $ssizetype /* signed count of bytes */
+
+ /* OSNAME:
+ * This symbol contains the name of the operating system, as determined
+ * by Configure. You shouldn't rely on it too much; the specific
+ * feature tests from Configure are generally more reliable.
+ */
+ #define OSNAME "$osname" /**/
+
+ /* CAT2:
+ * This macro catenates 2 tokens together.
+ */
+ /* STRINGIFY:
+ * This macro surrounds its token with double quotes.
+ */
+ #if $cpp_stuff == 1
+ #define CAT2(a,b)a/**/b
+ #define STRINGIFY(a)"a"
+ /* If you can get stringification with catify, tell me how! */
+ #endif
+ #if $cpp_stuff == 42
+ #define CAT2(a,b)a ## b
+ #define StGiFy(a)# a
+ #define STRINGIFY(a)StGiFy(a)
+ #endif
+ #if $cpp_stuff != 1 && $cpp_stuff != 42
+ #include "Bletch: How does this C preprocessor catenate tokens?"
+ #endif
+
+ /* CSH:
+ * This symbol, if defined, contains the full pathname of csh.
+ */
+ #$d_csh HAS_CSH /**/
+ #ifdef HAS_CSH
+ #define CSH "$full_csh" /**/
+ #endif
+
+ /* HAS_ENDHOSTENT:
+ * This symbol, if defined, indicates that the endhostent() routine is
+ * available to close whatever was being used for host queries.
+ */
+ #$d_endhent HAS_ENDHOSTENT /**/
+
+ /* HAS_ENDNETENT:
+ * This symbol, if defined, indicates that the endnetent() routine is
+ * available to close whatever was being used for network queries.
+ */
+ #$d_endnent HAS_ENDNETENT /**/
+
+ /* HAS_ENDPROTOENT:
+ * This symbol, if defined, indicates that the endprotoent() routine is
+ * available to close whatever was being used for protocol queries.
+ */
+ #$d_endpent HAS_ENDPROTOENT /**/
+
+ /* HAS_ENDSERVENT:
+ * This symbol, if defined, indicates that the endservent() routine is
+ * available to close whatever was being used for service queries.
+ */
+ #$d_endsent HAS_ENDSERVENT /**/
+
+ /* HAS_GETHOSTBYADDR:
+ * This symbol, if defined, indicates that the gethostbyaddr() routine is
+ * available to look up hosts by their IP addresses.
+ */
+ #$d_gethbyaddr HAS_GETHOSTBYADDR /**/
+
+ /* HAS_GETHOSTBYNAME:
+ * This symbol, if defined, indicates that the gethostbyname() routine is
+ * available to look up host names in some data base or other.
+ */
+ #$d_gethbyname HAS_GETHOSTBYNAME /**/
+
+ /* HAS_GETHOSTENT:
+ * This symbol, if defined, indicates that the gethostent() routine is
+ * available to look up host names in some data base or another.
+ */
+ #$d_gethent HAS_GETHOSTENT /**/
+
+ /* HAS_GETNETBYADDR:
+ * This symbol, if defined, indicates that the getnetbyaddr() routine is
+ * available to look up networks by their IP addresses.
+ */
+ #$d_getnbyaddr HAS_GETNETBYADDR /**/
+
+ /* HAS_GETNETBYNAME:
+ * This symbol, if defined, indicates that the getnetbyname() routine is
+ * available to look up networks by their names.
+ */
+ #$d_getnbyname HAS_GETNETBYNAME /**/
+
+ /* HAS_GETNETENT:
+ * This symbol, if defined, indicates that the getnetent() routine is
+ * available to look up network names in some data base or another.
+ */
+ #$d_getnent HAS_GETNETENT /**/
+
+ /* HAS_GETPROTOENT:
+ * This symbol, if defined, indicates that the getprotoent() routine is
+ * available to look up protocols in some data base or another.
+ */
+ #$d_getpent HAS_GETPROTOENT /**/
+
+ /* HAS_GETPROTOBYNAME:
+ * This symbol, if defined, indicates that the getprotobyname()
+ * routine is available to look up protocols by their name.
+ */
+ /* HAS_GETPROTOBYNUMBER:
+ * This symbol, if defined, indicates that the getprotobynumber()
+ * routine is available to look up protocols by their number.
+ */
+ #$d_getpbyname HAS_GETPROTOBYNAME /**/
+ #$d_getpbynumber HAS_GETPROTOBYNUMBER /**/
+
+ /* HAS_GETSERVENT:
+ * This symbol, if defined, indicates that the getservent() routine is
+ * available to look up network services in some data base or another.
+ */
+ #$d_getsent HAS_GETSERVENT /**/
+
+ /* HAS_GETSERVBYNAME:
+ * This symbol, if defined, indicates that the getservbyname()
+ * routine is available to look up services by their name.
+ */
+ /* HAS_GETSERVBYPORT:
+ * This symbol, if defined, indicates that the getservbyport()
+ * routine is available to look up services by their port.
+ */
+ #$d_getsbyname HAS_GETSERVBYNAME /**/
+ #$d_getsbyport HAS_GETSERVBYPORT /**/
+
+ /* HAS_LONG_DOUBLE:
+ * This symbol will be defined if the C compiler supports long
+ * doubles.
+ */
+ /* LONG_DOUBLESIZE:
+ * This symbol contains the size of a long double, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long doubles.
+ */
+ #$d_longdbl HAS_LONG_DOUBLE /**/
+ #ifdef HAS_LONG_DOUBLE
+ #define LONG_DOUBLESIZE $longdblsize /**/
+ #endif
+
+ /* HAS_LONG_LONG:
+ * This symbol will be defined if the C compiler supports
+ * long long.
+ */
+ /* LONGLONGSIZE:
+ * This symbol contains the size of a long long, so that the
+ * C preprocessor can make decisions based on it. It is only
+ * defined if the system supports long long.
+ */
+ #$d_longlong HAS_LONG_LONG /**/
+ #ifdef HAS_LONG_LONG
+ #define LONGLONGSIZE $longlongsize /**/
+ #endif
+
+ /* HAS_SETGROUPS:
+ * This symbol, if defined, indicates that the setgroups() routine is
+ * available to set the list of process groups. If unavailable, multiple
+ * groups are probably not supported.
+ */
+ #$d_setgrps HAS_SETGROUPS /**/
+
+ /* HAS_SETHOSTENT:
+ * This symbol, if defined, indicates that the sethostent() routine is
+ * available.
+ */
+ #$d_sethent HAS_SETHOSTENT /**/
+
+ /* HAS_SETNETENT:
+ * This symbol, if defined, indicates that the setnetent() routine is
+ * available.
+ */
+ #$d_setnent HAS_SETNETENT /**/
+
+ /* HAS_SETPROTOENT:
+ * This symbol, if defined, indicates that the setprotoent() routine is
+ * available.
+ */
+ #$d_setpent HAS_SETPROTOENT /**/
+
+ /* HAS_SETSERVENT:
+ * This symbol, if defined, indicates that the setservent() routine is
+ * available.
+ */
+ #$d_setsent HAS_SETSERVENT /**/
+
+ /* HAS_SETVBUF:
+ * This symbol, if defined, indicates that the setvbuf routine is
+ * available to change buffering on an open stdio stream.
+ * to a line-buffered mode.
+ */
+ #$d_setvbuf HAS_SETVBUF /**/
+
+ /* HAS_SOCKET:
+ * This symbol, if defined, indicates that the BSD socket interface is
+ * supported.
+ */
+ /* HAS_SOCKETPAIR:
+ * This symbol, if defined, indicates that the BSD socketpair() call is
+ * supported.
+ */
+ #$d_socket HAS_SOCKET /**/
+ #$d_sockpair HAS_SOCKETPAIR /**/
+
+ /* HAS_UNION_SEMUN:
+ * This symbol, if defined, indicates that the union semun is
+ * defined by including <sys/sem.h>. If not, the user code
+ * probably needs to define it as:
+ * union semun {
+ * int val;
+ * struct semid_ds *buf;
+ * unsigned short *array;
+ * }
+ */
+ /* USE_SEMCTL_SEMUN:
+ * This symbol, if defined, indicates that union semun is
+ * used for semctl IPC_STAT.
+ */
+ /* USE_SEMCTL_SEMID_DS:
+ * This symbol, if defined, indicates that struct semid_ds * is
+ * used for semctl IPC_STAT.
+ */
+ #$d_union_semun HAS_UNION_SEMUN /**/
+ #$d_semctl_semun USE_SEMCTL_SEMUN /**/
+ #$d_semctl_semid_ds USE_SEMCTL_SEMID_DS /**/
+
+ /* Signal_t:
+ * This symbol's value is either "void" or "int", corresponding to the
+ * appropriate return type of a signal handler. Thus, you can declare
+ * a signal handler using "Signal_t (*handler)()", and define the
+ * handler using "Signal_t handler(sig)".
+ */
+ #define Signal_t $signal_t /* Signal handler's return type */
+
+ /* Groups_t:
+ * This symbol holds the type used for the second argument to
+ * getgroups() and setgropus(). Usually, this is the same as
+ * gidtype (gid_t) , but sometimes it isn't.
+ * It can be int, ushort, uid_t, etc...
+ * It may be necessary to include <sys/types.h> to get any
+ * typedef'ed information. This is only required if you have
+ * getgroups() or setgropus()..
+ */
+ #if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
+ #define Groups_t $groupstype /* Type for 2nd arg to [sg]etgroups() */
+ #endif
+
+ /* I_NETDB:
+ * This symbol, if defined, indicates that <netdb.h> exists and
+ * should be included.
+ */
+ #$i_netdb I_NETDB /**/
+
+ /* I_PWD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <pwd.h>.
+ */
+ /* PWQUOTA:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_quota.
+ */
+ /* PWAGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_age.
+ */
+ /* PWCHANGE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_change.
+ */
+ /* PWCLASS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_class.
+ */
+ /* PWEXPIRE:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_expire.
+ */
+ /* PWCOMMENT:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_comment.
+ */
+ /* PWGECOS:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_gecos.
+ */
+ /* PWPASSWD:
+ * This symbol, if defined, indicates to the C program that struct passwd
+ * contains pw_passwd.
+ */
+ /* HAS_SETPWENT:
+ * This symbol, if defined, indicates that the getpwrent routine is
+ * available for initializing sequential access of the passwd database.
+ */
+ /* HAS_GETPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for sequential access of the password database.
+ */
+ /* HAS_ENDPWENT:
+ * This symbol, if defined, indicates that the getpwent routine is
+ * available for finalizing sequential access of the passwd database.
+ */
+ #$i_pwd I_PWD /**/
+ #$d_pwquota PWQUOTA /**/
+ #$d_pwage PWAGE /**/
+ #$d_pwchange PWCHANGE /**/
+ #$d_pwclass PWCLASS /**/
+ #$d_pwexpire PWEXPIRE /**/
+ #$d_pwcomment PWCOMMENT /**/
+ #$d_pwgecos PWGECOS /**/
+ #$d_pwpasswd PWPASSWD /**/
+ #$d_setpwent HAS_SETPWENT /**/
+ #$d_getpwent HAS_GETPWENT /**/
+ #$d_endpwent HAS_ENDPWENT /**/
+
+ /* Free_t:
+ * This variable contains the return type of free(). It is usually
+ * void, but occasionally int.
+ */
+ /* Malloc_t:
+ * This symbol is the type of pointer returned by malloc and realloc.
+ */
+ #define Malloc_t $malloctype /**/
+ #define Free_t $freetype /**/
+
+ /* MYMALLOC:
+ * This symbol, if defined, indicates that we're using our own malloc.
+ */
+ #$d_mymalloc MYMALLOC /**/
+
+ /* SIG_NAME:
+ * This symbol contains a list of signal names in order of
+ * signal number. This is intended
+ * to be used as a static array initialization, like this:
+ * char *sig_name[] = { SIG_NAME };
+ * The signals in the list are separated with commas, and each signal
+ * is surrounded by double quotes. There is no leading SIG in the signal
+ * name, i.e. SIGQUIT is known as "QUIT".
+ * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn,
+ * etc., where nn is the actual signal number (e.g. NUM37).
+ * The signal number for sig_name[i] is stored in sig_num[i].
+ * The last element is 0 to terminate the list with a NULL. This
+ * corresponds to the 0 at the end of the sig_num list.
+ */
+ /* SIG_NUM:
+ * This symbol contains a list of signal numbers, in the same order as the
+ * SIG_NAME list. It is suitable for static array initialization, as in:
+ * int sig_num[] = { SIG_NUM };
+ * The signals in the list are separated with commas, and the indices
+ * within that list and the SIG_NAME list match, so it's easy to compute
+ * the signal name from a number or vice versa at the price of a small
+ * dynamic linear lookup.
+ * Duplicates are allowed, but are moved to the end of the list.
+ * The signal number corresponding to sig_name[i] is sig_number[i].
+ * if (i < NSIG) then sig_number[i] == i.
+ * The last element is 0, corresponding to the 0 at the end of
+ * the sig_name list.
+ */
+ #define SIG_NAME $sig_name_init /**/
+ #define SIG_NUM $sig_num_init /**/
+
+ /* VOIDFLAGS:
+ * This symbol indicates how much support of the void type is given by this
+ * compiler. What various bits mean:
+ *
+ * 1 = supports declaration of void
+ * 2 = supports arrays of pointers to functions returning void
+ * 4 = supports comparisons between pointers to void functions and
+ * addresses of void functions
+ * 8 = suports declaration of generic void pointers
+ *
+ * The package designer should define VOIDUSED to indicate the requirements
+ * of the package. This can be done either by #defining VOIDUSED before
+ * including config.h, or by defining defvoidused in Myinit.U. If the
+ * latter approach is taken, only those flags will be tested. If the
+ * level of void support necessary is not present, defines void to int.
+ */
+ #ifndef VOIDUSED
+ #define VOIDUSED $defvoidused
+ #endif
+ #define VOIDFLAGS $voidflags
+ #if (VOIDFLAGS & VOIDUSED) != VOIDUSED
+ #define void int /* is void to be avoided? */
+ #define M_VOID /* Xenix strikes again */
+ #endif
+
+ /* ARCHLIB:
+ * This variable, if defined, holds the name of the directory in
+ * which the user wants to put architecture-dependent public
+ * library files for $package. It is most often a local directory
+ * such as /usr/local/lib. Programs using this variable must be
+ * prepared to deal with filename expansion. If ARCHLIB is the
+ * same as PRIVLIB, it is not defined, since presumably the
+ * program already searches PRIVLIB.
+ */
+ /* ARCHLIB_EXP:
+ * This symbol contains the ~name expanded version of ARCHLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ #$d_archlib ARCHLIB "$archlib" /**/
+ #$d_archlib ARCHLIB_EXP "$archlibexp" /**/
+
+ /* DLSYM_NEEDS_UNDERSCORE:
+ * This symbol, if defined, indicates that we need to prepend an
+ * underscore to the symbol name before calling dlsym(). This only
+ * makes sense if you *have* dlsym, which we will presume is the
+ * case if you're using dl_dlopen.xs.
+ */
+ #$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/
+
+ /* USE_SFIO:
+ * This symbol, if defined, indicates that sfio should
+ * be used.
+ */
+ #$d_sfio USE_SFIO /**/
+
+ /* USE_DYNAMIC_LOADING:
+ * This symbol, if defined, indicates that dynamic loading of
+ * some sort is available.
+ */
+ #$usedl USE_DYNAMIC_LOADING /**/
+
+ /* DB_Prefix_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is u_int32_t.
+ */
+ /* DB_Hash_t:
+ * This symbol contains the type of the prefix structure element
+ * in the <db.h> header file. In older versions of DB, it was
+ * int, while in newer ones it is size_t.
+ */
+ #define DB_Hash_t $db_hashtype /**/
+ #define DB_Prefix_t $db_prefixtype /**/
+
+ /* PRIVLIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ */
+ /* PRIVLIB_EXP:
+ * This symbol contains the ~name expanded version of PRIVLIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ #define PRIVLIB "$privlib" /**/
+ #define PRIVLIB_EXP "$privlibexp" /**/
+
+ /* SELECT_MIN_BITS:
+ * This symbol holds the minimum number of bits operated by select.
+ * That is, if you do select(n, ...), how many bits at least will be
+ * cleared in the masks if some activity is detected. Usually this
+ * is either n or 32*ceil(n/32), especially many little-endians do
+ * the latter. This is only useful if you have select(), naturally.
+ */
+ #define SELECT_MIN_BITS $selectminbits /**/
+
+ /* SITEARCH:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ * The standard distribution will put nothing in this directory.
+ * Individual sites may place their own extensions and modules in
+ * this directory.
+ */
+ /* SITEARCH_EXP:
+ * This symbol contains the ~name expanded version of SITEARCH, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ #define SITEARCH "$sitearch" /**/
+ #define SITEARCH_EXP "$sitearchexp" /**/
+
+ /* SITELIB:
+ * This symbol contains the name of the private library for this package.
+ * The library is private in the sense that it needn't be in anyone's
+ * execution path, but it should be accessible by the world. The program
+ * should be prepared to do ~ expansion.
+ * The standard distribution will put nothing in this directory.
+ * Individual sites may place their own extensions and modules in
+ * this directory.
+ */
+ /* SITELIB_EXP:
+ * This symbol contains the ~name expanded version of SITELIB, to be used
+ * in programs that are not prepared to deal with ~ expansion at run-time.
+ */
+ #define SITELIB "$sitelib" /**/
+ #define SITELIB_EXP "$sitelibexp" /**/
+
+ /* STARTPERL:
+ * This variable contains the string to put in front of a perl
+ * script to make sure (one hopes) that it runs with perl and not
+ * some shell.
+ */
+ #define STARTPERL "$startperl" /**/
+
+ /* USE_PERLIO:
+ * This symbol, if defined, indicates that the PerlIO abstraction should
+ * be used throughout. If not defined, stdio should be
+ * used in a fully backward compatible manner.
+ */
+ #$useperlio USE_PERLIO /**/
+
+ /* HAS_GETHOST_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for gethostent(), gethostbyname(), and
+ * gethostbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #$d_gethostprotos HAS_GETHOST_PROTOS /**/
+
+ /* HAS_GETNET_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getnetent(), getnetbyname(), and
+ * getnetbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #$d_getnetprotos HAS_GETNET_PROTOS /**/
+
+ /* HAS_GETPROTO_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getprotoent(), getprotobyname(), and
+ * getprotobyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #$d_getprotoprotos HAS_GETPROTO_PROTOS /**/
+
+ /* HAS_GETSERV_PROTOS:
+ * This symbol, if defined, indicates that <netdb.h> includes
+ * prototypes for getservent(), getservbyname(), and
+ * getservbyaddr(). Otherwise, it is up to the program to guess
+ * them. See netdbtype.U for probing for various Netdb_xxx_t types.
+ */
+ #$d_getservprotos HAS_GETSERV_PROTOS /**/
+
+ /* Netdb_host_t:
+ * This symbol holds the type used for the 1st argument
+ * to gethostbyaddr().
+ */
+ /* Netdb_hlen_t:
+ * This symbol holds the type used for the 2nd argument
+ * to gethostbyaddr().
+ */
+ /* Netdb_name_t:
+ * This symbol holds the type used for the argument to
+ * gethostbyname().
+ */
+ /* Netdb_net_t:
+ * This symbol holds the type used for the 1st argument to
+ * getnetbyaddr().
+ */
+ #define Netdb_host_t $netdb_host_type /**/
+ #define Netdb_hlen_t $netdb_hlen_type /**/
+ #define Netdb_name_t $netdb_name_type /**/
+ #define Netdb_net_t $netdb_net_type /**/
+
+ /* Select_fd_set_t:
+ * This symbol holds the type used for the 2nd, 3rd, and 4th
+ * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET
+ * is defined, and 'int *' otherwise. This is only useful if you
+ * have select(), of course.
+ */
+ #define Select_fd_set_t $selecttype /**/
+
+ /* ARCHNAME:
+ * This symbol holds a string representing the architecture name.
+ * It may be used to construct an architecture-dependant pathname
+ * where library files may be held under a private library, for
+ * instance.
+ */
+ #define ARCHNAME "$archname" /**/
+
+ /* I_MACH_CTHREADS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <mach/cthreads.h>.
+ */
+ /*#define I_MACH_CTHREADS /**/
+
+ /* I_PTHREAD:
+ * This symbol, if defined, indicates to the C program that it should
+ * include <pthread.h>.
+ */
+ /*#define I_PTHREAD /**/
+
+ /* HAS_PTHREAD_YIELD:
+ * This symbol, if defined, indicates that the pthread_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+ /* HAS_SCHED_YIELD:
+ * This symbol, if defined, indicates that the sched_yield
+ * routine is available to yield the execution of the current
+ * thread.
+ */
+ #$d_pthread_yield HAS_PTHREAD_YIELD /**/
+ #$d_sched_yield HAS_SCHED_YIELD /**/
+
+ /* PTHREADS_CREATED_JOINABLE:
+ * This symbol, if defined, indicates that pthreads are created
+ * in the joinable (aka undetached) state.
+ */
+ #$d_pthreads_created_joinable PTHREADS_CREATED_JOINABLE /**/
+
+ /* USE_THREADS:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use threads.
+ */
+ /* OLD_PTHREADS_API:
+ * This symbol, if defined, indicates that Perl should
+ * be built to use the old draft POSIX threads API.
+ */
+ #$usethreads USE_THREADS /**/
+ #$d_oldpthreads OLD_PTHREADS_API /**/
+
+ /* Time_t:
+ * This symbol holds the type returned by time(). It can be long,
+ * or time_t on BSD sites (in which case <sys/types.h> should be
+ * included).
+ */
+ #define Time_t $timetype /* Time type */
+
+ /* HAS_TIMES:
+ * This symbol, if defined, indicates that the times() routine exists.
+ * Note that this became obsolete on some systems (SUNOS), which now
+ * use getrusage(). It may be necessary to include <sys/times.h>.
+ */
+ #$d_times HAS_TIMES /**/
+
+ /* Fpos_t:
+ * This symbol holds the type used to declare file positions in libc.
+ * It can be fpos_t, long, uint, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Fpos_t $fpostype /* File position type */
+
+ /* Gid_t:
+ * This symbol holds the return type of getgid() and the type of
+ * argument to setrgid() and related functions. Typically,
+ * it is the type of group ids in the kernel. It can be int, ushort,
+ * uid_t, etc... It may be necessary to include <sys/types.h> to get
+ * any typedef'ed information.
+ */
+ #define Gid_t $gidtype /* Type for getgid(), etc... */
+
+ /* Off_t:
+ * This symbol holds the type used to declare offsets in the kernel.
+ * It can be int, long, off_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Off_t $lseektype /* <offset> type */
+
+ /* Mode_t:
+ * This symbol holds the type used to declare file modes
+ * for systems calls. It is usually mode_t, but may be
+ * int or unsigned short. It may be necessary to include <sys/types.h>
+ * to get any typedef'ed information.
+ */
+ #define Mode_t $modetype /* file mode parameter for system calls */
+
+ /* Pid_t:
+ * This symbol holds the type used to declare process ids in the kernel.
+ * It can be int, uint, pid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Pid_t $pidtype /* PID type */
+
+ /* Size_t:
+ * This symbol holds the type used to declare length parameters
+ * for string functions. It is usually size_t, but may be
+ * unsigned long, int, etc. It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Size_t $sizetype /* length paramater for string functions */
+
+ /* Uid_t:
+ * This symbol holds the type used to declare user ids in the kernel.
+ * It can be int, ushort, uid_t, etc... It may be necessary to include
+ * <sys/types.h> to get any typedef'ed information.
+ */
+ #define Uid_t $uidtype /* UID type */
+
+ #endif
+ !GROK!THIS!
diff -c /dev/null 'perl5.005_03/vos/perl.bind'
Index: vos/perl.bind
*** vos/perl.bind Wed Dec 31 18:00:00 1969
--- vos/perl.bind Thu Feb 11 18:06:27 1999
***************
*** 0 ****
--- 1,37 ----
+ name: perl;
+
+ /* entry: main; */
+
+ modules: miniperlmain,
+ av,
+ deb,
+ doio,
+ doop,
+ dump,
+ globals,
+ gv,
+ hv,
+ mg,
+ op,
+ perl,
+ perlio,
+ perly,
+ pp,
+ pp_ctl,
+ pp_hot,
+ pp_sys,
+ regcomp,
+ regexec,
+ run,
+ scope,
+ sv,
+ taint,
+ toke,
+ universal,
+ util,
+ vos_accept,
+ vos_dummies,
+ tcp_runtime,
+ tcp_gethost;
+
+ end;
diff -c /dev/null 'perl5.005_03/vos/test_vos_dummies.c'
Index: vos/test_vos_dummies.c
*** vos/test_vos_dummies.c Wed Dec 31 18:00:00 1969
--- vos/test_vos_dummies.c Thu Feb 11 18:06:27 1999
***************
*** 0 ****
--- 1,43 ----
+ /* +++begin copyright+++ ******************************************* */
+ /* */
+ /* COPYRIGHT (c) 1997, 1998 Stratus Computer, Inc. */
+ /* */
+ /* This program is free software; you can redistribute it and/or */
+ /* modify it under the terms of either: */
+ /* */
+ /* a) the GNU General Public License as published by the Free */
+ /* Software Foundation; either version 1, or (at your option) any */
+ /* later version, or */
+ /* */
+ /* b) the "Artistic License" which comes with this Kit. */
+ /* */
+ /* This program is distributed in the hope that it will be useful, */
+ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either */
+ /* the GNU General Public License or the Artistic License for more */
+ /* details. */
+ /* */
+ /* You should have received a copy of the Artistic License with this */
+ /* Kit, in the file named "Artistic". If not, you can get one from */
+ /* the Perl distribution. */
+ /* */
+ /* You should also have received a copy of the GNU General Public */
+ /* License along with this program; if not, you can get one from */
+ /* the Perl distribution or else write to the Free Software */
+ /* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA */
+ /* 02111-1307, USA. */
+ /* */
+ /* +++end copyright+++ ********************************************* */
+
+ /* This program tests the code in vos_dummies.c to make sure it
+ works as expected. */
+
+ extern int dup (int _fildes);
+
+ int t_dummies ()
+ {
+ int fildes;
+
+ fildes=3;
+ dup (fildes);
+ }
diff -c /dev/null 'perl5.005_03/vos/vos_accept.c'
Index: vos/vos_accept.c
*** vos/vos_accept.c Wed Dec 31 18:00:00 1969
--- vos/vos_accept.c Thu Feb 11 18:06:27 1999
***************
*** 0 ****
--- 1,51 ----
+ /* +++begin copyright+++ ******************************************* */
+ /* */
+ /* COPYRIGHT (c) 1999 Stratus Computer, Inc. */
+ /* */
+ /* This program is free software; you can redistribute it and/or */
+ /* modify it under the terms of either: */
+ /* */
+ /* a) the GNU General Public License as published by the Free */
+ /* Software Foundation; either version 1, or (at your option) any */
+ /* later version, or */
+ /* */
+ /* b) the "Artistic License" which comes with this Kit. */
+ /* */
+ /* This program is distributed in the hope that it will be useful, */
+ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either */
+ /* the GNU General Public License or the Artistic License for more */
+ /* details. */
+ /* */
+ /* You should have received a copy of the Artistic License with this */
+ /* Kit, in the file named "Artistic". If not, you can get one from */
+ /* the Perl distribution. */
+ /* */
+ /* You should also have received a copy of the GNU General Public */
+ /* License along with this program; if not, you can get one from */
+ /* the Perl distribution or else write to the Free Software */
+ /* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA */
+ /* 02111-1307, USA. */
+ /* */
+ /* +++end copyright+++ ********************************************* */
+
+ #define _POSIX_C_SOURCE 199309L
+
+ /* Beginning of modification history */
+ /* Written 99-02-03 by Paul Green. */
+ /* End of modification history */
+
+ /* This short program soaks up the call to "accept" and
+ transfers it to "_accept". This is necessary because the VOS
+ C compilers treat "accept" as a keyword unless the -Xc
+ (strict ANSI option) has been specified. This program must
+ be compiled with -Xc. Because "accept" is a keyword, the VOS
+ OS TCP/IP product has renamed the usual TCP/IP "accept"
+ function to "_accept". */
+
+ extern int _accept (int a, struct sockaddr *b, int *c);
+
+ extern int accept (int a, struct sockaddr *b, int *c)
+ {
+ return _accept (a, b, c);
+ }
diff -c /dev/null 'perl5.005_03/vos/vos_dummies.c'
Index: vos/vos_dummies.c
*** vos/vos_dummies.c Wed Dec 31 18:00:00 1969
--- vos/vos_dummies.c Thu Feb 11 18:06:27 1999
***************
*** 0 ****
--- 1,94 ----
+ /* +++begin copyright+++ ******************************************* */
+ /* */
+ /* COPYRIGHT (c) 1997, 1998, 1999 Stratus Computer, Inc. */
+ /* */
+ /* This program is free software; you can redistribute it and/or */
+ /* modify it under the terms of either: */
+ /* */
+ /* a) the GNU General Public License as published by the Free */
+ /* Software Foundation; either version 1, or (at your option) any */
+ /* later version, or */
+ /* */
+ /* b) the "Artistic License" which comes with this Kit. */
+ /* */
+ /* This program is distributed in the hope that it will be useful, */
+ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
+ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either */
+ /* the GNU General Public License or the Artistic License for more */
+ /* details. */
+ /* */
+ /* You should have received a copy of the Artistic License with this */
+ /* Kit, in the file named "Artistic". If not, you can get one from */
+ /* the Perl distribution. */
+ /* */
+ /* You should also have received a copy of the GNU General Public */
+ /* License along with this program; if not, you can get one from */
+ /* the Perl distribution or else write to the Free Software */
+ /* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA */
+ /* 02111-1307, USA. */
+ /* */
+ /* +++end copyright+++ ********************************************* */
+
+ #define _POSIX_C_SOURCE 199309L
+
+ #include <stdio.h>
+ #include <string.h>
+ #include <sys/types.h>
+
+ extern void s$stop_program (char_varying (256) *command_line,
+ short int *error_code);
+ extern void s$write_code (char_varying *record_buffer,
+ short int *error_code);
+ extern int vos_call_debug ();
+
+ #pragma page
+ static void bomb (char *p_name)
+ {
+ char_varying(256) msgvs;
+
+ strcpy_vstr_nstr (&msgvs, "FATAL ERROR: Call to unimplemented function '");
+ strcat_vstr_nstr (&msgvs, p_name);
+ strcat_vstr_nstr (&msgvs, "'. Entering debugger.");
+ s$write_code (&msgvs, &0);
+
+ strcpy_vstr_nstr (&msgvs, "Please capture the output of the 'trace' request and mail it to Paul_Green@stratus.com.");
+ s$write_code (&msgvs, &0);
+
+ vos_call_debug ();
+
+ strcpy_vstr_nstr (&msgvs, "Return from debugger. Stopping program. Sorry but this error is unrecoverable.");
+ s$write_code (&msgvs, &0);
+ s$stop_program (&"", &1);
+ }
+
+ extern int dup (int _fildes)
+ {
+ bomb ("dup");
+ }
+
+ extern int do_aspawn ()
+ {
+ bomb ("do_aspawn");
+ }
+
+ extern int do_spawn ()
+ {
+ bomb ("do_spawn");
+ }
+
+ extern pid_t fork (void)
+ {
+ bomb ("fork");
+ }
+
+ extern void Perl_dump_mstats (char *s)
+ {
+ bomb ("Perl_dump_mstats");
+ }
+
+ extern pid_t waitpid (pid_t pid, int *stat_loc, int options)
+ {
+
+ bomb ("waitpid");
+ }
+
diff -c /dev/null 'perl5.005_03/vos/vosish.h'
Index: vos/vosish.h
*** vos/vosish.h Wed Dec 31 18:00:00 1969
--- vos/vosish.h Thu Feb 11 18:06:27 1999
***************
*** 0 ****
--- 1,132 ----
+ /*
+ * The following symbols are defined if your operating system supports
+ * functions by that name. All Unixes I know of support them, thus they
+ * are not checked by the configuration script, but are directly defined
+ * here.
+ */
+
+ /* HAS_IOCTL:
+ * This symbol, if defined, indicates that the ioctl() routine is
+ * available to set I/O characteristics
+ */
+ #define HAS_IOCTL / **/
+
+ /* HAS_UTIME:
+ * This symbol, if defined, indicates that the routine utime() is
+ * available to update the access and modification times of files.
+ */
+ #define HAS_UTIME / **/
+
+ /* HAS_GROUP
+ * This symbol, if defined, indicates that the getgrnam() and
+ * getgrgid() routines are available to get group entries.
+ * The getgrent() has a separate definition, HAS_GETGRENT.
+ */
+ /*#define HAS_GROUP / **/
+
+ /* HAS_PASSWD
+ * This symbol, if defined, indicates that the getpwnam() and
+ * getpwuid() routines are available to get password entries.
+ * The getpwent() has a separate definition, HAS_GETPWENT.
+ */
+ /*#define HAS_PASSWD / **/
+
+ #define HAS_KILL
+ #define HAS_WAIT
+
+ /* USEMYBINMODE
+ * This symbol, if defined, indicates that the program should
+ * use the routine my_binmode(FILE *fp, char iotype) to insure
+ * that a file is in "binary" mode -- that is, that no translation
+ * of bytes occurs on read or write operations.
+ */
+ #undef USEMYBINMODE
+
+ /* Stat_t:
+ * This symbol holds the type used to declare buffers for information
+ * returned by stat(). It's usually just struct stat. It may be necessary
+ * to include <sys/stat.h> and <sys/types.h> to get any typedef'ed
+ * information.
+ */
+ #define Stat_t struct stat
+
+ /* USE_STAT_RDEV:
+ * This symbol is defined if this system has a stat structure declaring
+ * st_rdev
+ */
+ #undef USE_STAT_RDEV /**/
+
+ /* ACME_MESS:
+ * This symbol, if defined, indicates that error messages should be
+ * should be generated in a format that allows the use of the Acme
+ * GUI/editor's autofind feature.
+ */
+ #undef ACME_MESS /**/
+
+ /* UNLINK_ALL_VERSIONS:
+ * This symbol, if defined, indicates that the program should arrange
+ * to remove all versions of a file if unlink() is called. This is
+ * probably only relevant for VMS.
+ */
+ /* #define UNLINK_ALL_VERSIONS / **/
+
+ /* VMS:
+ * This symbol, if defined, indicates that the program is running under
+ * VMS. It is currently automatically set by cpps running under VMS,
+ * and is included here for completeness only.
+ */
+ /* #define VMS / **/
+
+ /* ALTERNATE_SHEBANG:
+ * This symbol, if defined, contains a "magic" string which may be used
+ * as the first line of a Perl program designed to be executed directly
+ * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG
+ * begins with a character other then #, then Perl will only treat
+ * it as a command line if if finds the string "perl" in the first
+ * word; otherwise it's treated as the first line of code in the script.
+ * (IOW, Perl won't hand off to another interpreter via an alternate
+ * shebang sequence that might be legal Perl code.)
+ */
+ /* #define ALTERNATE_SHEBANG "#!" / **/
+
+ #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
+ # include <signal.h>
+ #endif
+
+ #ifndef SIGABRT
+ # define SIGABRT SIGILL
+ #endif
+ #ifndef SIGILL
+ # define SIGILL 6 /* blech */
+ #endif
+ #define ABORT() kill(getpid(),SIGABRT);
+
+ /*
+ * fwrite1() should be a routine with the same calling sequence as fwrite(),
+ * but which outputs all of the bytes requested as a single stream (unlike
+ * fwrite() itself, which on some systems outputs several distinct records
+ * if the number_of_items parameter is >1).
+ */
+ #define fwrite1 fwrite
+
+ #define Stat(fname,bufptr) stat((fname),(bufptr))
+ #define Fstat(fd,bufptr) fstat((fd),(bufptr))
+ #define Fflush(fp) fflush(fp)
+ #define Mkdir(path,mode) mkdir((path),(mode))
+
+ #ifndef PERL_SYS_INIT
+ #ifdef PERL_SCO5
+ /* this should be set in a hint file, not here */
+ # define PERL_SYS_INIT(c,v) fpsetmask(0); MALLOC_INIT
+ #else
+ # define PERL_SYS_INIT(c,v) MALLOC_INIT
+ #endif
+ #endif
+
+ #ifndef PERL_SYS_TERM
+ #define PERL_SYS_TERM() MALLOC_TERM
+ #endif
+
+ #define BIT_BUCKET "/dev/null"
+
+ #define dXSUB_SYS
diff -c 'perl5.005_02/win32/GenCAPI.pl' 'perl5.005_03/win32/GenCAPI.pl'
Index: ./win32/GenCAPI.pl
*** ./win32/GenCAPI.pl Sun Jul 26 18:25:00 1998
--- ./win32/GenCAPI.pl Sun Mar 28 01:57:24 1999
***************
*** 3,8 ****
--- 3,10 ----
# takes one argument, the path to lib/CORE directory.
# creates 2 files: "perlCAPI.cpp" and "perlCAPI.h".
+ #use Config;
+
my $hdrfile = "$ARGV[0]\\perlCAPI.h";
my $infile = '..\\proto.h';
my $embedfile = '..\\embed.h';
***************
*** 98,106 ****
print OUTFILE "#ifdef SetCPerlObj_defined\n" unless ($separateObj == 0);
print OUTFILE <<ENDCODE;
! extern "C" void SetCPerlObj(CPerlObj* pP)
{
! pPerl = pP;
}
ENDCODE
--- 100,108 ----
print OUTFILE "#ifdef SetCPerlObj_defined\n" unless ($separateObj == 0);
print OUTFILE <<ENDCODE;
! EXTERN_C void SetCPerlObj(void *pP)
{
! pPerl = (CPerlObj*)pP;
}
ENDCODE
***************
*** 148,154 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $funcName ($args)
{
char *pstr;
char *pmsg;
--- 150,156 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $funcName ($args)
{
char *pstr;
char *pmsg;
***************
*** 170,176 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $funcName ($args)
{
SV *sv;
va_list args;
--- 172,178 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $funcName ($args)
{
SV *sv;
va_list args;
***************
*** 192,198 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
--- 194,200 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
***************
*** 214,220 ****
#ifndef mg_set
#define mg_set pPerl->Perl_mg_set
#endif
! extern "C" $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
--- 216,222 ----
#ifndef mg_set
#define mg_set pPerl->Perl_mg_set
#endif
! EXTERN_C $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
***************
*** 234,240 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
--- 236,242 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
***************
*** 256,262 ****
#ifndef mg_set
#define mg_set pPerl->Perl_mg_set
#endif
! extern "C" $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
--- 258,264 ----
#ifndef mg_set
#define mg_set pPerl->Perl_mg_set
#endif
! EXTERN_C $type $funcName ($args)
{
va_list args;
va_start(args, $arg1);
***************
*** 276,282 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $name ($args)
{
int nRet;
va_list args;
--- 278,284 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $name ($args)
{
int nRet;
va_list args;
***************
*** 321,327 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $name ($args)
{
return pPerl->perl_parse(xsinit, argc, argv, env);
}
--- 323,329 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $name ($args)
{
return pPerl->perl_parse(xsinit, argc, argv, env);
}
***************
*** 334,340 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $name ($args)
{
pPerl->perl_atexit(fn, ptr);
}
--- 336,342 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $name ($args)
{
pPerl->perl_atexit(fn, ptr);
}
***************
*** 353,359 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $funcName ()
{
$return pPerl->$funcName();
}
--- 355,361 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $funcName ()
{
$return pPerl->$funcName();
}
***************
*** 367,373 ****
print OUTFILE <<ENDCODE;
#undef $name
! extern "C" $type $funcName ($args)
{
ENDCODE
print OUTFILE "$return pPerl->$funcName";
--- 369,375 ----
print OUTFILE <<ENDCODE;
#undef $name
! EXTERN_C $type $funcName ($args)
{
ENDCODE
print OUTFILE "$return pPerl->$funcName";
***************
*** 422,427 ****
--- 424,430 ----
ors
opsave
eval_mutex
+ strtab_mutex
orslen
ofmt
modcount
***************
*** 488,493 ****
--- 491,497 ----
malloc_mutex
svref_mutex
sv_mutex
+ cred_mutex
nthreads_cond
eval_cond
cryptseen
***************
*** 519,526 ****
open(HDRFILE, ">$hdrfile") or die "$0: Can't open $hdrfile: $!\n";
print HDRFILE <<ENDCODE;
! void SetCPerlObj(void* pP);
! CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename);
ENDCODE
--- 523,530 ----
open(HDRFILE, ">$hdrfile") or die "$0: Can't open $hdrfile: $!\n";
print HDRFILE <<ENDCODE;
! EXTERN_C void SetCPerlObj(void* pP);
! EXTERN_C CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename);
ENDCODE
***************
*** 534,540 ****
print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
print OUTFILE <<ENDCODE;
#undef PL_$name
! extern "C" $type * _PL_$name ()
{
return (($type *)&pPerl->PL_$name);
}
--- 538,544 ----
print OUTFILE "\n#ifdef $name" . "_defined" unless ($separateObj == 0);
print OUTFILE <<ENDCODE;
#undef PL_$name
! EXTERN_C $type * _PL_$name ()
{
return (($type *)&pPerl->PL_$name);
}
***************
*** 546,552 ****
print HDRFILE <<ENDCODE;
#undef PL_$name
! $type * _PL_$name ();
#define PL_$name (*_PL_$name())
ENDCODE
--- 550,556 ----
print HDRFILE <<ENDCODE;
#undef PL_$name
! EXTERN_C $type * _PL_$name ();
#define PL_$name (*_PL_$name())
ENDCODE
***************
*** 567,575 ****
print OUTFILE <<EOCODE;
!
! extern "C" {
!
char ** _Perl_op_desc(void)
{
--- 571,577 ----
print OUTFILE <<EOCODE;
! START_EXTERN_C
char ** _Perl_op_desc(void)
{
***************
*** 593,598 ****
--- 595,603 ----
void xs_handler(CV* cv, CPerlObj* p)
{
+ #ifndef NO_XSLOCKS
+ XSLock localLock(p);
+ #endif
void(*func)(CV*);
SV* sv;
MAGIC* m = pPerl->Perl_mg_find((SV*)cv, '~');
***************
*** 611,617 ****
}
}
! CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename)
{
CV* cv = pPerl->Perl_newXS(name, xs_handler, filename);
pPerl->Perl_sv_magic((SV*)cv, pPerl->Perl_sv_2mortal(pPerl->Perl_newSViv((IV)subaddr)), '~', "CAPI", 4);
--- 616,622 ----
}
}
! EXTERN_C CV* Perl_newXS(char* name, void (*subaddr)(CV* cv), char* filename)
{
CV* cv = pPerl->Perl_newXS(name, xs_handler, filename);
pPerl->Perl_sv_magic((SV*)cv, pPerl->Perl_sv_2mortal(pPerl->Perl_newSViv((IV)subaddr)), '~', "CAPI", 4);
***************
*** 987,992 ****
--- 992,1002 ----
return pPerl->PL_piENV->Getenv(name, ErrorNo());
}
+ int _win32_putenv(const char *name)
+ {
+ return pPerl->PL_piENV->Putenv(name, ErrorNo());
+ }
+
int _win32_open_osfhandle(long handle, int flags)
{
return pPerl->PL_piStdIO->OpenOSfhandle(handle, flags);
***************
*** 1215,1225 ****
{
pPerl->PL_piSock->Setservent(stayopen, ErrorNo());
}
! } /* extern "C" */
EOCODE
print HDRFILE <<EOCODE;
#undef Perl_op_desc
char ** _Perl_op_desc ();
#define Perl_op_desc (_Perl_op_desc())
--- 1225,1238 ----
{
pPerl->PL_piSock->Setservent(stayopen, ErrorNo());
}
! END_EXTERN_C
EOCODE
print HDRFILE <<EOCODE;
+
+ START_EXTERN_C
+
#undef Perl_op_desc
char ** _Perl_op_desc ();
#define Perl_op_desc (_Perl_op_desc())
***************
*** 1592,1597 ****
--- 1605,1612 ----
void _win32_setnetent(int stayopen);
void _win32_setprotoent(int stayopen);
void _win32_setservent(int stayopen);
+
+ END_EXTERN_C
#pragma warning(once : 4113)
EOCODE
diff -c 'perl5.005_02/win32/Makefile' 'perl5.005_03/win32/Makefile'
Index: ./win32/Makefile
*** ./win32/Makefile Fri Aug 7 22:57:52 1998
--- ./win32/Makefile Sun Mar 28 16:36:42 1999
***************
*** 6,11 ****
--- 6,15 ----
#
##
+ ## Make sure you read README.win32 *before* you mess with anything here!
+ ##
+
+ ##
## Build configuration. Edit the values below to suit your needs.
##
***************
*** 25,31 ****
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
! INST_VER = \5.00502
#
# uncomment to enable threads-capabilities
--- 29,35 ----
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
! INST_VER = \5.00503
#
# uncomment to enable threads-capabilities
***************
*** 33,38 ****
--- 37,47 ----
#USE_THREADS = define
#
+ # uncomment to enable multiple interpreters
+ #
+ #USE_MULTI = define
+
+ #
# uncomment next line if you are using Visual C++ 2.x
#
#CCTYPE = MSVC20
***************
*** 49,54 ****
--- 58,72 ----
#CFG = Debug
#
+ # uncomment next option if you want to use the VC++ compiler optimization.
+ # Warning: This is known to produce incorrect code for compiler versions
+ # earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that
+ # successfully passes the Perl regression test suite. It hasn't yet been
+ # widely tested with real applications though.
+ #
+ #CFG = Optimize
+
+ #
# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL.
# This currently requires VC 5.0 with Service Pack 3.
***************
*** 91,96 ****
--- 109,118 ----
#
# set the install locations of the compiler include/libraries
+ # Running VCVARS32.BAT is *required* when using Visual C.
+ # Some versions of Visual C don't define MSVCDIR in the environment,
+ # so you may have to set CCHOME explicitly (spaces in the path name should
+ # not be quoted)
#
#CCHOME = f:\msvc20
CCHOME = $(MSVCDIR)
***************
*** 98,104 ****
CCLIBDIR = $(CCHOME)\lib
#
! # specify space-separated list of extra directories to look for libraries
#
EXTRALIBDIRS =
--- 120,127 ----
CCLIBDIR = $(CCHOME)\lib
#
! # specify semicolon-separated list of extra directories that modules will
! # look for libraries (spaces in path names need not be quoted)
#
EXTRALIBDIRS =
***************
*** 123,128 ****
--- 146,153 ----
!IF "$(OBJECT)" != ""
PERL_MALLOC = undef
+ USE_THREADS = undef
+ USE_MULTI = undef
!ENDIF
!IF "$(PERL_MALLOC)" == ""
***************
*** 133,140 ****
USE_THREADS = undef
!ENDIF
! #BUILDOPT = -DMULTIPLICITY
! #BUILDOPT = -DPERL_GLOBAL_STRUCT -DMULTIPLICITY
# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
--- 158,168 ----
USE_THREADS = undef
!ENDIF
! !IF "$(USE_MULTI)" == ""
! USE_MULTI = undef
! !ENDIF
!
! #BUILDOPT = -DPERL_GLOBAL_STRUCT
# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include
!IF "$(PROCESSOR_ARCHITECTURE)" == ""
***************
*** 203,210 ****
! ENDIF
LINK_DBG = -debug -pdb:none
!ELSE
! ! IF "$(CCTYPE)" == "MSVC20"
! OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
! ELSE
OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
! ENDIF
--- 231,238 ----
! ENDIF
LINK_DBG = -debug -pdb:none
!ELSE
! ! IF "$(CFG)" == "Optimize"
! OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
! ELSE
OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
! ENDIF
***************
*** 545,566 ****
"INST_VER=$(INST_VER)" \
"archname=$(ARCHNAME)" \
"cc=$(CC)" \
! "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)" \
"cf_email=$(EMAIL)" \
"d_crypt=$(D_CRYPT)" \
"d_mymalloc=$(PERL_MALLOC)" \
"libs=$(LIBFILES)" \
! "incpath=$(CCINCDIR)" \
! "libperl=$(PERLIMPLIB:..\=)" \
! "libpth=$(CCLIBDIR) $(EXTRALIBDIRS)" \
"libc=$(LIBC)" \
"make=nmake" \
"static_ext=$(STATIC_EXT)" \
"dynamic_ext=$(DYNAMIC_EXT)" \
"nonxs_ext=$(NONXS_EXT)" \
"usethreads=$(USE_THREADS)" \
! "LINK_FLAGS=$(LINK_FLAGS)" \
! "optimize=$(OPTIMIZE)"
#
# Top targets
--- 573,595 ----
"INST_VER=$(INST_VER)" \
"archname=$(ARCHNAME)" \
"cc=$(CC)" \
! "ccflags=$(OPTIMIZE:"=\") $(DEFINES) $(OBJECT)" \
"cf_email=$(EMAIL)" \
"d_crypt=$(D_CRYPT)" \
"d_mymalloc=$(PERL_MALLOC)" \
"libs=$(LIBFILES)" \
! "incpath=$(CCINCDIR:"=\")" \
! "libperl=$(PERLIMPLIB:..\=)" \
! "libpth=$(CCLIBDIR:"=\");$(EXTRALIBDIRS:"=\")" \
"libc=$(LIBC)" \
"make=nmake" \
"static_ext=$(STATIC_EXT)" \
"dynamic_ext=$(DYNAMIC_EXT)" \
"nonxs_ext=$(NONXS_EXT)" \
"usethreads=$(USE_THREADS)" \
! "usemultiplicity=$(USE_MULTI)" \
! "LINK_FLAGS=$(LINK_FLAGS:"=\")" \
! "optimize=$(OPTIMIZE:"=\")"
#
# Top targets
***************
*** 599,605 ****
perl configpm
cd win32
-del /f $(CFGH_TMPL)
! -mkdir ..\lib\CORE
-perl -I..\lib config_h.PL "INST_VER=$(INST_VER)"
rename config.h $(CFGH_TMPL)
--- 628,634 ----
perl configpm
cd win32
-del /f $(CFGH_TMPL)
! -mkdir $(COREDIR)
-perl -I..\lib config_h.PL "INST_VER=$(INST_VER)"
rename config.h $(CFGH_TMPL)
***************
*** 611,617 ****
$(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
$(RCOPY) include $(COREDIR)\*.*
$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \
! || $(MAKE) $(MAKEFLAGS) $(CONFIGPM)
$(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
$(LINK32) -subsystem:console -out:$@ @<<
--- 640,646 ----
$(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.*
$(RCOPY) include $(COREDIR)\*.*
$(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \
! || $(MAKE) /$(MAKEFLAGS) $(CONFIGPM)
$(MINIPERL) : $(MINIDIR) $(MINI_OBJ)
$(LINK32) -subsystem:console -out:$@ @<<
***************
*** 857,863 ****
-del /f perl95.c
-del /f bin\*.bat
cd $(EXTDIR)
! -del /s *.lib *.def *.map *.bs Makefile *$(o) pm_to_blib
cd ..\win32
-rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
-rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
--- 886,892 ----
-del /f perl95.c
-del /f bin\*.bat
cd $(EXTDIR)
! -del /s *.lib *.def *.map *.pdb *.bs Makefile *$(o) pm_to_blib
cd ..\win32
-rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
-rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
***************
*** 923,929 ****
-@erase $(WIN32_OBJ)
-@erase $(DLL_OBJ)
-@erase $(X2P_OBJ)
! -@erase ..\*$(o) ..\*.lib ..\*.exp *$(o) *.lib *.exp
-@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
-@erase ..\x2p\*.exe ..\x2p\*.bat
-@erase *.ilk
--- 952,958 ----
-@erase $(WIN32_OBJ)
-@erase $(DLL_OBJ)
-@erase $(X2P_OBJ)
! -@erase ..\*$(o) ..\*.lib ..\*.exp ..\*.res *$(o) *.lib *.exp *.res
-@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
-@erase ..\x2p\*.exe ..\x2p\*.bat
-@erase *.ilk
diff -c 'perl5.005_02/win32/bin/pl2bat.pl' 'perl5.005_03/win32/bin/pl2bat.pl'
Index: ./win32/bin/pl2bat.pl
*** ./win32/bin/pl2bat.pl Thu Jul 23 23:02:44 1998
--- ./win32/bin/pl2bat.pl Wed Nov 4 21:23:16 1998
***************
*** 80,85 ****
--- 80,87 ----
my $linenum = 0;
my $skiplines = 0;
my $line;
+ my $start= $Config{startperl};
+ $start= "#!perl" unless $start =~ /^#!.*perl/;
open( FILE, $file ) or die "$0: Can't open $file: $!";
@file = <FILE>;
foreach $line ( @file ) {
***************
*** 109,115 ****
$file .= '.bat' unless $file =~ /\.bat$/i or $file =~ /^-$/;
open( FILE, ">$file" ) or die "Can't open $file: $!";
print FILE $myhead;
! print FILE $Config{startperl}, ( $OPT{'w'} ? " -w" : "" ),
"\n#line ", ($headlines+1), "\n" unless $linedone;
print FILE @file[$skiplines..$#file];
print FILE $tail unless $taildone;
--- 111,117 ----
$file .= '.bat' unless $file =~ /\.bat$/i or $file =~ /^-$/;
open( FILE, ">$file" ) or die "Can't open $file: $!";
print FILE $myhead;
! print FILE $start, ( $OPT{'w'} ? " -w" : "" ),
"\n#line ", ($headlines+1), "\n" unless $linedone;
print FILE @file[$skiplines..$#file];
print FILE $tail unless $taildone;
diff -c 'perl5.005_02/win32/config.bc' 'perl5.005_03/win32/config.bc'
Index: ./win32/config.bc
*** ./win32/config.bc Thu Jul 23 23:02:47 1998
--- ./win32/config.bc Sat Jan 16 11:02:34 1999
***************
*** 21,26 ****
--- 21,27 ----
alignbytes='8'
ansi2knr=''
aphostname=''
+ apiversion='5.005'
ar='tlib /P128'
archlib='~INST_TOP~~INST_VER~\lib\~archname~'
archlibexp='~INST_TOP~~INST_VER~\lib\~archname~'
***************
*** 163,169 ****
d_memset='define'
d_mkdir='define'
d_mkfifo='undef'
- d_mkstemp='undef'
d_mktime='define'
d_msg='undef'
d_msgctl='undef'
--- 164,169 ----
***************
*** 309,315 ****
freetype='void'
full_csh=''
full_sed=''
- gcc=''
gccversion=''
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
--- 309,314 ----
***************
*** 495,503 ****
shortsize='2'
shrpenv=''
shsharp='true'
! sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM USR1 USR2 CHLD USR3 BREAK ABRT STOP CONT CLD'
! sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "USR3", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0'
! sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 16, 17, 18, 20, 21, 22, 23, 25, 18, 0'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
--- 494,503 ----
shortsize='2'
shrpenv=''
shsharp='true'
! sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM USR1 USR2 CHLD NUM19 USR3 BREAK ABRT STOP NUM24 CONT CLD'
! sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "NUM19", "USR3", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0'
! sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 18 0'
! sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 18, 0'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
diff -c 'perl5.005_02/win32/config.gc' 'perl5.005_03/win32/config.gc'
Index: ./win32/config.gc
*** ./win32/config.gc Thu Jul 23 23:02:47 1998
--- ./win32/config.gc Sun Dec 13 10:05:40 1998
***************
*** 21,26 ****
--- 21,27 ----
alignbytes='8'
ansi2knr=''
aphostname=''
+ apiversion='5.005'
ar='ar'
archlib='~INST_TOP~~INST_VER~\lib\~archname~'
archlibexp='~INST_TOP~~INST_VER~\lib\~archname~'
***************
*** 163,169 ****
d_memset='define'
d_mkdir='define'
d_mkfifo='undef'
- d_mkstemp='undef'
d_mktime='define'
d_msg='undef'
d_msgctl='undef'
--- 164,169 ----
***************
*** 309,315 ****
freetype='void'
full_csh=''
full_sed=''
- gcc=''
gccversion=''
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
--- 309,314 ----
***************
*** 495,503 ****
shortsize='2'
shrpenv=''
shsharp='true'
! sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CONT CLD'
! sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0'
! sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
--- 494,503 ----
shortsize='2'
shrpenv=''
shsharp='true'
! sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM NUM16 NUM17 NUM18 NUM19 CHLD BREAK ABRT STOP NUM24 CONT CLD'
! sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0'
! sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 20 0'
! sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
diff -c 'perl5.005_02/win32/config.vc' 'perl5.005_03/win32/config.vc'
Index: ./win32/config.vc
*** ./win32/config.vc Thu Jul 23 23:02:47 1998
--- ./win32/config.vc Sun Dec 13 10:05:40 1998
***************
*** 21,26 ****
--- 21,27 ----
alignbytes='8'
ansi2knr=''
aphostname=''
+ apiversion='5.005'
ar='lib'
archlib='~INST_TOP~~INST_VER~\lib\~archname~'
archlibexp='~INST_TOP~~INST_VER~\lib\~archname~'
***************
*** 163,169 ****
d_memset='define'
d_mkdir='define'
d_mkfifo='undef'
- d_mkstemp='undef'
d_mktime='define'
d_msg='undef'
d_msgctl='undef'
--- 164,169 ----
***************
*** 309,315 ****
freetype='void'
full_csh=''
full_sed=''
- gcc=''
gccversion=''
gidtype='gid_t'
glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib '
--- 309,314 ----
***************
*** 495,503 ****
shortsize='2'
shrpenv=''
shsharp='true'
! sig_name='ZERO INT QUIT ILL FPE KILL SEGV PIPE ALRM TERM CHLD BREAK ABRT STOP CONT CLD'
! sig_name_init='"ZERO", "INT", "QUIT", "ILL", "FPE", "KILL", "SEGV", "PIPE", "ALRM", "TERM", "CHLD", "BREAK", "ABRT", "STOP", "CONT", "CLD", 0'
! sig_num='0, 2, 3, 4, 8, 9, 11, 13, 14, 15, 20, 21, 22, 23, 25, 20, 0'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
--- 494,503 ----
shortsize='2'
shrpenv=''
shsharp='true'
! sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM NUM16 NUM17 NUM18 NUM19 CHLD BREAK ABRT STOP NUM24 CONT CLD'
! sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0'
! sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 20 0'
! sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0'
signal_t='void'
sitearch='~INST_TOP~\site~INST_VER~\lib\~archname~'
sitearchexp='~INST_TOP~\site~INST_VER~\lib\~archname~'
diff -c 'perl5.005_02/win32/config_H.bc' 'perl5.005_03/win32/config_H.bc'
Index: ./win32/config_H.bc
Prereq: 3.0.1.5
*** ./win32/config_H.bc Sun Aug 2 00:37:35 1998
--- ./win32/config_H.bc Sun Nov 29 20:23:07 1998
***************
*** 34,41 ****
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
! #define BIN "c:\\perl\\5.00502\\bin\\MSWin32-x86" /**/
! #define BIN_EXP "c:\\perl\\5.00502\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
--- 34,41 ----
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
! #define BIN "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
! #define BIN_EXP "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
***************
*** 1829,1835 ****
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define ARCHLIB "c:\\perl\\5.00502\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* DLSYM_NEEDS_UNDERSCORE:
--- 1829,1835 ----
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define ARCHLIB "c:\\perl\\5.00503\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* DLSYM_NEEDS_UNDERSCORE:
***************
*** 1875,1882 ****
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define PRIVLIB "c:\\perl\\5.00502\\lib" /**/
! #define PRIVLIB_EXP (win32_get_privlib("5.00502")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
--- 1875,1882 ----
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define PRIVLIB "c:\\perl\\5.00503\\lib" /**/
! #define PRIVLIB_EXP (win32_get_privlib("5.00503")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
***************
*** 1891,1897 ****
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITEARCH "c:\\perl\\site\\5.00502\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
--- 1891,1897 ----
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITEARCH "c:\\perl\\site\\5.00503\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
***************
*** 1907,1914 ****
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITELIB "c:\\perl\\site\\5.00502\\lib" /**/
! #define SITELIB_EXP (win32_get_sitelib("5.00502")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
--- 1907,1914 ----
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITELIB "c:\\perl\\site\\5.00503\\lib" /**/
! #define SITELIB_EXP (win32_get_sitelib("5.00503")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
diff -c 'perl5.005_02/win32/config_H.gc' 'perl5.005_03/win32/config_H.gc'
Index: ./win32/config_H.gc
Prereq: 3.0.1.5
*** ./win32/config_H.gc Sun Aug 2 00:37:35 1998
--- ./win32/config_H.gc Sun Nov 29 20:23:07 1998
***************
*** 34,41 ****
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
! #define BIN "c:\\perl\\5.00502\\bin\\MSWin32-x86" /**/
! #define BIN_EXP "c:\\perl\\5.00502\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
--- 34,41 ----
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
! #define BIN "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
! #define BIN_EXP "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
***************
*** 1829,1835 ****
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define ARCHLIB "c:\\perl\\5.00502\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* DLSYM_NEEDS_UNDERSCORE:
--- 1829,1835 ----
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define ARCHLIB "c:\\perl\\5.00503\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* DLSYM_NEEDS_UNDERSCORE:
***************
*** 1875,1882 ****
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define PRIVLIB "c:\\perl\\5.00502\\lib" /**/
! #define PRIVLIB_EXP (win32_get_privlib("5.00502")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
--- 1875,1882 ----
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define PRIVLIB "c:\\perl\\5.00503\\lib" /**/
! #define PRIVLIB_EXP (win32_get_privlib("5.00503")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
***************
*** 1891,1897 ****
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITEARCH "c:\\perl\\site\\5.00502\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
--- 1891,1897 ----
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITEARCH "c:\\perl\\site\\5.00503\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
***************
*** 1907,1914 ****
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITELIB "c:\\perl\\site\\5.00502\\lib" /**/
! #define SITELIB_EXP (win32_get_sitelib("5.00502")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
--- 1907,1914 ----
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITELIB "c:\\perl\\site\\5.00503\\lib" /**/
! #define SITELIB_EXP (win32_get_sitelib("5.00503")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
diff -c 'perl5.005_02/win32/config_H.vc' 'perl5.005_03/win32/config_H.vc'
Index: ./win32/config_H.vc
Prereq: 3.0.1.5
*** ./win32/config_H.vc Sun Aug 2 00:37:35 1998
--- ./win32/config_H.vc Sun Nov 29 20:23:07 1998
***************
*** 34,41 ****
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
! #define BIN "c:\\perl\\5.00502\\bin\\MSWin32-x86" /**/
! #define BIN_EXP "c:\\perl\\5.00502\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
--- 34,41 ----
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
! #define BIN "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
! #define BIN_EXP "c:\\perl\\5.00503\\bin\\MSWin32-x86" /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
***************
*** 1829,1835 ****
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define ARCHLIB "c:\\perl\\5.00502\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* DLSYM_NEEDS_UNDERSCORE:
--- 1829,1835 ----
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define ARCHLIB "c:\\perl\\5.00503\\lib\\MSWin32-x86" /**/
/*#define ARCHLIB_EXP "" /**/
/* DLSYM_NEEDS_UNDERSCORE:
***************
*** 1875,1882 ****
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define PRIVLIB "c:\\perl\\5.00502\\lib" /**/
! #define PRIVLIB_EXP (win32_get_privlib("5.00502")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
--- 1875,1882 ----
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define PRIVLIB "c:\\perl\\5.00503\\lib" /**/
! #define PRIVLIB_EXP (win32_get_privlib("5.00503")) /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
***************
*** 1891,1897 ****
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITEARCH "c:\\perl\\site\\5.00502\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
--- 1891,1897 ----
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITEARCH "c:\\perl\\site\\5.00503\\lib\\MSWin32-x86" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
***************
*** 1907,1914 ****
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITELIB "c:\\perl\\site\\5.00502\\lib" /**/
! #define SITELIB_EXP (win32_get_sitelib("5.00502")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
--- 1907,1914 ----
* This symbol contains the ~name expanded version of SITELIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
! #define SITELIB "c:\\perl\\site\\5.00503\\lib" /**/
! #define SITELIB_EXP (win32_get_sitelib("5.00503")) /**/
/* STARTPERL:
* This variable contains the string to put in front of a perl
diff -c 'perl5.005_02/win32/config_sh.PL' 'perl5.005_03/win32/config_sh.PL'
Index: ./win32/config_sh.PL
*** ./win32/config_sh.PL Thu Jul 23 23:02:51 1998
--- ./win32/config_sh.PL Thu Jan 21 18:40:11 1999
***************
*** 1,3 ****
--- 1,15 ----
+ # take a semicolon separated path list and turn it into a quoted
+ # list of paths that Text::Parsewords will grok
+ sub mungepath {
+ my $p = shift;
+ # remove leading/trailing semis/spaces
+ $p =~ s/^[ ;]+//;
+ $p =~ s/[ ;]+$//;
+ $p =~ s/'/"/g;
+ my @p = map { $_ = "\"$_\"" if /\s/ and !/^".*"$/; $_ } split /;/, $p;
+ return join(' ', @p);
+ }
+
my %opt;
while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/)
{
***************
*** 16,21 ****
--- 28,36 ----
$opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0]
unless $opt{'cf_email'};
$opt{'usemymalloc'} = 'y' if $opt{'d_mymalloc'} eq 'define';
+
+ $opt{libpth} = mungepath($opt{libpth}) if exists $opt{libpth};
+ $opt{incpath} = mungepath($opt{incpath}) if exists $opt{incpath};
while (<>)
{
diff -c 'perl5.005_02/win32/makedef.pl' 'perl5.005_03/win32/makedef.pl'
Index: ./win32/makedef.pl
*** ./win32/makedef.pl Thu Jul 23 23:02:52 1998
--- ./win32/makedef.pl Sat Feb 13 12:06:17 1999
***************
*** 216,221 ****
--- 216,223 ----
skip_symbols [qw(
PL_thr_key
PL_sv_mutex
+ PL_cred_mutex
+ PL_strtab_mutex
PL_svref_mutex
PL_malloc_mutex
PL_eval_mutex
***************
*** 515,520 ****
--- 517,523 ----
win32_setprotoent
win32_setservent
win32_getenv
+ win32_putenv
win32_perror
win32_setbuf
win32_setvbuf
diff -c 'perl5.005_02/win32/makefile.mk' 'perl5.005_03/win32/makefile.mk'
Index: ./win32/makefile.mk
*** ./win32/makefile.mk Fri Aug 7 22:57:53 1998
--- ./win32/makefile.mk Sun Mar 28 16:36:42 1999
***************
*** 10,15 ****
--- 10,19 ----
#
##
+ ## Make sure you read README.win32 *before* you mess with anything here!
+ ##
+
+ ##
## Build configuration. Edit the values below to suit your needs.
##
***************
*** 29,35 ****
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
! INST_VER *= \5.00502
#
# uncomment to enable threads-capabilities
--- 33,39 ----
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
! INST_VER *= \5.00503
#
# uncomment to enable threads-capabilities
***************
*** 37,42 ****
--- 41,51 ----
#USE_THREADS *= define
#
+ # uncomment to enable multiple interpreters
+ #
+ #USE_MULTI *= define
+
+ #
# uncomment one
#
#CCTYPE *= MSVC20
***************
*** 57,62 ****
--- 66,83 ----
#CFG *= Debug
#
+ # uncomment next option if you want to use the VC++ compiler optimization.
+ # This option is only relevant for the Microsoft compiler; we automatically
+ # use maximum optimization with the other compilers (unless you specify a
+ # DEBUGGING build).
+ # Warning: This is known to produce incorrect code for compiler versions
+ # earlier than VC++ 98 (Visual Studio 6.0). VC++ 98 generates code that
+ # successfully passes the Perl regression test suite. It hasn't yet been
+ # widely tested with real applications though.
+ #
+ #CFG *= Optimize
+
+ #
# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL.
# This currently requires VC 5.0 with Service Pack 3.
***************
*** 99,104 ****
--- 120,129 ----
#
# set the install locations of the compiler include/libraries
+ # Running VCVARS32.BAT is *required* when using Visual C.
+ # Some versions of Visual C don't define MSVCDIR in the environment,
+ # so you may have to set CCHOME explicitly (spaces in the path name should
+ # not be quoted)
#
#CCHOME *= f:\msdev\vc
CCHOME *= C:\bc5
***************
*** 107,113 ****
CCLIBDIR *= $(CCHOME)\lib
#
! # specify space-separated list of extra directories to look for libraries
#
EXTRALIBDIRS *=
--- 132,139 ----
CCLIBDIR *= $(CCHOME)\lib
#
! # specify semicolon-separated list of extra directories that modules will
! # look for libraries (spaces in path names need not be quoted)
#
EXTRALIBDIRS *=
***************
*** 138,151 ****
.IF "$(OBJECT)" != ""
PERL_MALLOC != undef
.ENDIF
PERL_MALLOC *= undef
USE_THREADS *= undef
! #BUILDOPT *= -DMULTIPLICITY
! #BUILDOPT *= -DPERL_GLOBAL_STRUCT -DMULTIPLICITY
# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include
.IMPORT .IGNORE : PROCESSOR_ARCHITECTURE
--- 164,179 ----
.IF "$(OBJECT)" != ""
PERL_MALLOC != undef
+ USE_THREADS != undef
+ USE_MULTI != undef
.ENDIF
PERL_MALLOC *= undef
USE_THREADS *= undef
+ USE_MULTI *= undef
! #BUILDOPT *= -DPERL_GLOBAL_STRUCT
# -DUSE_PERLIO -D__STDC__=1 -DUSE_SFIO -DI_SFIO -I\sfio97\include
.IMPORT .IGNORE : PROCESSOR_ARCHITECTURE
***************
*** 181,187 ****
# Options
#
RUNTIME = -D_RTLDLL
! INCLUDES = -I$(COREDIR) -I.\include -I. -I.. -I$(CCINCDIR)
#PCHFLAGS = -H -Hc -H=c:\temp\bcmoduls.pch
DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG)
LOCDEFS = -DPERLDLL -DPERL_CORE
--- 209,215 ----
# Options
#
RUNTIME = -D_RTLDLL
! INCLUDES = -I$(COREDIR) -I.\include -I. -I.. -I"$(CCINCDIR)"
#PCHFLAGS = -H -Hc -H=c:\temp\bcmoduls.pch
DEFINES = -DWIN32 $(BUILDOPT) $(CRYPT_FLAG)
LOCDEFS = -DPERLDLL -DPERL_CORE
***************
*** 199,207 ****
LINK_DBG =
.ENDIF
! CFLAGS = -w -d -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \
$(PCHFLAGS) $(OPTIMIZE)
! LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) $(EXTRALIBDIRS:^"-L")
OBJOUT_FLAG = -o
EXEOUT_FLAG = -e
LIBOUT_FLAG =
--- 227,235 ----
LINK_DBG =
.ENDIF
! CFLAGS = -w -g0 -tWM -tWD $(INCLUDES) $(DEFINES) $(LOCDEFS) \
$(PCHFLAGS) $(OPTIMIZE)
! LINK_FLAGS = $(LINK_DBG) -L"$(CCLIBDIR)"
OBJOUT_FLAG = -o
EXEOUT_FLAG = -e
LIBOUT_FLAG =
***************
*** 239,245 ****
.ENDIF
CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE)
! LINK_FLAGS = $(LINK_DBG) -L$(CCLIBDIR) $(EXTRALIBDIRS:^"-L")
OBJOUT_FLAG = -o
EXEOUT_FLAG = -o
LIBOUT_FLAG =
--- 267,273 ----
.ENDIF
CFLAGS = $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE)
! LINK_FLAGS = $(LINK_DBG) -L"$(CCLIBDIR)"
OBJOUT_FLAG = -o
EXEOUT_FLAG = -o
LIBOUT_FLAG =
***************
*** 290,297 ****
.ENDIF
LINK_DBG = -debug -pdb:none
.ELSE
! .IF "$(CCTYPE)" == "MSVC20"
! OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
.ELSE
OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
.ENDIF
--- 318,325 ----
.ENDIF
LINK_DBG = -debug -pdb:none
.ELSE
! .IF "$(CFG)" == "Optimize"
! OPTIMIZE = -O2 $(RUNTIME) -DNDEBUG
.ELSE
OPTIMIZE = -Od $(RUNTIME) -DNDEBUG
.ENDIF
***************
*** 660,673 ****
"INST_VER=$(INST_VER)" \
"archname=$(ARCHNAME)" \
"cc=$(CC)" \
! "ccflags=$(OPTIMIZE) $(DEFINES) $(OBJECT)" \
"cf_email=$(EMAIL)" \
"d_crypt=$(D_CRYPT)" \
"d_mymalloc=$(PERL_MALLOC)" \
"libs=$(LIBFILES:f)" \
! "incpath=$(CCINCDIR)" \
"libperl=$(PERLIMPLIB:f)" \
! "libpth=$(strip $(CCLIBDIR) $(EXTRALIBDIRS) $(LIBFILES:d))" \
"libc=$(LIBC)" \
"make=dmake" \
"_o=$(o)" "obj_ext=$(o)" \
--- 688,701 ----
"INST_VER=$(INST_VER)" \
"archname=$(ARCHNAME)" \
"cc=$(CC)" \
! "ccflags=$(OPTIMIZE:s/"/\"/) $(DEFINES) $(OBJECT)" \
"cf_email=$(EMAIL)" \
"d_crypt=$(D_CRYPT)" \
"d_mymalloc=$(PERL_MALLOC)" \
"libs=$(LIBFILES:f)" \
! "incpath=$(CCINCDIR:s/"/\"/)" \
"libperl=$(PERLIMPLIB:f)" \
! "libpth=$(CCLIBDIR:s/"/\"/);$(EXTRALIBDIRS:s/"/\"/)" \
"libc=$(LIBC)" \
"make=dmake" \
"_o=$(o)" "obj_ext=$(o)" \
***************
*** 676,683 ****
"dynamic_ext=$(DYNAMIC_EXT)" \
"nonxs_ext=$(NONXS_EXT)" \
"usethreads=$(USE_THREADS)" \
! "LINK_FLAGS=$(LINK_FLAGS)" \
! "optimize=$(OPTIMIZE)"
#
# Top targets
--- 704,712 ----
"dynamic_ext=$(DYNAMIC_EXT)" \
"nonxs_ext=$(NONXS_EXT)" \
"usethreads=$(USE_THREADS)" \
! "usemultiplicity=$(USE_MULTI)" \
! "LINK_FLAGS=$(LINK_FLAGS:s/"/\"/)" \
! "optimize=$(OPTIMIZE:s/"/\"/)"
#
# Top targets
***************
*** 692,700 ****
$(GLOBEXE) : perlglob$(o)
.IF "$(CCTYPE)" == "BORLAND"
! $(CC) -c -w -v -tWM -I$(CCINCDIR) perlglob.c
$(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \
! $(CCLIBDIR)\32BIT\wildargs$(o),$@,,import32.lib cw32mt.lib,
.ELIF "$(CCTYPE)" == "GCC"
$(LINK32) $(LINK_FLAGS) -o $@ perlglob$(o) $(LIBFILES)
.ELSE
--- 721,729 ----
$(GLOBEXE) : perlglob$(o)
.IF "$(CCTYPE)" == "BORLAND"
! $(CC) -c -w -v -tWM -I"$(CCINCDIR)" perlglob.c
$(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \
! "$(CCLIBDIR)\32BIT\wildargs$(o)",$@,,import32.lib cw32mt.lib,
.ELIF "$(CCTYPE)" == "GCC"
$(LINK32) $(LINK_FLAGS) -o $@ perlglob$(o) $(LIBFILES)
.ELSE
***************
*** 722,728 ****
-cd .. && del /f perl.exe
cd .. && perl configpm
-del /f $(CFGH_TMPL)
! -mkdir ..\lib\CORE
-perl -I..\lib config_h.PL "INST_VER=$(INST_VER)"
rename config.h $(CFGH_TMPL)
--- 751,757 ----
-cd .. && del /f perl.exe
cd .. && perl configpm
-del /f $(CFGH_TMPL)
! -mkdir $(COREDIR)
-perl -I..\lib config_h.PL "INST_VER=$(INST_VER)"
rename config.h $(CFGH_TMPL)
***************
*** 1008,1014 ****
-rmdir /s /q $(LIBDIR)\Data || rmdir /s $(LIBDIR)\Data
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
! -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc pstruct *.bat
-cd ..\x2p && del /f find2perl s2p *.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-del /f $(CONFIGPM)
--- 1037,1044 ----
-rmdir /s /q $(LIBDIR)\Data || rmdir /s $(LIBDIR)\Data
-del /f $(PODDIR)\*.html
-del /f $(PODDIR)\*.bat
! -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc \
! pstruct *.bat
-cd ..\x2p && del /f find2perl s2p *.bat
-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
-del /f $(CONFIGPM)
***************
*** 1016,1022 ****
-del /f perl95.c
.ENDIF
-del /f bin\*.bat
! -cd $(EXTDIR) && del /s *$(a) *.def *.map *.bs Makefile *$(o) pm_to_blib
-rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
-rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
--- 1046,1053 ----
-del /f perl95.c
.ENDIF
-del /f bin\*.bat
! -cd $(EXTDIR) && del /s *$(a) *.def *.map *.pdb *.bs Makefile *$(o) \
! pm_to_blib
-rmdir /s /q $(AUTODIR) || rmdir /s $(AUTODIR)
-rmdir /s /q $(COREDIR) || rmdir /s $(COREDIR)
***************
*** 1083,1089 ****
-@erase $(WIN32_OBJ)
-@erase $(DLL_OBJ)
-@erase $(X2P_OBJ)
! -@erase ..\*$(o) ..\*$(a) ..\*.exp *$(o) *$(a) *.exp
-@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
-@erase ..\x2p\*.exe ..\x2p\*.bat
-@erase *.ilk
--- 1114,1120 ----
-@erase $(WIN32_OBJ)
-@erase $(DLL_OBJ)
-@erase $(X2P_OBJ)
! -@erase ..\*$(o) ..\*$(a) ..\*.exp ..\*.res *$(o) *$(a) *.exp *.res
-@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat
-@erase ..\x2p\*.exe ..\x2p\*.bat
-@erase *.ilk
diff -c 'perl5.005_02/win32/perlhost.h' 'perl5.005_03/win32/perlhost.h'
Index: ./win32/perlhost.h
*** ./win32/perlhost.h Thu Jul 23 23:02:53 1998
--- ./win32/perlhost.h Sat Feb 13 12:06:18 1999
***************
*** 88,94 ****
};
virtual int Putenv(const char *envstring, int &err)
{
! return putenv(envstring);
};
virtual char* LibPath(char *pl)
{
--- 88,94 ----
};
virtual int Putenv(const char *envstring, int &err)
{
! return win32_putenv(envstring);
};
virtual char* LibPath(char *pl)
{
diff -c 'perl5.005_02/win32/pod.mak' 'perl5.005_03/win32/pod.mak'
Index: ./win32/pod.mak
*** ./win32/pod.mak Thu Jul 23 23:02:53 1998
--- ./win32/pod.mak Thu Mar 4 18:35:01 1999
***************
*** 22,27 ****
--- 22,28 ----
perlre.pod \
perlrun.pod \
perlfunc.pod \
+ perlopentut.pod \
perlvar.pod \
perlsub.pod \
perlmod.pod \
***************
*** 37,42 ****
--- 38,44 ----
perltie.pod \
perlbot.pod \
perlipc.pod \
+ perlthrtut.pod \
perldebug.pod \
perldiag.pod \
perlsec.pod \
***************
*** 73,78 ****
--- 75,81 ----
perlre.man \
perlrun.man \
perlfunc.man \
+ perlopentut.man \
perlvar.man \
perlsub.man \
perlmod.man \
***************
*** 81,86 ****
--- 84,90 ----
perlform.man \
perllocale.man \
perlref.man \
+ perlreftut.man \
perldsc.man \
perllol.man \
perltoot.man \
***************
*** 88,93 ****
--- 92,98 ----
perltie.man \
perlbot.man \
perlipc.man \
+ perlthrtut.man \
perldebug.man \
perldiag.man \
perlsec.man \
***************
*** 124,129 ****
--- 129,135 ----
perlre.html \
perlrun.html \
perlfunc.html \
+ perlopentut.html \
perlvar.html \
perlsub.html \
perlmod.html \
***************
*** 132,137 ****
--- 138,144 ----
perlform.html \
perllocale.html \
perlref.html \
+ perlreftut.html \
perldsc.html \
perllol.html \
perltoot.html \
***************
*** 139,144 ****
--- 146,152 ----
perltie.html \
perlbot.html \
perlipc.html \
+ perlthrtut.html \
perldebug.html \
perldiag.html \
perlsec.html \
***************
*** 175,180 ****
--- 183,189 ----
perlre.tex \
perlrun.tex \
perlfunc.tex \
+ perlopentut.tex \
perlvar.tex \
perlsub.tex \
perlmod.tex \
***************
*** 183,188 ****
--- 192,198 ----
perlform.tex \
perllocale.tex \
perlref.tex \
+ perlreftut.tex \
perldsc.tex \
perllol.tex \
perltoot.tex \
***************
*** 190,195 ****
--- 200,206 ----
perltie.tex \
perlbot.tex \
perlipc.tex \
+ perlthrtut.tex \
perldebug.tex \
perldiag.tex \
perlsec.tex \
diff -c 'perl5.005_02/win32/runperl.c' 'perl5.005_03/win32/runperl.c'
Index: ./win32/runperl.c
*** ./win32/runperl.c Thu Jul 23 23:02:53 1998
--- ./win32/runperl.c Thu Jan 21 18:40:11 1999
***************
*** 1,9 ****
-
- #ifdef PERL_OBJECT
- #define USE_SOCKETS_AS_HANDLES
#include "EXTERN.h"
#include "perl.h"
#define NO_XSLOCKS
#include "XSUB.H"
#include "win32iop.h"
--- 1,8 ----
#include "EXTERN.h"
#include "perl.h"
+ #ifdef PERL_OBJECT
+
#define NO_XSLOCKS
#include "XSUB.H"
#include "win32iop.h"
***************
*** 37,44 ****
{
CPerlHost host;
int exitstatus = 1;
! if(!host.PerlCreate())
exit(exitstatus);
exitstatus = host.PerlParse(xs_init, argc, argv, NULL);
--- 36,52 ----
{
CPerlHost host;
int exitstatus = 1;
+ #ifndef __BORLANDC__
+ /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
+ * want to free() argv after main() returns. As luck would have it,
+ * Borland's CRT does the right thing to argv[0] already. */
+ char szModuleName[MAX_PATH];
! GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
! argv[0] = szModuleName;
! #endif
!
! if (!host.PerlCreate())
exit(exitstatus);
exitstatus = host.PerlParse(xs_init, argc, argv, NULL);
***************
*** 74,79 ****
--- 82,95 ----
int
main(int argc, char **argv, char **env)
{
+ #ifndef __BORLANDC__
+ /* XXX this _may_ be a problem on some compilers (e.g. Borland) that
+ * want to free() argv after main() returns. As luck would have it,
+ * Borland's CRT does the right thing to argv[0] already. */
+ char szModuleName[MAX_PATH];
+ GetModuleFileName(NULL, szModuleName, sizeof(szModuleName));
+ argv[0] = szModuleName;
+ #endif
return RunPerl(argc, argv, env, (void*)0);
}
diff -c 'perl5.005_02/win32/win32.c' 'perl5.005_03/win32/win32.c'
Index: ./win32/win32.c
*** ./win32/win32.c Tue Aug 4 17:36:51 1998
--- ./win32/win32.c Sat Feb 13 12:06:23 1999
***************
*** 38,43 ****
--- 38,45 ----
#include "EXTERN.h"
#include "perl.h"
+ #include "patchlevel.h"
+
#define NO_XSLOCKS
#ifdef PERL_OBJECT
extern CPerlObj* pPerl;
***************
*** 91,97 ****
static void get_shell(void);
static long tokenize(char *str, char **dest, char ***destv);
int do_spawn2(char *cmd, int exectype);
! static BOOL has_redirection(char *ptr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
static char * get_emd_part(char *leading, char *trailing, ...);
--- 93,99 ----
static void get_shell(void);
static long tokenize(char *str, char **dest, char ***destv);
int do_spawn2(char *cmd, int exectype);
! static BOOL has_shell_metachars(char *ptr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
static char * get_emd_part(char *leading, char *trailing, ...);
***************
*** 145,151 ****
if (retval == ERROR_SUCCESS){
retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
if (retval == ERROR_SUCCESS && type == REG_SZ) {
! if (*ptr != NULL) {
Renew(*ptr, *lpDataLen, char);
}
else {
--- 147,153 ----
if (retval == ERROR_SUCCESS){
retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
if (retval == ERROR_SUCCESS && type == REG_SZ) {
! if (*ptr) {
Renew(*ptr, *lpDataLen, char);
}
else {
***************
*** 154,160 ****
retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
if (retval != ERROR_SUCCESS) {
Safefree(*ptr);
! *ptr = NULL;
}
}
RegCloseKey(handle);
--- 156,162 ----
retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
if (retval != ERROR_SUCCESS) {
Safefree(*ptr);
! *ptr = Nullch;
}
}
RegCloseKey(handle);
***************
*** 166,172 ****
GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
{
*ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
! if (*ptr == NULL)
{
*ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
}
--- 168,174 ----
GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
{
*ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
! if (*ptr == Nullch)
{
*ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
}
***************
*** 176,181 ****
--- 178,184 ----
static char *
get_emd_part(char *prev_path, char *trailing_path, ...)
{
+ char base[10];
va_list ap;
char mod_name[MAX_PATH+1];
char *ptr;
***************
*** 186,194 ****
va_start(ap, trailing_path);
strip = va_arg(ap, char *);
! GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE)
! ? GetModuleHandle(NULL)
! : w32_perldll_handle, mod_name, sizeof(mod_name));
ptr = strrchr(mod_name, '\\');
while (ptr && strip) {
/* look for directories to skip back */
--- 189,199 ----
va_start(ap, trailing_path);
strip = va_arg(ap, char *);
! sprintf(base, "%5.3f", (double) 5 + ((double) PATCHLEVEL / (double) 1000));
!
! GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE)
! ? GetModuleHandle(NULL) : w32_perldll_handle),
! mod_name, sizeof(mod_name));
ptr = strrchr(mod_name, '\\');
while (ptr && strip) {
/* look for directories to skip back */
***************
*** 196,203 ****
*ptr = '\0';
ptr = strrchr(mod_name, '\\');
if (!ptr || stricmp(ptr+1, strip) != 0) {
! *optr = '\\';
! ptr = optr;
}
strip = va_arg(ap, char *);
}
--- 201,211 ----
*ptr = '\0';
ptr = strrchr(mod_name, '\\');
if (!ptr || stricmp(ptr+1, strip) != 0) {
! if(!(*strip == '5' && *(ptr+1) == '5' && strncmp(strip, base, 5) == 0
! && strncmp(ptr+1, base, 5) == 0)) {
! *optr = '\\';
! ptr = optr;
! }
}
strip = va_arg(ap, char *);
}
***************
*** 209,225 ****
va_end(ap);
strcpy(++ptr, trailing_path);
! newsize = strlen(mod_name) + 1;
! if (prev_path) {
! oldsize = strlen(prev_path) + 1;
! newsize += oldsize; /* includes plus 1 for ';' */
! Renew(prev_path, newsize, char);
! prev_path[oldsize-1] = ';';
! strcpy(&prev_path[oldsize], mod_name);
! }
! else {
! New(1311, prev_path, newsize, char);
! strcpy(prev_path, mod_name);
}
return prev_path;
--- 217,237 ----
va_end(ap);
strcpy(++ptr, trailing_path);
! /* only add directory if it exists */
! if(GetFileAttributes(mod_name) != (DWORD) -1) {
! /* directory exists */
! newsize = strlen(mod_name) + 1;
! if (prev_path) {
! oldsize = strlen(prev_path) + 1;
! newsize += oldsize; /* includes plus 1 for ';' */
! Renew(prev_path, newsize, char);
! prev_path[oldsize-1] = ';';
! strcpy(&prev_path[oldsize], mod_name);
! }
! else {
! New(1311, prev_path, newsize, char);
! strcpy(prev_path, mod_name);
! }
}
return prev_path;
***************
*** 236,242 ****
/* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
sprintf(buffer, "%s-%s", stdlib, pl);
path = GetRegStr(buffer, &path, &datalen);
! if (path == NULL)
path = GetRegStr(stdlib, &path, &datalen);
/* $stdlib .= ";$EMD/../../lib" */
--- 248,254 ----
/* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
sprintf(buffer, "%s-%s", stdlib, pl);
path = GetRegStr(buffer, &path, &datalen);
! if (!path)
path = GetRegStr(stdlib, &path, &datalen);
/* $stdlib .= ";$EMD/../../lib" */
***************
*** 289,305 ****
static BOOL
! has_redirection(char *ptr)
{
int inquote = 0;
char quote = '\0';
/*
* Scan string looking for redirection (< or >) or pipe
! * characters (|) that are not in a quoted string
*/
while (*ptr) {
switch(*ptr) {
case '\'':
case '\"':
if (inquote) {
--- 301,320 ----
static BOOL
! has_shell_metachars(char *ptr)
{
int inquote = 0;
char quote = '\0';
/*
* Scan string looking for redirection (< or >) or pipe
! * characters (|) that are not in a quoted string.
! * Shell variable interpolation (%VAR%) can also happen inside strings.
*/
while (*ptr) {
switch(*ptr) {
+ case '%':
+ return TRUE;
case '\'':
case '\"':
if (inquote) {
***************
*** 457,462 ****
--- 472,478 ----
int status;
int flag = P_WAIT;
int index = 0;
+ STRLEN n_a;
if (sp <= mark)
return -1;
***************
*** 470,476 ****
}
while (++mark <= sp) {
! if (*mark && (str = SvPV(*mark, PL_na)))
argv[index++] = str;
else
argv[index++] = "";
--- 486,492 ----
}
while (++mark <= sp) {
! if (*mark && (str = SvPV(*mark, n_a)))
argv[index++] = str;
else
argv[index++] = "";
***************
*** 478,487 ****
argv[index++] = 0;
status = win32_spawnvp(flag,
! (const char*)(really ? SvPV(really,PL_na) : argv[0]),
(const char* const*)argv);
! if (status < 0 && errno == ENOEXEC) {
/* possible shell-builtin, invoke with shell */
int sh_items;
sh_items = w32_perlshell_items;
--- 494,503 ----
argv[index++] = 0;
status = win32_spawnvp(flag,
! (const char*)(really ? SvPV(really,n_a) : argv[0]),
(const char* const*)argv);
! if (status < 0 && (errno == ENOEXEC || errno == ENOENT)) {
/* possible shell-builtin, invoke with shell */
int sh_items;
sh_items = w32_perlshell_items;
***************
*** 491,497 ****
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
! (const char*)(really ? SvPV(really,PL_na) : argv[0]),
(const char* const*)argv);
}
--- 507,513 ----
argv[sh_items] = w32_perlshell_vec[sh_items];
status = win32_spawnvp(flag,
! (const char*)(really ? SvPV(really,n_a) : argv[0]),
(const char* const*)argv);
}
***************
*** 521,527 ****
/* Save an extra exec if possible. See if there are shell
* metacharacters in it */
! if (!has_redirection(cmd)) {
New(1301,argv, strlen(cmd) / 2 + 2, char*);
New(1302,cmd2, strlen(cmd) + 1, char);
strcpy(cmd2, cmd);
--- 537,543 ----
/* Save an extra exec if possible. See if there are shell
* metacharacters in it */
! if (!has_shell_metachars(cmd)) {
New(1301,argv, strlen(cmd) / 2 + 2, char*);
New(1302,cmd2, strlen(cmd) + 1, char);
strcpy(cmd2, cmd);
***************
*** 636,647 ****
return NULL;
/* check to see if filename is a directory */
! if (win32_stat(filename, &sbuf) < 0 || (sbuf.st_mode & S_IFDIR) == 0) {
! /* CRT is buggy on sharenames, so make sure it really isn't */
! DWORD r = GetFileAttributes(filename);
! if (r == 0xffffffff || !(r & FILE_ATTRIBUTE_DIRECTORY))
! return NULL;
! }
/* Get us a DIR structure */
Newz(1303, p, 1, DIR);
--- 652,659 ----
return NULL;
/* check to see if filename is a directory */
! if (win32_stat(filename, &sbuf) < 0 || !S_ISDIR(sbuf.st_mode))
! return NULL;
/* Get us a DIR structure */
Newz(1303, p, 1, DIR);
***************
*** 658,663 ****
--- 670,679 ----
/* do the FindFirstFile call */
fh = FindFirstFile(scanname, &FindData);
if (fh == INVALID_HANDLE_VALUE) {
+ /* FindFirstFile() fails on empty drives! */
+ if (GetLastError() == ERROR_FILE_NOT_FOUND)
+ return p;
+ Safefree( p);
return NULL;
}
***************
*** 881,887 ****
DllExport int
win32_stat(const char *path, struct stat *buffer)
{
! char t[MAX_PATH+1];
const char *p = path;
int l = strlen(path);
int res;
--- 897,903 ----
DllExport int
win32_stat(const char *path, struct stat *buffer)
{
! char t[MAX_PATH+1];
const char *p = path;
int l = strlen(path);
int res;
***************
*** 898,905 ****
}
}
res = stat(p,buffer);
#ifdef __BORLANDC__
- if (res == 0) {
if (S_ISDIR(buffer->st_mode))
buffer->st_mode |= S_IWRITE | S_IEXEC;
else if (S_ISREG(buffer->st_mode)) {
--- 914,944 ----
}
}
res = stat(p,buffer);
+ if (res < 0) {
+ /* CRT is buggy on sharenames, so make sure it really isn't.
+ * XXX using GetFileAttributesEx() will enable us to set
+ * buffer->st_*time (but note that's not available on the
+ * Windows of 1995) */
+ DWORD r = GetFileAttributes(p);
+ if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) {
+ buffer->st_mode |= S_IFDIR | S_IREAD;
+ errno = 0;
+ if (!(r & FILE_ATTRIBUTE_READONLY))
+ buffer->st_mode |= S_IWRITE | S_IEXEC;
+ return 0;
+ }
+ }
+ else {
+ if (l == 3 && path[l-2] == ':'
+ && (path[l-1] == '\\' || path[l-1] == '/'))
+ {
+ /* The drive can be inaccessible, some _stat()s are buggy */
+ if (!GetVolumeInformation(path,NULL,0,NULL,NULL,NULL,NULL,0)) {
+ errno = ENOENT;
+ return -1;
+ }
+ }
#ifdef __BORLANDC__
if (S_ISDIR(buffer->st_mode))
buffer->st_mode |= S_IWRITE | S_IEXEC;
else if (S_ISREG(buffer->st_mode)) {
***************
*** 916,923 ****
else
buffer->st_mode &= ~S_IEXEC;
}
- }
#endif
return res;
}
--- 955,962 ----
else
buffer->st_mode &= ~S_IEXEC;
}
#endif
+ }
return res;
}
***************
*** 926,936 ****
DllExport char *
win32_getenv(const char *name)
{
! static char *curitem = Nullch;
! static DWORD curlen = 512;
DWORD needlen;
! if (!curitem)
New(1305,curitem,curlen,char);
needlen = GetEnvironmentVariable(name,curitem,curlen);
if (needlen != 0) {
--- 965,977 ----
DllExport char *
win32_getenv(const char *name)
{
! static char *curitem = Nullch; /* XXX threadead */
! static DWORD curlen = 0; /* XXX threadead */
DWORD needlen;
! if (!curitem) {
! curlen = 512;
New(1305,curitem,curlen,char);
+ }
needlen = GetEnvironmentVariable(name,curitem,curlen);
if (needlen != 0) {
***************
*** 940,967 ****
needlen = GetEnvironmentVariable(name,curitem,curlen);
}
}
! else
! {
/* allow any environment variables that begin with 'PERL'
! to be stored in the registry
! */
! if(curitem != NULL)
*curitem = '\0';
if (strncmp(name, "PERL", 4) == 0) {
! if (curitem != NULL) {
Safefree(curitem);
! curitem = NULL;
}
curitem = GetRegStr(name, &curitem, &curlen);
}
}
! if(curitem != NULL && *curitem == '\0')
return Nullch;
return curitem;
}
#endif
static long
--- 981,1041 ----
needlen = GetEnvironmentVariable(name,curitem,curlen);
}
}
! else {
/* allow any environment variables that begin with 'PERL'
! to be stored in the registry */
! if (curitem)
*curitem = '\0';
if (strncmp(name, "PERL", 4) == 0) {
! if (curitem) {
Safefree(curitem);
! curitem = Nullch;
! curlen = 0;
}
curitem = GetRegStr(name, &curitem, &curlen);
}
}
! if (curitem && *curitem == '\0')
return Nullch;
return curitem;
}
+ DllExport int
+ win32_putenv(const char *name)
+ {
+ char* curitem;
+ char* val;
+ int relval = -1;
+ if(name) {
+ New(1309,curitem,strlen(name)+1,char);
+ strcpy(curitem, name);
+ val = strchr(curitem, '=');
+ if(val) {
+ /* The sane way to deal with the environment.
+ * Has these advantages over putenv() & co.:
+ * * enables us to store a truly empty value in the
+ * environment (like in UNIX).
+ * * we don't have to deal with RTL globals, bugs and leaks.
+ * * Much faster.
+ * Why you may want to enable USE_WIN32_RTL_ENV:
+ * * environ[] and RTL functions will not reflect changes,
+ * which might be an issue if extensions want to access
+ * the env. via RTL. This cuts both ways, since RTL will
+ * not see changes made by extensions that call the Win32
+ * functions directly, either.
+ * GSAR 97-06-07
+ */
+ *val++ = '\0';
+ if(SetEnvironmentVariable(curitem, *val ? val : NULL))
+ relval = 0;
+ }
+ Safefree(curitem);
+ }
+ return relval;
+ }
+
#endif
static long
***************
*** 1068,1077 ****
return win32_wait(status);
else {
rc = cwait(status, pid, WAIT_CHILD);
! /* cwait() returns differently on Borland */
! #ifdef __BORLANDC__
if (status)
! *status = (((*status >> 8) & 0xff) | ((*status << 8) & 0xff00));
#endif
remove_dead_process((HANDLE)pid);
}
--- 1142,1151 ----
return win32_wait(status);
else {
rc = cwait(status, pid, WAIT_CHILD);
! /* cwait() returns "correctly" on Borland */
! #ifndef __BORLANDC__
if (status)
! *status *= 256;
#endif
remove_dead_process((HANDLE)pid);
}
***************
*** 1724,1735 ****
/* wait for the child */
if (cwait(&status, childpid, WAIT_CHILD) == -1)
return (-1);
! /* cwait() returns differently on Borland */
! #ifdef __BORLANDC__
! return (((status >> 8) & 0xff) | ((status << 8) & 0xff00));
! #else
! return (status);
#endif
#endif /* USE_RTL_POPEN */
}
--- 1798,1808 ----
/* wait for the child */
if (cwait(&status, childpid, WAIT_CHILD) == -1)
return (-1);
! /* cwait() returns "correctly" on Borland */
! #ifndef __BORLANDC__
! status *= 256;
#endif
+ return (status);
#endif /* USE_RTL_POPEN */
}
***************
*** 1737,1787 ****
DllExport int
win32_rename(const char *oname, const char *newname)
{
! char szNewWorkName[MAX_PATH+1];
! WIN32_FIND_DATA fdOldFile, fdNewFile;
! HANDLE handle;
! char *ptr;
!
! if ((strchr(oname, '\\') || strchr(oname, '/'))
! && strchr(newname, '\\') == NULL
! && strchr(newname, '/') == NULL)
! {
! strcpy(szNewWorkName, oname);
! if ((ptr = strrchr(szNewWorkName, '\\')) == NULL)
! ptr = strrchr(szNewWorkName, '/');
! strcpy(++ptr, newname);
}
! else
! strcpy(szNewWorkName, newname);
!
! if (stricmp(oname, szNewWorkName) != 0) {
! // check that we're not being fooled by relative paths
! // and only delete the new file
! // 1) if it exists
! // 2) it is not the same file as the old file
! // 3) old file exist
! // GetFullPathName does not return the long file name on some systems
! handle = FindFirstFile(oname, &fdOldFile);
! if (handle != INVALID_HANDLE_VALUE) {
! FindClose(handle);
!
! handle = FindFirstFile(szNewWorkName, &fdNewFile);
!
! if (handle != INVALID_HANDLE_VALUE)
! FindClose(handle);
else
! fdNewFile.cFileName[0] = '\0';
! if (strcmp(fdOldFile.cAlternateFileName,
! fdNewFile.cAlternateFileName) != 0
! && strcmp(fdOldFile.cFileName, fdNewFile.cFileName) != 0)
! {
! // file exists and not same file
! DeleteFile(szNewWorkName);
}
}
}
- return rename(oname, newname);
}
DllExport int
--- 1810,1911 ----
DllExport int
win32_rename(const char *oname, const char *newname)
{
! /* XXX despite what the documentation says about MoveFileEx(),
! * it doesn't work under Windows95!
! */
! if (IsWinNT()) {
! if (!MoveFileEx(oname,newname,
! MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING)) {
! DWORD err = GetLastError();
! switch (err) {
! case ERROR_BAD_NET_NAME:
! case ERROR_BAD_NETPATH:
! case ERROR_BAD_PATHNAME:
! case ERROR_FILE_NOT_FOUND:
! case ERROR_FILENAME_EXCED_RANGE:
! case ERROR_INVALID_DRIVE:
! case ERROR_NO_MORE_FILES:
! case ERROR_PATH_NOT_FOUND:
! errno = ENOENT;
! break;
! default:
! errno = EACCES;
! break;
! }
! return -1;
! }
! return 0;
}
! else {
! int retval = 0;
! char tmpname[MAX_PATH+1];
! char dname[MAX_PATH+1];
! char *endname = Nullch;
! STRLEN tmplen = 0;
! DWORD from_attr, to_attr;
!
! /* if oname doesn't exist, do nothing */
! from_attr = GetFileAttributes(oname);
! if (from_attr == 0xFFFFFFFF) {
! errno = ENOENT;
! return -1;
! }
!
! /* if newname exists, rename it to a temporary name so that we
! * don't delete it in case oname happens to be the same file
! * (but perhaps accessed via a different path)
! */
! to_attr = GetFileAttributes(newname);
! if (to_attr != 0xFFFFFFFF) {
! /* if newname is a directory, we fail
! * XXX could overcome this with yet more convoluted logic */
! if (to_attr & FILE_ATTRIBUTE_DIRECTORY) {
! errno = EACCES;
! return -1;
! }
! tmplen = strlen(newname);
! strcpy(tmpname,newname);
! endname = tmpname+tmplen;
! for (; endname > tmpname ; --endname) {
! if (*endname == '/' || *endname == '\\') {
! *endname = '\0';
! break;
! }
! }
! if (endname > tmpname)
! endname = strcpy(dname,tmpname);
else
! endname = ".";
! /* get a temporary filename in same directory
! * XXX is this really the best we can do? */
! if (!GetTempFileName((LPCTSTR)endname, "plr", 0, tmpname)) {
! errno = ENOENT;
! return -1;
}
+ DeleteFile(tmpname);
+
+ retval = rename(newname, tmpname);
+ if (retval != 0) {
+ errno = EACCES;
+ return retval;
+ }
+ }
+
+ /* rename oname to newname */
+ retval = rename(oname, newname);
+
+ /* if we created a temporary file before ... */
+ if (endname != Nullch) {
+ /* ...and rename succeeded, delete temporary file/directory */
+ if (retval == 0)
+ DeleteFile(tmpname);
+ /* else restore it to what it was */
+ else
+ (void)rename(tmpname, newname);
}
+ return retval;
}
}
DllExport int
***************
*** 2123,2131 ****
XS(w32_SetCwd)
{
dXSARGS;
if (items != 1)
croak("usage: Win32::SetCurrentDirectory($cwd)");
! if (SetCurrentDirectory(SvPV(ST(0),PL_na)))
XSRETURN_YES;
XSRETURN_NO;
--- 2247,2256 ----
XS(w32_SetCwd)
{
dXSARGS;
+ STRLEN n_a;
if (items != 1)
croak("usage: Win32::SetCurrentDirectory($cwd)");
! if (SetCurrentDirectory(SvPV(ST(0),n_a)))
XSRETURN_YES;
XSRETURN_NO;
***************
*** 2304,2315 ****
PROCESS_INFORMATION stProcInfo;
STARTUPINFO stStartInfo;
BOOL bSuccess = FALSE;
if (items != 3)
croak("usage: Win32::Spawn($cmdName, $args, $PID)");
! cmd = SvPV(ST(0),PL_na);
! args = SvPV(ST(1), PL_na);
memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
--- 2429,2441 ----
PROCESS_INFORMATION stProcInfo;
STARTUPINFO stStartInfo;
BOOL bSuccess = FALSE;
+ STRLEN n_a;
if (items != 3)
croak("usage: Win32::Spawn($cmdName, $args, $PID)");
! cmd = SvPV(ST(0),n_a);
! args = SvPV(ST(1), n_a);
memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
diff -c 'perl5.005_02/win32/win32.h' 'perl5.005_03/win32/win32.h'
Index: ./win32/win32.h
*** ./win32/win32.h Thu Jul 23 23:02:54 1998
--- ./win32/win32.h Sun Jan 24 08:48:27 1999
***************
*** 27,33 ****
--- 27,35 ----
/* GCC does not do __declspec() - render it a nop
* and turn on options to avoid importing data
*/
+ #ifndef __declspec
# define __declspec(x)
+ #endif
# ifndef PERL_OBJECT
# define PERL_GLOBAL_STRUCT
# define MULTIPLICITY
***************
*** 100,105 ****
--- 102,112 ----
* real filehandles. XXX Should always be defined (the other version is untested) */
#define USE_SOCKETS_AS_HANDLES
+ /* read() and write() aren't transparent for socket handles */
+ #define PERL_SOCK_SYSREAD_IS_RECV
+ #define PERL_SOCK_SYSWRITE_IS_SEND
+
+
/* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
* to read the environment, bypassing the runtime's (usually broken)
* facilities for accessing the same. See note in util.c/my_setenv(). */
***************
*** 213,219 ****
--- 220,228 ----
typedef long uid_t;
typedef long gid_t;
+ #ifndef _environ
#define _environ environ
+ #endif
#define flushall _flushall
#define fcloseall _fcloseall
diff -c 'perl5.005_02/win32/win32iop.h' 'perl5.005_03/win32/win32iop.h'
Index: ./win32/win32iop.h
*** ./win32/win32iop.h Thu Jul 23 23:02:54 1998
--- ./win32/win32iop.h Sat Feb 13 12:06:24 1999
***************
*** 115,120 ****
--- 115,121 ----
#ifndef USE_WIN32_RTL_ENV
DllExport char* win32_getenv(const char *name);
+ DllExport int win32_putenv(const char *name);
#endif
DllExport unsigned win32_sleep(unsigned int);
***************
*** 279,284 ****
--- 280,287 ----
#ifndef USE_WIN32_RTL_ENV
#undef getenv
#define getenv win32_getenv
+ #undef putenv
+ #define putenv win32_putenv
#endif
#endif /* WIN32IO_IS_STDIO */
diff -c 'perl5.005_02/win32/win32sck.c' 'perl5.005_03/win32/win32sck.c'
Index: ./win32/win32sck.c
*** ./win32/win32sck.c Thu Jul 23 23:02:55 1998
--- ./win32/win32sck.c Sun Nov 29 14:10:24 1998
***************
*** 287,294 ****
--- 287,301 ----
win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int *fromlen)
{
int r;
+ int frombufsize = *fromlen;
SOCKET_TEST_ERROR(r = recvfrom(TO_SOCKET(s), buf, len, flags, from, fromlen));
+ /* Winsock's recvfrom() only returns a valid 'from' when the socket
+ * is connectionless. Perl expects a valid 'from' for all types
+ * of sockets, so go the extra mile.
+ */
+ if (r != SOCKET_ERROR && frombufsize == *fromlen)
+ (void)win32_getpeername(s, from, fromlen);
return r;
}
diff -c 'perl5.005_02/win32/win32thread.c' 'perl5.005_03/win32/win32thread.c'
Index: ./win32/win32thread.c
*** ./win32/win32thread.c Sun Aug 2 01:08:11 1998
--- ./win32/win32thread.c Wed Dec 30 10:14:52 1998
***************
*** 92,98 ****
DWORD junk;
unsigned long th;
- MUTEX_LOCK(&thr->mutex);
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: create OS thread\n", thr));
#ifdef USE_RTL_THREAD_API
--- 92,97 ----
***************
*** 126,132 ****
#endif /* !USE_RTL_THREAD_API */
DEBUG_S(PerlIO_printf(PerlIO_stderr(),
"%p: OS thread = %p, id=%ld\n", thr, thr->self, junk));
- MUTEX_UNLOCK(&thr->mutex);
return thr->self ? 0 : -1;
}
#endif
--- 125,130 ----
diff -c 'perl5.005_02/x2p/Makefile.SH' 'perl5.005_03/x2p/Makefile.SH'
Index: ./x2p/Makefile.SH
*** ./x2p/Makefile.SH Thu Jul 23 23:02:55 1998
--- ./x2p/Makefile.SH Wed Nov 4 21:37:35 1998
***************
*** 36,43 ****
LDFLAGS = $ldflags
SMALL = $small
LARGE = $large $split
! mallocsrc = $mallocsrc
! mallocobj = $mallocobj
shellflags = $shellflags
libs = $libs
--- 36,45 ----
LDFLAGS = $ldflags
SMALL = $small
LARGE = $large $split
! # XXX Perl malloc temporarily unusable (declaration collisions with
! # stdlib.h)
! #mallocsrc = $mallocsrc
! #mallocobj = $mallocobj
shellflags = $shellflags
libs = $libs
diff -c 'perl5.005_02/x2p/s2p.PL' 'perl5.005_03/x2p/s2p.PL'
Index: ./x2p/s2p.PL
*** ./x2p/s2p.PL Thu Jul 23 23:02:59 1998
--- ./x2p/s2p.PL Thu Mar 4 18:35:12 1999
***************
*** 671,677 ****
}
if (/^H/) {
! $_ = '$hold .= "\n"; $hold .= $_;';
next;
}
--- 671,677 ----
}
if (/^H/) {
! $_ = '$hold .= "\n", $hold .= $_;';
next;
}
***************
*** 681,687 ****
}
if (/^G/) {
! $_ = '$_ .= "\n"; $_ .= $hold;';
next;
}
--- 681,687 ----
}
if (/^G/) {
! $_ = '$_ .= "\n", $_ .= $hold;';
next;
}
diff -c 'perl5.005_02/x2p/walk.c' 'perl5.005_03/x2p/walk.c'
Index: ./x2p/walk.c
*** ./x2p/walk.c Thu Jul 23 23:03:01 1998
--- ./x2p/walk.c Sat Oct 31 17:41:29 1998
***************
*** 133,139 ****
if (saw_FS && !const_FS)
do_chop = TRUE;
if (do_chop) {
! str_cat(str,"chop;\t# strip record separator\n");
tab(str,level);
}
if (do_split)
--- 133,139 ----
if (saw_FS && !const_FS)
do_chop = TRUE;
if (do_chop) {
! str_cat(str,"chomp;\t# strip record separator\n");
tab(str,level);
}
if (do_split)
***************
*** 190,196 ****
i = 0;
if (do_chop) {
i++;
! str_cat(str,"chop;\t# strip record separator\n");
tab(str,level);
}
if (do_split && !(len & 1)) {
--- 190,196 ----
i = 0;
if (do_chop) {
i++;
! str_cat(str,"chomp;\t# strip record separator\n");
tab(str,level);
}
if (do_split && !(len & 1)) {
#### End of Patch data ####
#### ApplyPatch data follows ####
# Data version : 1.0
# Date generated : Sun Mar 28 16:53:07 1999
# Generated by : makepatch 1.99 (2.0BETA)
# Recurse directories : Yes
# Excluded files : (none)
# r 'interp.sym' 1988 0
# p 'patchlevel.h' 1643 922637518 0100444
# p 'Changes' 855806 922660416 0100444
# p 'Configure' 263706 922637577 0100555
# p 'Copying' 12487 909325434 0100444
# p 'EXTERN.h' 1492 922557455 0100444
# p 'INSTALL' 61508 922427135 0100444
# p 'INTERN.h' 1192 922557453 0100444
# p 'MANIFEST' 50165 922637579 0100444
# p 'Makefile.SH' 20144 920514925 0100555
# p 'Porting/Glossary' 98821 920514929 0100444
# p 'Porting/patching.pod' 10898 916976262 0100444
# p 'Porting/pumpkin.pod' 48267 920594047 0100444
# p 'README' 4716 922556877 0100444
# c 'README.apollo' 0 921715555 0100444
# p 'README.beos' 2264 917579994 0100444
# c 'README.hpux' 0 920594048 0100444
# c 'README.hurd' 0 921445269 0100444
# c 'README.mint' 0 917572412 0100444
# p 'README.os390' 3140 921445269 0100444
# p 'README.threads' 10787 918777941 0100444
# p 'README.vms' 15489 920514930 0100444
# c 'README.vos' 0 918777942 0100444
# p 'README.win32' 28209 922660602 0100444
# p 'Todo' 1626 920594049 0100444
# p 'Todo-5.005' 2418 920594049 0100444
# p 'XSUB.h' 2958 915037122 0100444
# p 'XSlock.h' 612 922607829 0100444
# c 'apollo/netinet/in.h' 0 921715556 0100444
# p 'av.c' 12570 922557451 0100444
# p 'av.h' 1871 922556848 0100444
# p 'bytecode.h' 5095 920514930 0100444
# p 'cc_runtime.h' 1739 909806112 0100444
# p 'config_h.SH' 66649 920514932 0100555
# p 'configure.com' 65527 909671773 0100444
# p 'cop.h' 10826 922557450 0100444
# p 'cv.h' 3532 922557448 0100444
# p 'deb.c' 2866 922557446 0100444
# p 'djgpp/config.over' 830 916504153 0100444
# p 'djgpp/djgpp.c' 9577 916504153 0100444
# p 'doio.c' 36845 922557444 0100444
# p 'doop.c' 10944 922557439 0100444
# p 'dump.c' 10011 922557437 0100444
# p 'embed.h' 37463 916510417 0100444
# p 'embed.pl' 5778 910230451 0100555
# p 'embedvar.h' 34368 915591761 0100444
# p 'ext/B/B.pm' 14617 912388508 0100444
# p 'ext/B/B.xs' 19699 915080057 0100444
# p 'ext/B/B/Assembler.pm' 5338 912388703 0100444
# p 'ext/B/B/C.pm' 39744 912388769 0100444
# p 'ext/B/B/CC.pm' 47577 912132038 0100444
# p 'ext/B/B/Disassembler.pm' 3419 912388835 0100444
# p 'ext/B/Makefile.PL' 1210 912132719 0100444
# p 'ext/B/README' 14841 909325546 0100444
# p 'ext/DB_File/Changes' 4921 921715556 0100444
# p 'ext/DB_File/DB_File.pm' 46573 921715558 0100444
# p 'ext/DB_File/DB_File.xs' 32482 921715559 0100444
# p 'ext/DB_File/Makefile.PL' 488 912132729 0100444
# p 'ext/DB_File/dbinfo' 2128 916622664 0100444
# c 'ext/DB_File/hints/dynixptx.pl' 0 912093774 0100444
# p 'ext/DB_File/typemap' 786 921715560 0100444
# p 'ext/Data/Dumper/Changes' 4260 912138094 0100444
# p 'ext/Data/Dumper/Dumper.pm' 28415 918777947 0100444
# p 'ext/Data/Dumper/Dumper.xs' 19900 912138188 0100444
# p 'ext/Data/Dumper/Makefile.PL' 247 912132738 0100444
# p 'ext/Data/Dumper/Todo' 968 912138195 0100444
# p 'ext/DynaLoader/DynaLoader_pm.PL' 24249 909890396 0100444
# p 'ext/DynaLoader/Makefile.PL' 852 912132746 0100444
# c 'ext/DynaLoader/dl_beos.xs' 0 920594051 0100444
# p 'ext/DynaLoader/dl_cygwin32.xs' 3589 920594051 0100444
# p 'ext/DynaLoader/dl_mpeix.xs' 3458 912126190 0100444
# p 'ext/DynaLoader/dl_next.xs' 6811 915037689 0100444
# p 'ext/DynaLoader/dl_vms.xs' 12950 912135177 0100444
# p 'ext/Errno/Errno_pm.PL' 6295 920594526 0100444
# p 'ext/Errno/Makefile.PL' 728 912132753 0100444
# p 'ext/Fcntl/Makefile.PL' 214 912132760 0100444
# p 'ext/GDBM_File/Makefile.PL' 270 912132765 0100444
# c 'ext/GDBM_File/hints/sco.pl' 0 918777947 0100444
# p 'ext/IO/IO.xs' 4945 915079960 0100444
# p 'ext/IO/Makefile.PL' 241 912132771 0100444
# p 'ext/IO/lib/IO/Pipe.pm' 5030 916282553 0100444
# p 'ext/IO/lib/IO/Seekable.pm' 1414 915589107 0100444
# p 'ext/IO/lib/IO/Socket.pm' 16948 915589109 0100444
# p 'ext/IPC/SysV/Makefile.PL' 673 912132779 0100444
# p 'ext/IPC/SysV/Msg.pm' 3848 910544116 0100444
# p 'ext/IPC/SysV/SysV.xs' 9529 919187567 0100444
# p 'ext/NDBM_File/Makefile.PL' 276 912132786 0100444
# p 'ext/ODBM_File/Makefile.PL' 250 912132793 0100444
# p 'ext/Opcode/Makefile.PL' 145 912132799 0100444
# p 'ext/Opcode/Opcode.xs' 11814 915037723 0100444
# p 'ext/Opcode/Safe.pm' 16688 916967035 0100444
# p 'ext/Opcode/ops.pm' 969 916967035 0100444
# p 'ext/POSIX/Makefile.PL' 279 912132805 0100444
# p 'ext/POSIX/POSIX.pm' 18269 917316458 0100444
# p 'ext/POSIX/POSIX.pod' 35684 910474890 0100444
# p 'ext/POSIX/POSIX.xs' 68717 920594054 0100444
# c 'ext/POSIX/hints/dynixptx.pl' 0 912385236 0100444
# c 'ext/POSIX/hints/mint.pl' 0 917572432 0100444
# p 'ext/SDBM_File/Makefile.PL' 970 912132812 0100444
# p 'ext/SDBM_File/sdbm/sdbm.c' 10868 920594054 0100444
# p 'ext/Socket/Makefile.PL' 214 912132817 0100444
# p 'ext/Socket/Socket.pm' 8039 912385261 0100444
# p 'ext/Socket/Socket.xs' 16254 913474494 0100444
# p 'ext/Thread/Makefile.PL' 114 912132824 0100444
# p 'ext/Thread/Thread.xs' 15955 922594889 0100444
# p 'ext/Thread/create.t' 359 909980676 0100444
# p 'ext/attrs/Makefile.PL' 189 912132855 0100444
# p 'ext/attrs/attrs.xs' 1171 915037953 0100444
# p 'ext/re/Makefile.PL' 860 912132864 0100444
# p 'ext/re/re.pm' 3821 916967036 0100444
# p 'form.h' 547 922557429 0100444
# p 'global.sym' 10960 916510417 0100444
# p 'gv.c' 35531 922583815 0100444
# p 'gv.h' 4648 922557424 0100444
# p 'handy.h' 10638 922557422 0100444
# p 'hints/aix.sh' 2830 922642089 0100444
# p 'hints/apollo.sh' 1927 921715560 0100444
# p 'hints/beos.sh' 1311 917579888 0100444
# p 'hints/dec_osf.sh' 9175 922427135 0100444
# p 'hints/dos_djgpp.sh' 976 917189255 0100444
# p 'hints/dynixptx.sh' 886 912094092 0100444
# p 'hints/freebsd.sh' 4459 918777948 0100444
# c 'hints/gnu.sh' 0 918777948 0100444
# p 'hints/hpux.sh' 7863 920514936 0100444
# p 'hints/irix_4.sh' 623 917189259 0100444
# p 'hints/irix_5.sh' 1255 917189259 0100444
# p 'hints/irix_6.sh' 6762 917189261 0100444
# p 'hints/irix_6_0.sh' 1771 917189261 0100444
# p 'hints/irix_6_1.sh' 1770 917189261 0100444
# p 'hints/linux.sh' 7020 918777949 0100444
# c 'hints/mint.sh' 0 917572435 0100444
# p 'hints/mpeix.sh' 2434 917572435 0100444
# p 'hints/netbsd.sh' 1948 921445269 0100444
# p 'hints/next_3.sh' 4615 911673941 0100444
# p 'hints/next_4.sh' 2644 910236159 0100444
# p 'hints/openbsd.sh' 1383 918929151 0100444
# p 'hints/os2.sh' 7469 917189267 0100444
# p 'hints/os390.sh' 1381 913565963 0100444
# p 'hints/sco.sh' 4217 918777949 0100444
# p 'hints/solaris_2.sh' 13780 917189269 0100444
# p 'hints/ultrix_4.sh' 1830 918777949 0100444
# c 'hints/uwin.sh' 0 911869340 0100444
# p 'hv.c' 27976 922557420 0100444
# p 'hv.h' 3806 922557417 0100444
# p 'installman' 7809 911866737 0100555
# p 'installperl' 17695 916504286 0100555
# p 'intrpvar.h' 7557 909976050 0100444
# p 'iperlsys.h' 33831 920594056 0100444
# p 'lib/AutoLoader.pm' 9979 916967035 0100444
# p 'lib/AutoSplit.pm' 14234 914941855 0100444
# p 'lib/Benchmark.pm' 13637 912385332 0100444
# p 'lib/CGI.pm' 186637 918777957 0100444
# p 'lib/CGI/Apache.pm' 2401 915684113 0100444
# p 'lib/CGI/Carp.pm' 9450 917135084 0100444
# p 'lib/CGI/Cookie.pm' 12621 917135084 0100444
# p 'lib/CGI/Fast.pm' 5408 917135084 0100444
# p 'lib/CGI/Push.pm' 10075 917135084 0100444
# p 'lib/CPAN.pm' 126362 922652792 0100444
# p 'lib/CPAN/FirstTime.pm' 12119 922652801 0100444
# p 'lib/CPAN/Nox.pm' 676 922652801 0100444
# p 'lib/Carp.pm' 10060 920594057 0100444
# p 'lib/Cwd.pm' 9896 916967035 0100444
# c 'lib/Dumpvalue.pm' 0 916514210 0100444
# p 'lib/English.pm' 3208 922559927 0100444
# p 'lib/ExtUtils/Command.pm' 3523 915589068 0100444
# p 'lib/ExtUtils/Embed.pm' 12622 915589070 0100444
# p 'lib/ExtUtils/Install.pm' 11896 915589071 0100444
# p 'lib/ExtUtils/Liblist.pm' 25685 915589067 0100444
# p 'lib/ExtUtils/MM_OS2.pm' 1886 909795153 0100444
# p 'lib/ExtUtils/MM_Unix.pm' 100106 920594060 0100444
# p 'lib/ExtUtils/MM_VMS.pm' 73567 913565789 0100444
# p 'lib/ExtUtils/MM_Win32.pm' 21738 909795742 0100444
# p 'lib/ExtUtils/MakeMaker.pm' 58598 918777961 0100444
# p 'lib/ExtUtils/Manifest.pm' 11164 915589074 0100444
# p 'lib/ExtUtils/Mkbootstrap.pm' 3090 909795887 0100444
# p 'lib/ExtUtils/Mksymlists.pm' 9447 915589075 0100444
# p 'lib/ExtUtils/typemap' 6038 912124317 0100444
# p 'lib/ExtUtils/xsubpp' 38078 909796550 0100555
# p 'lib/Fatal.pm' 4197 920594060 0100444
# p 'lib/File/Copy.pm' 10864 915684113 0100444
# p 'lib/File/Find.pm' 5775 909888913 0100444
# p 'lib/File/Path.pm' 6476 909343898 0100444
# p 'lib/File/Spec.pm' 2988 915684113 0100444
# p 'lib/File/Spec/Mac.pm' 4982 915684113 0100444
# p 'lib/FindBin.pm' 4522 916970052 0100444
# p 'lib/Getopt/Long.pm' 40322 917134908 0100444
# p 'lib/Getopt/Std.pm' 4367 920594061 0100444
# p 'lib/IPC/Open3.pm' 8669 908505881 0100444
# p 'lib/Math/BigFloat.pm' 8607 915684113 0100444
# p 'lib/Math/BigInt.pm' 11098 915684113 0100444
# p 'lib/Math/Complex.pm' 40450 912092046 0100444
# p 'lib/Math/Trig.pm' 11337 918777961 0100444
# p 'lib/Net/hostent.pm' 3994 915684113 0100444
# p 'lib/Net/netent.pm' 4466 915684113 0100444
# p 'lib/Pod/Html.pm' 42630 913479248 0100444
# p 'lib/Pod/Text.pm' 13512 920594062 0100444
# p 'lib/SelfLoader.pm' 11707 916967035 0100444
# p 'lib/Symbol.pm' 3753 916967035 0100444
# p 'lib/Term/Complete.pm' 3436 915684113 0100444
# p 'lib/Term/ReadLine.pm' 9993 915684113 0100444
# p 'lib/Test.pm' 6768 922555666 0100444
# p 'lib/Test/Harness.pm' 13367 909806193 0100444
# p 'lib/Text/ParseWords.pm' 6535 915768465 0100444
# p 'lib/Text/Wrap.pm' 2906 915684113 0100444
# p 'lib/Tie/Array.pm' 6522 915684113 0100444
# p 'lib/Tie/Hash.pm' 3967 915684114 0100444
# p 'lib/Tie/SubstrHash.pm' 4503 915292622 0100444
# p 'lib/Time/Local.pm' 4148 917189269 0100444
# p 'lib/Time/gmtime.pm' 2517 915767645 0100444
# p 'lib/Time/localtime.pm' 2348 915767645 0100444
# p 'lib/User/grent.pm' 2878 915767645 0100444
# p 'lib/User/pwent.pm' 2929 915767645 0100444
# p 'lib/constant.pm' 5757 909883395 0100444
# p 'lib/diagnostics.pm' 13964 917129345 0100555
# p 'lib/fields.pm' 4549 915291511 0100444
# p 'lib/overload.pm' 39254 917132040 0100444
# p 'lib/perl5db.pl' 68715 914856936 0100444
# p 'makedepend.SH' 5737 916967423 0100555
# p 'malloc.c' 48431 920514939 0100444
# p 'mg.c' 40554 922559796 0100444
# p 'mg.h' 1202 922557410 0100444
# p 'miniperlmain.c' 1181 917572462 0100444
# c 'mint/Makefile' 0 917572462 0100444
# c 'mint/README' 0 917572462 0100444
# c 'mint/errno.h' 0 917572462 0100444
# c 'mint/pwd.c' 0 917572463 0100444
# c 'mint/stdio.h' 0 917572463 0100444
# c 'mint/sys/time.h' 0 917572465 0100444
# c 'mint/time.h' 0 917572465 0100444
# p 'mpeix/relink' 444 917572465 0100555
# p 'objXSUB.h' 68492 916510417 0100444
# p 'objpp.h' 50328 916510417 0100444
# p 'op.c' 118903 922637583 0100444
# p 'op.h' 9068 922557400 0100444
# p 'opcode.h' 50075 922595478 0100444
# p 'opcode.pl' 17301 922595469 0100555
# p 'os2/Changes' 8009 916967423 0100444
# p 'os2/Makefile.SHs' 7628 916967423 0100444
# p 'os2/OS2/PrfDB/PrfDB.xs' 2791 916967423 0100444
# p 'os2/OS2/REXX/REXX.xs' 11498 915074225 0100444
# p 'os2/os2.c' 39212 916967423 0100444
# p 'os2/os2ish.h' 12962 917572467 0100444
# p 'perl.c' 74158 922556957 0100444
# p 'perl.h' 64758 922607836 0100444
# p 'perl_exp.SH' 2750 910233962 0100555
# p 'perlio.c' 9062 920594069 0100444
# p 'perlvars.h' 7392 915082184 0100444
# p 'perly.c' 96375 919439120 0100444
# p 'perly.y' 15378 922557851 0100444
# p 'perly_c.diff' 11770 916506151 0100444
# p 'pod/Makefile' 4829 922637583 0100444
# p 'pod/buildtoc' 4317 918777965 0100444
# p 'pod/perl.pod' 12193 922637584 0100444
# p 'pod/perl5004delta.pod' 56148 922563652 0100444
# p 'pod/perlcall.pod' 55960 922564060 0100444
# p 'pod/perldata.pod' 24954 914942138 0100444
# p 'pod/perldebug.pod' 54874 922637588 0100444
# p 'pod/perldelta.pod' 31996 922593318 0100444
# p 'pod/perldiag.pod' 111047 922637592 0100444
# p 'pod/perldsc.pod' 24794 922564105 0100444
# p 'pod/perlembed.pod' 33475 922564118 0100444
# p 'pod/perlfaq.pod' 5406 922564210 0100444
# p 'pod/perlfaq1.pod' 13298 922564263 0100444
# p 'pod/perlfaq2.pod' 20409 922564307 0100444
# p 'pod/perlfaq3.pod' 24797 922564371 0100444
# p 'pod/perlfaq4.pod' 43969 922564461 0100444
# p 'pod/perlfaq5.pod' 37455 922564509 0100444
# p 'pod/perlfaq6.pod' 21976 922564532 0100444
# p 'pod/perlfaq7.pod' 27824 922564549 0100444
# p 'pod/perlfaq8.pod' 37123 922564575 0100444
# p 'pod/perlfaq9.pod' 20580 922564591 0100444
# p 'pod/perlform.pod' 13191 911008885 0100444
# p 'pod/perlfunc.pod' 166795 922637599 0100444
# p 'pod/perlguts.pod' 107223 922571923 0100444
# p 'pod/perlhist.pod' 21203 922660199 0100444
# p 'pod/perlipc.pod' 51992 922572072 0100444
# p 'pod/perllocale.pod' 38868 917134091 0100444
# p 'pod/perllol.pod' 8233 922572110 0100444
# p 'pod/perlmod.pod' 15937 922572137 0100444
# p 'pod/perlmodinstall.pod' 11209 922574725 0100444
# p 'pod/perlmodlib.pod' 30408 922573804 0100444
# p 'pod/perlobj.pod' 20101 922574733 0100444
# p 'pod/perlop.pod' 65768 922579488 0100444
# c 'pod/perlopentut.pod' 0 917189285 0100444
# p 'pod/perlpod.pod' 8303 922574741 0100444
# p 'pod/perlport.pod' 50553 918777969 0100444
# p 'pod/perlre.pod' 36956 920594088 0100444
# p 'pod/perlref.pod' 24472 922574752 0100444
# c 'pod/perlreftut.pod' 0 922573829 0100444
# p 'pod/perlrun.pod' 26456 922573593 0100444
# p 'pod/perlstyle.pod' 7722 922573603 0100444
# p 'pod/perlsub.pod' 43006 922573618 0100444
# p 'pod/perlsyn.pod' 21609 922573632 0100444
# c 'pod/perlthrtut.pod' 0 922585711 0100444
# p 'pod/perltie.pod' 27230 920594092 0100444
# p 'pod/perltoc.pod' 117752 922573661 0100444
# p 'pod/perlvar.pod' 30204 922558937 0100444
# p 'pod/perlxs.pod' 45867 922579612 0100444
# p 'pod/perlxstut.pod' 25951 916513471 0100444
# p 'pod/pod2html.PL' 3544 915029960 0100444
# p 'pod/pod2man.PL' 30061 915291829 0100444
# p 'pod/roffitall' 7404 918777973 0100444
# p 'pp.c' 90475 922593912 0100444
# p 'pp.h' 7640 922557392 0100444
# p 'pp_ctl.c' 94474 922557384 0100444
# p 'pp_hot.c' 59284 922579969 0100444
# p 'pp_sys.c' 91413 922557376 0100444
# p 'proto.h' 35726 920594098 0100444
# p 'regcomp.c' 67793 922557373 0100444
# p 'regexec.c' 45482 922557369 0100444
# p 'run.c' 2651 922557348 0100444
# p 'scope.c' 20211 922557345 0100444
# p 'scope.h' 5490 910482992 0100444
# p 'sv.c' 109180 922557342 0100444
# p 'sv.h' 22028 922579987 0100444
# p 't/base/lex.t' 1987 922607836 0100555
# p 't/cmd/for.t' 941 909667925 0100555
# p 't/cmd/while.t' 2454 909287291 0100555
# p 't/comp/package.t' 800 912126560 0100555
# p 't/comp/proto.t' 7660 920594098 0100555
# p 't/comp/require.t' 967 911870820 0100555
# p 't/io/argv.t' 1249 922579864 0100555
# p 't/io/fs.t' 5184 917572520 0100555
# p 't/lib/cgi-html.t' 2570 917137090 0100555
# p 't/lib/complex.t' 22917 912092121 0100555
# p 't/lib/db-recno.t' 9840 920514954 0100555
# p 't/lib/dumper.t' 10326 913566714 0100555
# c 't/lib/fatal.t' 0 920594098 0100555
# p 't/lib/h2ph.pht' 2804 918777974 0100444
# p 't/lib/io_udp.t' 1273 921715562 0100555
# p 't/lib/parsewords.t' 2896 915768480 0100555
# p 't/lib/posix.t' 2797 921445283 0100555
# p 't/lib/safe2.t' 4013 917572520 0100555
# p 't/lib/searchdict.t' 898 913566146 0100555
# c 't/lib/textfill.t' 0 917580725 0100555
# p 't/lib/textwrap.t' 920 917572521 0100555
# p 't/lib/thread.t' 1166 922594889 0100555
# p 't/op/array.t' 6011 912127211 0100555
# p 't/op/die_exit.t' 1178 909342175 0100555
# p 't/op/eval.t' 1947 920594098 0100555
# p 't/op/goto.t' 1509 909982078 0100555
# c 't/op/grep.t' 0 922637601 0100555
# p 't/op/local.t' 5064 918929164 0100555
# p 't/op/misc.t' 8771 919439126 0100555
# p 't/op/mkdir.t' 620 917572523 0100555
# p 't/op/oct.t' 584 909340051 0100555
# p 't/op/pack.t' 6217 922594488 0100555
# p 't/op/pat.t' 13866 909878142 0100555
# p 't/op/range.t' 1158 920594098 0100555
# p 't/op/re_tests' 13759 909710932 0100444
# p 't/op/repeat.t' 1499 914942933 0100555
# p 't/op/runlevel.t' 5048 909877225 0100555
# p 't/op/sort.t' 3592 912378936 0100555
# p 't/op/sysio.t' 4534 915589573 0100555
# p 't/op/taint.t' 16094 917572525 0100555
# p 't/op/tie.t' 3021 908845356 0100555
# p 't/op/tiehandle.t' 2095 909890599 0100555
# c 't/op/tr.t' 0 909194848 0100555
# p 't/op/undef.t' 1369 912371160 0100555
# p 't/op/write.t' 2868 912388929 0100555
# p 't/pragma/constant.t' 3331 909883425 0100555
# p 't/pragma/locale.t' 10858 909194858 0100555
# p 't/pragma/overload.t' 16441 914940602 0100555
# p 't/pragma/subs.t' 3149 911870861 0100555
# p 't/pragma/warn-1global' 2198 922585373 0100444
# p 't/pragma/warning.t' 2362 911870958 0100555
# p 'taint.c' 2661 915591018 0100444
# p 'thread.h' 6290 920514956 0100444
# p 'toke.c' 148456 922607843 0100444
# p 'universal.c' 4511 915079018 0100444
# p 'unixish.h' 4070 918777980 0100444
# p 'util.c' 65379 922557328 0100444
# p 'util.h' 214 922557507 0100444
# p 'utils/h2ph.PL' 17672 918777981 0100444
# p 'utils/h2xs.PL' 23121 919440426 0100444
# p 'utils/perlbug.PL' 32541 922427137 0100444
# p 'utils/perldoc.PL' 17854 920594101 0100444
# p 'vms/ext/Stdio/Stdio.pm' 9295 911016597 0100444
# p 'vms/ext/Stdio/Stdio.xs' 10733 915079098 0100444
# p 'vms/ext/Stdio/test.pl' 2313 917572526 0100555
# p 'vms/perly_c.vms' 96563 919439130 0100444
# p 'vms/subconfigure.com' 67957 920731723 0100444
# p 'vms/vms.c' 150010 915684605 0100444
# c 'vos/Changes' 0 918777981 0100444
# c 'vos/build.cm' 0 918777981 0100444
# c 'vos/compile_perl.cm' 0 918777982 0100444
# c 'vos/config.h' 0 920731726 0100444
# c 'vos/config_h.SH_orig' 0 920731729 0100555
# c 'vos/perl.bind' 0 918777987 0100444
# c 'vos/test_vos_dummies.c' 0 918777987 0100444
# c 'vos/vos_accept.c' 0 918777987 0100444
# c 'vos/vos_dummies.c' 0 918777987 0100444
# c 'vos/vosish.h' 0 918777987 0100444
# p 'win32/GenCAPI.pl' 39760 922607844 0100444
# p 'win32/Makefile' 23536 922660602 0100444
# p 'win32/bin/pl2bat.pl' 7469 910236196 0100444
# p 'win32/config.bc' 11071 916506154 0100444
# p 'win32/config.gc' 10984 913565140 0100444
# p 'win32/config.vc' 11009 913565140 0100444
# p 'win32/config_H.bc' 65372 912392587 0100444
# p 'win32/config_H.gc' 65333 912392587 0100444
# p 'win32/config_H.vc' 65335 912392587 0100444
# p 'win32/config_sh.PL' 824 916965611 0100444
# p 'win32/makedef.pl' 9440 918929177 0100444
# p 'win32/makefile.mk' 28472 922660602 0100444
# p 'win32/perlhost.h' 21990 918929178 0100444
# p 'win32/pod.mak' 4839 920594101 0100444
# p 'win32/runperl.c' 1356 916965611 0100444
# p 'win32/win32.c' 52554 918929183 0100444
# p 'win32/win32.h' 9308 917189307 0100444
# p 'win32/win32iop.h' 9006 918929184 0100444
# p 'win32/win32sck.c' 12725 912370224 0100444
# p 'win32/win32thread.c' 3030 915034492 0100444
# p 'x2p/Makefile.SH' 4033 910237055 0100555
# p 'x2p/s2p.PL' 15734 920594112 0100444
# p 'x2p/walk.c' 48915 909877289 0100444
# C 'apollo' 0 0 040700
# C 'apollo/netinet' 0 0 040700
# C 'ext/DB_File/hints' 0 0 040700
# C 'ext/GDBM_File/hints' 0 0 040700
# C 'mint' 0 0 040700
# C 'mint/sys' 0 0 040700
# C 'vos' 0 0 040700
#### End of ApplyPatch data ####
#### End of Patch kit [created: Sun Mar 28 16:53:07 1999] ####
#### Checksum: 72623 2338727 65410 ####