This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Maintenance 5.004_04 changes
authorTim Bunce <Tim.Bunce@pobox.com>
Wed, 15 Oct 1997 15:55:26 +0000 (15:55 +0000)
committerTim Bunce <Tim.Bunce@pobox.com>
Wed, 15 Oct 1997 15:55:26 +0000 (15:55 +0000)
p4raw-id: //depot/maint-5.004/perl@128

136 files changed:
Changes
Configure
INSTALL
MANIFEST
Makefile.SH
Porting/makerel
Porting/patchls
Porting/pumpkin.pod
README.vms
av.c
configpm
doop.c
eg/sysvipc/ipcsem
emacs/cperl-mode.el
embed.h
ext/DynaLoader/DynaLoader.pm
ext/IO/lib/IO/Socket.pm
ext/util/extliblist [deleted file]
ext/util/make_ext
global.sym
gv.c
hints/bsdos.sh
hints/dec_osf.sh
hints/dynixptx.sh
hints/irix_6.sh
hints/linux.sh
hints/machten.sh
hints/os2.sh
hints/os390.sh [new file with mode: 0644]
hints/qnx.sh
hv.c
installperl
lib/AutoLoader.pm
lib/CPAN.pm
lib/CPAN/FirstTime.pm
lib/Carp.pm
lib/Cwd.pm
lib/English.pm
lib/ExtUtils/Install.pm
lib/ExtUtils/Liblist.pm
lib/ExtUtils/MM_Unix.pm
lib/ExtUtils/xsubpp
lib/File/DosGlob.pm
lib/File/Find.pm
lib/FileHandle.pm
lib/Getopt/Long.pm
lib/Getopt/Std.pm
lib/Math/Complex.pm
lib/Sys/Hostname.pm
lib/Sys/Syslog.pm
lib/Test/Harness.pm
lib/Time/Local.pm
lib/autouse.pm
lib/base.pm [new file with mode: 0644]
lib/blib.pm
lib/diagnostics.pm [changed mode: 0644->0755]
lib/getopt.pl
lib/perl5db.pl
lib/vars.pm
makedepend.SH
malloc.c
mg.c
miniperlmain.c
myconfig
op.c
opcode.h
os2/Changes
os2/OS2/REXX/Makefile.PL
os2/OS2/REXX/REXX.pm
os2/os2.c
patchlevel.h
perl.c
perl.h
perly.c
perly.fixer
perly.y
pod/perl.pod
pod/perlapio.pod
pod/perldelta.pod
pod/perldiag.pod
pod/perlfunc.pod
pod/perlguts.pod
pod/perlipc.pod
pod/perlop.pod
pod/perlrun.pod
pod/perlsec.pod
pod/perlsub.pod
pod/perltrap.pod
pod/perlvar.pod
pod/perlxs.pod
pp.c
pp_ctl.c
pp_hot.c
pp_sys.c
proto.h
regcomp.c
regexec.c
scope.c
sv.c
t/TEST
t/comp/proto.t
t/lib/complex.t
t/lib/dosglob.t [new file with mode: 0644]
t/lib/io_sock.t
t/lib/io_udp.t
t/op/glob.t
t/op/method.t
t/op/misc.t
t/op/ref.t
t/op/runlevel.t
t/op/split.t
t/op/sprintf.t
t/op/subst.t
t/op/taint.t
t/pragma/locale.t
taint.c
toke.c
unixish.h
util.c
utils/h2ph.PL
utils/h2xs.PL
utils/perlbug.PL
utils/perldoc.PL
vms/perly_c.vms
vms/vms.c
vms/vmsish.h
win32/Makefile
win32/config_H.bc
win32/config_H.vc
win32/makefile.mk
win32/pod.mak
win32/win32.c
win32/win32io.c
win32/win32sck.c
x2p/Makefile.SH
x2p/util.c

diff --git a/Changes b/Changes
index 1675e31..7475501 100644 (file)
--- a/Changes
+++ b/Changes
@@ -42,9 +42,836 @@ current addresses (as of March 1997):
 And the Keepers of the Patch Pumpkin:
 
     Charles Bailey      <bailey@hmivax.humgen.upenn.edu>
+    Tim Bunce           <Tim.Bunce@ig.co.uk>
     Andy Dougherty      <doughera@lafcol.lafayette.edu>
     Chip Salzenberg     <chip@perl.com>
-    Tim Bunce           <Tim.Bunce@ig.co.uk>
+
+
+----------------
+Version 5.004_04        Maintenance release 4 for 5.004
+----------------
+
+"1. Out of clutter, find simplicity.
+ 2. From discord, find harmony.
+ 3. In the middle of difficulty lies opportunity."
+  -- Albert Einstein, three rules of work
+
+
+  HEADLINES FOR THIS MAINTENANCE RELEASE
+
+    Fixed gaps in tainting (readdir, readlink, gecos, bit vector ops).
+    Fixed memory leak in splice(@_).
+    Fixed debugger core dumps.
+    IO::Socket now sets autoflush by default.
+    Several perldoc bugs fixed, now faster and more helpful.
+    Fixed Win32 handle leak.
+    Many other improvements to Win32 support.
+    Many many other bug fixes and enhancements.
+
+
+  ------  BUILD PROCESS  ------
+
+  Title:  "ExtUtils::Liblist prints diagnostics to STDOUT (vs. STDERR)"
+   From:  Andy Dougherty <doughera@newton.phys.lafayette.edu>, jesse@ginger
+          (Jesse Glick)
+ Msg-ID:  <199708290032.UAA15663@ginger>,
+          <Pine.SUN.3.96.970829132217.28552A-100000@newton.phys>
+  Files:  MANIFEST lib/ExtUtils/Liblist.pm
+
+  Title:  "Set LD_RUN_PATH when building suidperl"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>, Tony Sanders
+          <sanders@bsdi.com>
+ Msg-ID:  <199708272226.QAA10206@austin.bsdi.com>
+  Files:  Makefile.SH
+
+  Title:  "INSTALL version 1.26"
+   From:  Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Msg-ID:  <Pine.SUN.3.96.970828143314.27416B-100000@newton.phys>
+  Files:  INSTALL
+
+  Title:  "Propagate MAKE=$(MAKE) through perl build"
+   From:  Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Msg-ID:  <Pine.SUN.3.96.970908143853.13750C-100000@newton.phys>
+  Files:  Makefile.SH makedepend.SH x2p/Makefile.SH ext/util/make_ext
+
+  Title:  "update to installperl for perl5.004_02 to skip CVS dir"
+   From:  Tony Sanders <sanders@bsdi.com>
+ Msg-ID:  <199708272307.RAA13451@austin.bsdi.com>
+  Files:  installperl
+
+  Title:  "makedepend loop on HP-UX 10.20"
+ Msg-ID:  <1997Sep20.183731.2297443@cor.newman>
+  Files:  Makefile.SH
+
+  Title:  "Tiny Grammaro in INSTALL"
+   From:  koenig@anna.mind.de (Andreas J. Koenig)
+ Msg-ID:  <sfcwwkb2pc8.fsf@anna.in-berlin.de>
+  Files:  INSTALL
+
+  Title:  "Fix Configured osvers under Linux 1"
+   From:  Andy Dougherty <doughera@newton.phys.lafayette.edu>, Hugo van der
+          Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199709241439.PAA17114@crypt.compulink.co.uk>,
+          <Pine.SUN.3.96.970924112654.5054D-100000@newton.phys>
+  Files:  Configure
+
+  Title:  "INSTALL-1.28"
+   From:  Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Msg-ID:  <Pine.SUN.3.96.971010131207.23751A-100000@newton.phys>
+  Files:  INSTALL
+
+  Title:  "makedepend.SH fix for UNICOS"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID:  <199710132039.XAA21459@alpha.hut.fi>
+  Files:  makedepend.SH
+
+  ------  CORE LANGUAGE  ------
+
+  Title:  "Re: "perl -d" dumps core when loading syslog.ph"
+   From:  Jochen Wiedmann <wiedmann@neckar-alb.de>, Stephen McCamant
+          <alias@mcs.com>, ilya@math.ohio-state.edu (Ilya
+          Zakharevich)
+ Msg-ID:  <1997Aug30.034921.2297381@cor.newman.upenn.edu>,
+          <3407639E.FEBF20BA@neckar-alb.de>,
+          <m0x4ZGj-000EZYC@alias-2.pr.mcs.net>
+  Files:  pp_ctl.c
+
+  Title:  "Allow $obj->$coderef()"
+   From:  Chip Salzenberg <salzench@nielsenmedia.com>
+ Msg-ID:  <199708291649.MAA23276@nielsenmedia.com>
+  Files:  pp_hot.c
+
+  Title:  "Localize PV value in save_gp()", "typeglob differences in perl4 and
+          perl5"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen McCamant
+          <alias@mcs.com>
+ Msg-ID:  <199708272348.TAA03139@aatma.engin.umich.edu>,
+          <m0x4u2o-000EZkC@alias-2.pr.mcs.net>
+  Files:  scope.c t/op/ref.t
+
+  Title:  "Avoid assumption that STRLEN == I32"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>, Hallvard B Furuseth
+          <h.b.furuseth@usit.uio.no>
+ Msg-ID:  <199708242310.BAA05497@bombur2.uio.no>
+  Files:  hv.c
+
+  Title:  "Fix memory leak in splice(@_)"
+   From:  "Tuomas J. Lukka" <tjl@fkfuga.pc.helsinki.fi>, Chip Salzenberg
+          <chip@rio.atlantic.net>
+ Msg-ID:  <m0x3iQE-000CBrC@lukka.student.harvard.edu>
+  Files:  proto.h av.c global.sym pp.c
+
+  Title:  "Fix line number of warnings in while() conditional", "misleading
+          uninit value warning"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>, Greg Bacon
+          <gbacon@crp-201.adtran.com>
+ Msg-ID:  <199708271607.LAA01403@crp-201.adtran.com>
+  Files:  proto.h op.c perly.c perly.y
+
+  Title:  "-t and POSIX::isatty on IO::Handle objects", "Fix C<-t $handle>"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>, Greg Ward
+          <greg@bic.mni.mcgill.ca>
+ Msg-ID:  <199708261754.NAA24826@bottom.bic.mni.mcgill.ca>
+  Files:  pp_sys.c
+
+  Title:  "Fix output of invalid printf formats"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>, Hugo van der Sanden
+          <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199708241529.QAA02457@crypt.compulink.co.uk>
+  Files:  sv.c t/op/sprintf.t
+
+  Title:  "regexec.c regcppartblow declaration missing an arg"
+   From:  Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199708290059.BAA05808@crypt.compulink.co.uk>
+  Files:  regexec.c
+
+  Title:  "taint readlink, readdir, gecos"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID:  <199709131651.TAA13471@alpha.hut.fi>
+  Files:  pod/perlfunc.pod pod/perlsec.pod pp_sys.c t/op/taint.t
+
+  Title:  "clean up old style package' usage in op.c"
+   From:  Stephen Potter <spp@psa.pencom.com>
+ Msg-ID:  <199709151813.NAA14433@psisa.psa.pencom.com>
+  Files:  op.c
+
+  Title:  "beautifying usage() code in perl.c"
+   From:  "John L. Allen" <"John L. Allen"<allen@gateway.grumman.com>>
+ Msg-ID:  <Pine.SOL.3.91.970905091314.5991C-100000@gateway>
+  Files:  perl.c
+
+  Title:  "debugger to fix core dumps, adds $^S"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199709170823.EAA21359@monk.mps.ohio-state.edu>
+  Files:  pod/perlvar.pod perl.h gv.c lib/perl5db.pl mg.c perl.c toke.c
+
+  Title:  "downgrade "my $foo masks earlier" from mandatory to "-w""
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen Potter
+          <spp@psa.pencom.com>
+ Msg-ID:  <199709091832.NAA14763@psisa.psa.pencom.com>,
+          <199709102019.QAA09591@aatma.engin.umich.edu>
+  Files:  pod/perldelta.pod pod/perldiag.pod op.c
+
+  Title:  "fix overridden glob() problems"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID:  <199709171645.MAA13988@aatma.engin.umich.edu>
+  Files:  MANIFEST pod/perlsub.pod lib/File/DosGlob.pm op.c t/lib/dosglob.t
+          toke.c
+
+  Title:  "Reverse previous "Fix C<qq #hi#>" patch"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>, Kenneth Albanowski
+          <kjahds@kjahds.com>, Tom Christiansen
+          <tchrist@jhereg.perl.com>
+ Msg-ID:  <199707050155.VAA27394@rio.atlantic.net>,
+          <199708172326.RAA19344@jhereg.perl.com>,
+          <Pine.LNX.3.93.970817200236.170F-100000@kjahds.com>
+  Files:  toke.c
+
+  Title:  "printf type warning buglets in m3t2"
+   From:  Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
+ Msg-ID:  <199708141017.MAA10225@bombur2.uio.no>
+  Files:  regcomp.c regexec.c scope.c sv.c util.c x2p/util.c
+
+  Title:  "Localize PV value in save_gp()", "typeglob differences in perl4 and
+          perl5"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen McCamant
+          <alias@mcs.com>
+ Msg-ID:  <199708272348.TAA03139@aatma.engin.umich.edu>,
+          <m0x4AUk-000EUJC@alias-2.pr.mcs.net>
+  Files:  scope.c t/op/ref.t
+
+  Title:  "unpack now allows commas but -w warns", "unpack() difference
+          5.003->5.004"
+   From:  "John L. Allen" <allen@gateway.grumman.com>, Chip Salzenberg
+          <chip@rio.atlantic.net>, Jarkko Hietaniemi <jhi@iki.fi>,
+          Jim Esten <jesten@wdynamic.com>, Jim Esten
+          <jesten@wepco.com>, timbo (Tim Bunce)
+ Msg-ID:  <199709031632.LAA29584@wepco.com>,
+          <199709090257.WAA32670@rio.atlantic.net>,
+          <199709090917.MAA05602@alpha.hut.fi>,
+          <199709091000.LAA24094@toad.ig.co.uk>,
+          <341077FE.132F@wdynamic.com>,
+          <Pine.SOL.3.91.970905171243.14630A-100000@gateway>
+  Files:  pod/perldiag.pod pp.c
+
+  Title:  "5.004_04 trial 1 assorted minor details"
+   From:  Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
+ Msg-ID:  <HBF.970921p5f6@bombur2.uio.no>
+  Files:  Porting/pumpkin.pod hv.c op.c sv.c x2p/util.c
+
+  Title:  "A couple of 4_04t1 problems"
+   From:  pmarquess@bfsec.bt.co.uk (Paul Marquess)
+ Msg-ID:  <9709210959.AA28772@claudius.bfsec.bt.co.uk>
+  Files:  lib/Cwd.pm perl.c
+
+  Title:  "Minor changes to ease port to MVS"
+   From:  Len Johnson <lenjay@ibm.net>, SMTP%"BAHUFF@us.oracle.com" ,
+          SMTP%"pfuntner@vnet.ibm.com" , pvhp@forte.com (Peter
+          Prymmer)
+ Msg-ID:  <199709162058.NAA00952@mailsun2.us.oracle.com>
+  Files:  unixish.h miniperlmain.c
+
+  Title:  "Truer version string and more robust perlbug"
+   From:  "Michael A. Chase" <mchase@ix.netcom.com>, Hugo van der Sanden
+          <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199709201514.QAA21187@crypt.compulink.co.uk>,
+          <1997Sep22.090701.2297448@cor.newman>
+  Files:  perl.c utils/perlbug.PL
+
+  Title:  "Fix locale bug for constant (readonly) strings"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID:  <199709262125.AAA28292@alpha.hut.fi>
+  Files:  sv.c t/pragma/locale.t
+
+  Title:  "Enable truly global glob()"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID:  <199710080000.UAA18972@aatma.engin.umich.edu>
+  Files:  op.c
+
+  Title:  "Fix for $0 truncation"
+   From:  Tim Bunce <Tim.Bunce@ig.co.uk>
+ Msg-ID:  <199710081703.SAA02653@toad.ig.co.uk>
+  Files:  mg.c
+
+  Title:  "Fix for missing &import leaving stack untidy"
+   From:  Chip Salzenberg <salzench@nielsenmedia.com>
+ Msg-ID:  <199709282252.SAA22915@nielsenmedia.com>
+  Files:  pp_hot.c
+
+  Title:  "Larry's proto fix"
+   From:  Chip Salzenberg <salzench@nielsenmedia.com>
+ Msg-ID:  <199709290004.UAA07559@nielsenmedia.com>
+  Files:  op.c t/comp/proto.t
+
+  Title:  "Fix bugs with magical arrays and hashes (@ISA)"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>
+ Msg-ID:  <199709232148.RAA29967@rio.atlantic.net>
+  Files:  perl.h proto.h av.c global.sym gv.c mg.c pp.c pp_hot.c scope.c
+          t/op/method.t
+
+  Title:  "Perl_debug_log stream used for all DEBUG_*(...) macro uses"
+   From:  Nick Ing-Simmons <nik@tiuk.ti.com>, Tim Bunce
+ Msg-ID:  <199709230820.JAA11945@tiuk.ti.com>
+  Files:  perl.c taint.c util.c
+
+  Title:  "Tainting bitwise vector ops"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>
+ Msg-ID:  <199710061726.NAA16438@rio.atlantic.net>
+  Files:  doop.c t/op/taint.t
+
+  Title:  "Enhance $^E on OS/2"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199709232236.SAA04463@monk.mps.ohio-state.edu>
+  Files:  pod/perlvar.pod mg.c os2/Changes
+
+  Title:  "option "!#... -- ..." in perl 5.004.03 seems not to work"
+   From:  "John L. Allen" <allen@gateway.grumman.com>, Urs Thuermann
+          <urs@isnogud.escape.de>
+ Msg-ID:  <199709232030.WAA30425@isnogud.escape.de>,
+          <Pine.SOL.3.91.970930105158.10789A-100000@gateway>
+  Files:  perl.c
+
+  Title:  "syswrite will again write a zero length buffer"
+   From:  Cameron Simpson <cs@zip.com.au>, Jarkko Hietaniemi <jhi@iki.fi>,
+          aml@world.std.com (Andrew M. Langmead)
+ Msg-ID:  <199710042107.AAA28561@alpha.hut.fi>,
+          <19971007104652-cameron-1-10391@sid.research.canon.com.au>
+  Files:  pp_sys.c
+
+  Title:  "make Odd number of elements in hash list warning non-mandatory"
+   From:  Jason Varsoke {81530} <jjv@caesun10.msd.ray.com>
+ Msg-ID:  <199710021651.MAA15690@caesun7.msd.ray.com>
+  Files:  pp.c pp_hot.c
+
+  Title:  "Fix defined() bug in m4t3 affecting LWP"
+   From:  chip@atlantic.net@ig.co.uk ()
+ Msg-ID:  <199710101822.OAA14249@cyprus.atlantic.net>
+  Files:  pp.c
+
+  Title:  "Include $archname in perl -v output"
+   From:  Tim Bunce <Tim.Bunce@ig.co.uk>
+  Files:  perl.c
+
+  Title:  "-I flag can easily lead to whitespace in @INC"
+   From:  Kenneth Stephen <y2kmvs@us.ibm.com>, Tim Bunce <Tim.Bunce@ig.co.uk>,
+          pvhp@forte.com (Peter Prymmer)
+ Msg-ID:  <199710130922.KAA07780@toad.ig.co.uk>,
+          <5040400007001448000002L082*@MHS>,
+          <9710132015.AA12457@forte.com>
+  Files:  perl.c
+
+  ------  DOCUMENTATION  ------
+
+  Title:  "perldiag.pod: gotcha in short pattern/char ops"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID:  <199709050718.KAA31405@alpha.hut.fi>
+  Files:  pod/perldiag.pod
+
+  Title:  "Documenting the perl-thanks address"
+   From:  Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID:  <Pine.GSO.3.96.970913064628.12359F-100000@julie.teleport.com>
+  Files:  pod/perl.pod
+
+  Title:  "Missing section for @_ in perlvar."
+   From:  abigail@fnx.com (Abigail)
+ Msg-ID:  <199708142146.RAA13146@fnx.com>
+  Files:  pod/perlvar.pod
+
+  Title:  "Promised information about AvHASH in perguts is not delivered"
+   From:  mjd@plover.com
+  Files:  pod/perlguts.pod
+
+  Title:  "perlfunc.doc - $_ aliasing in map, grep, foreach etc"
+   From:  Ted Ashton <ashted@southern.edu>
+ Msg-ID:  <199708181852.OAA15901@ns.southern.edu>
+  Files:  pod/perlfunc.pod
+
+  Title:  "-U Unsafe operations need -w to warn"
+   From:  Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID:  <Pine.GSO.3.96.970826141343.13463h-100000@julie.teleport.com>
+  Files:  pod/perlrun.pod
+
+  Title:  "document the return value of syscall"
+   From:  Hans Mulder <hansm@icgned.nl>
+ Msg-ID:  <1997Sep7.160817.2297395@cor.newman>
+  Files:  pod/perlfunc.pod
+
+  Title:  "minor fix for perltrap.pod"
+   From:  abigail@fnx.com (Abigail)
+ Msg-ID:  <199709170500.BAA14805@fnx.com>
+  Files:  pod/perltrap.pod
+
+  Title:  "xsubpp: document advanced dynamic typemap usage"
+   From:  "Rujith S. de Silva" <desilva@netbox.com>
+  Files:  pod/perlxs.pod
+
+  Title:  "Improved diagnostic docs for here-documents"
+   From:  Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID:  <Pine.GSO.3.96.970921074004.21358G-100000@julie.teleport.com>
+  Files:  pod/perldiag.pod
+
+  Title:  "[POD patch] do-FILE forces scalar context."
+   From:  Robin Houston <robin@oneworld.org>
+ Msg-ID:  <199709221553.QAA28409@carryon.oneworld.org>
+  Files:  pod/perlfunc.pod
+
+  Title:  "perlop.pop. Behaviour of C<qq#hi#> vs C<qq #hi#>."
+   From:  abigail@fnx.com (Abigail)
+ Msg-ID:  <199709220107.VAA27064@fnx.com>
+  Files:  pod/perlop.pod
+
+  Title:  "Clarify exec docs in perlfunc.pod"
+   From:  Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199710081353.OAA00834@crypt.compulink.co.uk>
+  Files:  pod/perlfunc.pod
+
+  Title:  "Documentation patch for perlguts.pod--document tainting routines"
+   From:  Dan Sugalski <sugalskd@osshe.edu>
+ Msg-ID:  <3.0.3.32.19971007165226.02fd2cd4@osshe.edu>
+  Files:  pod/perlguts.pod
+
+  Title:  "Man perlfunc: incorrect split example"
+   From:  Joerg Porath <Joerg.Porath@informatik.tu-chemnitz.de>
+ Msg-ID:  <199709240620.IAA30928@pandora.hrz.tu-chemnitz.de>
+  Files:  pod/perlfunc.pod
+
+  Title:  "Improve "Use of inherited AUTOLOAD for non-method" disgnostic"
+   From:  rjray@uswest.com (Randy J. Ray)
+ Msg-ID:  <199709231710.LAA08854@tremere.ecte.uswc.uswest.com>
+  Files:  pod/perldiag.pod
+
+  Title:  "Document split-with-limit on empty string perl4/perl5 change"
+   From:  "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Gisle Aas <aas@bergen.sn.no>, Hugo
+          van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199709221419.PAA03987@crypt.compulink.co.uk>,
+          <hiuvttdkv.fsf@bergen.sn.no>
+  Files:  pod/perlfunc.pod pod/perltrap.pod URI/URL/http.pm t/op/split.t
+
+  Title:  "Clarify close() docs"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710081653.MAA20611@monk.mps.ohio-state.edu>
+  Files:  pod/perlfunc.pod
+
+  Title:  "perldiag log & sqrt - refer to Math::Complex package"
+   From:  Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Msg-ID:  <199710042129.AAA20367@alpha.hut.fi>
+  Files:  pod/perldiag.pod
+
+  Title:  "perlfunc.pod: sysread, syswrite docs"
+   From:  Jarkko Hietaniemi <jhi@cc.hut.fi>
+ Msg-ID:  <199710061910.WAA15266@alpha.hut.fi>
+  Files:  pod/perlfunc.pod
+
+  Title:  "Document //gc"
+   From:  abigail@fnx.com (Abigail)
+ Msg-ID:  <199709232302.TAA27947@fnx.com>
+  Files:  pod/perlop.pod
+
+  Title:  "repeating #! switches"
+   From:  Chip Salzenberg <chip@rio.atlantic.net>, Robin Barker
+          <rmb1@cise.npl.co.uk>
+ Msg-ID:  <199709241736.NAA25855@rio.atlantic.net>,
+          <24778.9709241501@tempest.cise.npl.co.uk>
+  Files:  pod/perlrun.pod
+
+  Title:  "Re: taint documentation bug"
+   From:  Ken Estes <estes@ms.com>, Tom Phoenix <rootbeer@teleport.com>
+ Msg-ID:  <Pine.GSO.3.96.971006121349.10551X-100000@usertest.teleport.com>
+  Files:  pod/perlsec.pod
+
+  ------  LIBRARY AND EXTENSIONS  ------
+
+  Title:  "FileHandle.pm fails if Exporter has not been loaded previously"
+   From:  jan.dubois@ibm.net (Jan Dubois)
+ Msg-ID:  <3445e05b.17874041@smtp2.ibm.net>
+  Files:  lib/FileHandle.pm
+
+  Title:  "Prefer startperl path over perlpath in MakeMaker"
+   From:  Andreas Klussmann <andreas@infosys.heitec.de>
+ Msg-ID:  <199709162017.WAA05043@troubadix.infosys.heitec.net>
+  Files:  lib/ExtUtils/MM_Unix.pm
+
+  Title:  "Sys::Hostname fails under Solaris 2.5 when setuid"
+   From:  Patrick Hayes <Patrick.Hayes.CAP_SESA@renault.fr>
+ Msg-ID:  <199708201240.OAA04243@goblin.renault.fr>
+  Files:  lib/Sys/Hostname.pm
+
+  Title:  "Cwd::getcwd cannot handle path contains '0' element"
+   From:  Hironori Ikura <hikura@tcc.co.jp>, Hironori Ikura
+          <hikura@trans-nt.com>, Stephen Zander <srz@mckesson.com>
+ Msg-ID:  <19970830060142J.hikura@matsu.tcc.co.jp>,
+          <m0x4TzI-0003F1C@wsuse5.mckesson.com>
+  Files:  lib/Cwd.pm
+
+  Title:  "Getopt::Long 2.11"
+   From:  JVromans@squirrel.nl (Johan Vromans)
+ Msg-ID:  <m0xBcdR-000RArC@plume.nl.compuware.com>
+  Files:  lib/Getopt/Long.pm
+
+  Title:  "IO::Socket autoflush by default, assume tcp and PeerAddr"
+   From:  "M.J.T. Guy" <mjtg@cus.cam.ac.uk>, Andy Dougherty
+          <doughera@newton.phys.lafayette.edu>, Gisle Aas
+          <aas@bergen.sn.no>
+ Msg-ID:  <E0x9WpH-0003HT-00@ursa.cus.cam.ac.uk>,
+          <Pine.SUN.3.96.970915115856.23236F-100000@newton.phys>,
+          <hvi07zvo9.fsf@bergen.sn.no>
+  Files:  ext/IO/lib/IO/Socket.pm
+
+  Title:  "Syslog.pm and missing _PATH_LOG"
+   From:  Ulrich Pfeifer <upf@de.uu.net>
+ Msg-ID:  <p5iuw1cris.fsf@knowway.de.uu.net>
+  Files:  lib/Sys/Syslog.pm
+
+  Title:  "Undocumented: $Test::Harness::switches"
+   From:  Achim Bohnet <ach@mpe.mpg.de>
+ Msg-ID:  <9708272110.AA26904@o09.xray.mpe.mpg.de>
+  Files:  lib/Test/Harness.pm
+
+  Title:  "Patches for lib/Math/Complex.pm and t/lib/complex.t"
+   From:  Jarkko Hietaniemi <jhi@anna.in-berlin.de>
+ Msg-ID:  <199709102009.WAA27428@anna.in-berlin.de>
+  Files:  lib/Math/Complex.pm t/lib/complex.t
+
+  Title:  "Win32: Install.pm not correctly comparing binary files."
+   From:  Jeff Urlwin <jurlwin@access.digex.net>
+ Msg-ID:  <01BCBFAA.E325C4A0.jurlwin@access.digex.net>
+  Files:  lib/ExtUtils/Install.pm
+
+  Title:  "Document that File::Find doesn't follow symlinks"
+   From:  Greg Ward <greg@bic.mni.mcgill.ca>
+ Msg-ID:  <199708191853.OAA07111@bottom.bic.mni.mcgill.ca>
+  Files:  lib/File/Find.pm
+
+  Title:  "fix subroutines called in a void context in perl5db.pl"
+   From:  "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
+ Msg-ID:  <E0x6Gsa-0004VR-00@ursa.cus.cam.ac.uk>
+  Files:  lib/perl5db.pl
+
+  Title:  "xsubpp fix to allow #ifdef's around entire XSubs"
+   From:  John Tobey <jtobey@user1.channel1.com>
+ Msg-ID:  <199709070034.AAA16457@remote119>
+  Files:  lib/ExtUtils/xsubpp
+
+  Title:  "Banishing eval from getopt.pl and Getopt/Std.pm"
+   From:  "John L. Allen" <allen@gateway.grumman.com>
+ Msg-ID:  <Pine.SOL.3.91.970920154720.3683A@gateway>
+  Files:  lib/getopt.pl lib/Getopt/Std.pm
+
+  Title:  "further complex number patches"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>, d-lewart@uiuc.edu (Daniel S. Lewart)
+ Msg-ID:  <199709221009.FAA21216@staff2.cso.uiuc.edu>,
+          <199709221216.PAA15130@alpha.hut.fi>
+  Files:  lib/Math/Complex.pm t/lib/complex.t
+
+  Title:  "Trap Time::Local infinite loop"
+   From:  Hugo van der Sanden <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199710030030.BAA17372@crypt.compulink.co.uk>
+  Files:  lib/Time/Local.pm
+
+  Title:  "Cosmetic Test::Harness patch"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710032226.SAA15354@monk.mps.ohio-state.edu>
+  Files:  lib/Test/Harness.pm
+
+  Title:  "ExtUtil::Install sub my_cmp needs to binmode its files"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>, Stephen Potter
+          <spp@psa.pencom.com>
+ Msg-ID:  <199710010617.BAA02037@psisa.psa.pencom.com>,
+          <199710011819.OAA03288@aatma.engin.umich.edu>
+  Files:  lib/ExtUtils/Install.pm
+
+  Title:  "Enable make test "TEST_FILES=t/*.t.were_failing""
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710032231.SAA15364@monk.mps.ohio-state.edu>
+  Files:  lib/ExtUtils/MM_Unix.pm
+
+  Title:  "Fix for autouse.pm"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710071734.NAA19462@monk.mps.ohio-state.edu>
+  Files:  lib/autouse.pm
+
+  Title:  "Math::Complex fixes - fixes problems on m68-linux"
+   From:  Jarkko Hietaniemi <jarkko.hietaniemi@research.nokia.com>
+ Msg-ID:  <199709301422.HAA24368@koah.research.nokia.com>
+  Files:  lib/Math/Complex.pm
+
+  Title:  "Updated CPAN.pm for 5.004_04"
+   From:  koenig@anna.mind.de (Andreas J. Koenig)
+ Msg-ID:  <sfcpvpv8teo.fsf@anna.in-berlin.de>
+  Files:  lib/CPAN.pm lib/CPAN/FirstTime.pm
+
+  Title:  "debugger bug with 'c subname'"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199709232331.TAA04546@monk.mps.ohio-state.edu>
+  Files:  lib/perl5db.pl
+
+  Title:  "Fix atan2 & restrict $t to (-pi,pi] instead of to [-pi,pi]"
+   From:  Daniel S. Lewart, Jarkko Hietaniemi
+          <jarkko.hietaniemi@research.nokia.com>
+ Msg-ID:  <199710010939.CAA00964@koah.research.nokia.com>
+  Files:  lib/Math/Complex.pm
+
+  Title:  "Cwd::fastcwd needs changes to work with tainting"
+   From:  Hugo van der Sanden <hv@crypt.compulink.co.uk>, Ulrich Pfeifer
+          <pfeifer@wait.de>, Tim Bunce
+ Msg-ID:  <yfmwwk6y0bc.ulp@gretchen.informatik.uni-dortmund.de>
+  Files:  lib/Cwd.pm
+
+  Title:  "use autouse: requires prototype now"
+   From:  user@agate.berkeley.edu
+ Msg-ID:  <9709220450.AA0380@tuzik.HIP.Berkeley.EDU>
+  Files:  lib/autouse.pm
+
+  Title:  ""use base qw(Foo Bar);" to set @ISA at compile time"
+   From:  Gisle Aas <gisle@aas.no>, Graham Barr <gbarr@pobox.com>, Graham Barr
+          <gbarr@ti.com>, Tim Bunce <Tim.Bunce@ig.co.uk>,
+          jan.dubois@ibm.net (Jan Dubois), larry@wall.org (Larry
+          Wall)
+ Msg-ID:  <199710022151.WAA21250@toad.ig.co.uk>,
+          <199710031613.JAA11286@wall.org>,
+          <199710040829.KAA16739@furu.g.aas.no>,
+          <3434E4C6.AE24135E@ti.com>, <343C2278.7DC1ADC6@pobox.com>,
+          <343ec306.50394803@smtp-gw01.ny.us.ibm.net>
+  Files:  lib/base.pm
+
+  Title:  "Further Math/Complex.pm enhancements"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID:  <199710132055.XAA02086@alpha.hut.fi>
+  Files:  lib/Math/Complex.pm t/lib/complex.t
+
+  Title:  "Further Math::Complex fixes"
+   From:  Jarkko Hietaniemi <jhi@iki.fi>
+ Msg-ID:  <199710120933.MAA01165@alpha.hut.fi>
+  Files:  lib/Math/Complex.pm
+
+  ------  OTHER CHANGES  ------
+
+  Title:  "POD patches w.r.t. $^S"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710030001.UAA14241@monk.mps.ohio-state.edu>
+  Files:  ../pod/perlfunc.pod ../pod/perlvar.pod
+
+  Title:  "libperl.sl on HP-UX 10.20"
+   From:  "Darren/Torin/Who Ever..." <torin@daft.com>, Hugo van der Sanden
+          <hv@crypt.compulink.co.uk>
+ Msg-ID:  <199709250003.BAA18085@crypt.compulink.co.uk>,
+          <873emkbpit.fsf@perv.daft.com>
+  Files:  
+
+  Title:  "myconfig / perl -V: remove randbits and add prototype"
+   From:  Tim Bunce <Tim.Bunce@ig.co.uk>
+ Msg-ID:  <199709290857.JAA07706@toad.ig.co.uk>
+  Files:  myconfig
+
+  Title:  "Emacs CPerl update for 5.004_04"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710140835.EAA26825@monk.mps.ohio-state.edu>
+  Files:  emacs/cperl-mode.el
+
+  Title:  "Enhance perly.fixer to help porters."
+   From:  Tim Bunce
+  Files:  perly.fixer
+
+  ------  PORTABILITY - WIN32  ------
+
+  Title:  "Fix win32/Makefile for perl95"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+  Files:  win32/Makefile win32/makefile.mk
+
+  Title:  "Win32 archnames"
+   From:  Bill Middleton <wmiddlet@Adobe.COM>, Gurusamy Sarathy
+          <gsar@engin.umich.edu>, Peter Prymmer <pvhp@forte.com>, Tim
+          Bunce <Tim.Bunce@ig.co.uk>
+ Msg-ID:  <199709111929.PAA22488@aatma.engin.umich.edu>,
+          <341719E4.4923@forte.com>,
+          <Pine.GSO.3.95.970905123145.12361B-100000@ducks>
+  Files:  win32/config_H.bc win32/config_H.vc
+
+  Title:  "pl2bat.bat -> pl2bat.pl change in win32/pod.mak"
+   From:  jan.dubois@ibm.net (Jan Dubois)
+ Msg-ID:  <3411ee6f.9143607@smtp-gw01.ny.us.ibm.net>
+  Files:  win32/pod.mak
+
+  Title:  "Add test-notty target to Win32 Makefile"
+   From:  jan.dubois@ibm.net (Jan Dubois)
+ Msg-ID:  <343f5106.12461608@smtp2.ibm.net>
+  Files:  win32/Makefile
+
+  Title:  "Bug in Win32::GetShortPathName"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID:  <199710092229.SAA21556@aatma.engin.umich.edu>
+  Files:  win32/win32.c
+
+  Title:  "Fix NT handles leak."
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID:  <199710111319.JAA10918@aatma.engin.umich.edu>
+  Files:  win32/win32io.c win32/win32sck.c
+
+  Title:  "fix socket init duality on win32"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>
+ Msg-ID:  <199710111523.LAA12407@aatma.engin.umich.edu>
+  Files:  win32/win32sck.c
+
+  ------  PORTABILITY - GENERAL  ------
+
+  Title:  "Tweak to hints/machten.sh: stop t/lib/complex.t from failing"
+   From:  Dominic Dunlop <domo@tcp.ip.lu>
+ Msg-ID:  <v03110700b06a30bdfc42@[194.51.248.80]>
+  Files:  hints/machten.sh
+
+  Title:  "Irix 6.2 build problem - so_locations"
+   From:  "Billinghurst, David" <David.Billinghurst@riotinto.com.au>
+ Msg-ID:  <D54B1932FFB4CF11B5C80000F8018BD2907E31@CRCMAIL>
+  Files:  hints/irix_6.sh
+
+  Title:  "Porting/pumpkin.pod version 1.13"
+   From:  Andy Dougherty <doughera@newton.phys.lafayette.edu>
+ Msg-ID:  <Pine.SUN.3.96.970828142011.27416A-100000@newton.phys>
+  Files:  Porting/pumpkin.pod
+
+  Title:  "lib/timelocal.t fails test 1 for VMS 7.1"
+   From:  Dan Sugalski <sugalsd@lbcc.cc.or.us>
+ Msg-ID:  <3.0.3.32.19970908112449.0087bc90@stargate.lbcc.cc.or.us>
+  Files:  vms/vmsish.h vms/vms.c
+
+  Title:  "Patches to updated README.VMS for Perl 5.004_04"
+   From:  Dan Sugalski <sugalsd@stargate.lbcc.cc.or.us>
+ Msg-ID:  <3.0.3.32.19970918100648.008b1c60@stargate.lbcc.cc.or.us>
+  Files:  README.vms
+
+  Title:  "Fix perl build on Digital UNIX after JDK installs libnet.so"
+   From:  Spider Boardman <spider@orb.nashua.nh.us>
+ Msg-ID:  <199709191826.OAA18040@Orb.Nashua.NH.US>
+  Files:  hints/dec_osf.sh
+
+  Title:  "Updated README.VMS for Perl 5.004_04"
+   From:  Dan Sugalski <sugalsd@stargate.lbcc.cc.or.us>
+ Msg-ID:  <3.0.3.32.19970912091524.008a3620@stargate.lbcc.cc.or.us>
+  Files:  README.vms
+
+  Title:  "Dynixptx hints"
+   From:  bruce@aps.org ("Bruce P. Schuck")
+ Msg-ID:  <Pine.PTX.3.95.971002104651.12112G-200000@lancelot.aps.org>
+  Files:  hints/dynixptx.sh
+
+  Title:  "Minor OS/2 patch for 4_03"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710032224.SAA15345@monk.mps.ohio-state.edu>
+  Files:  os2/os2.c
+
+  Title:  "OS2::REXX improvements"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199709272214.SAA08638@monk.mps.ohio-state.edu>
+  Files:  os2/Changes os2/OS2/REXX/Makefile.PL os2/OS2/REXX/REXX.pm
+
+  Title:  "hints/qnx.sh update"
+   From:  Norton Allen <allen@huarp.harvard.edu>
+ Msg-ID:  <199709261508.LAA07889@dolores.harvard.edu>
+  Files:  hints/qnx.sh
+
+  Title:  "New hints file for IBM OS/390 OpenEdition (MVS)"
+   From:  pvhp@forte.com (Peter Prymmer)
+ Msg-ID:  <9709240106.AA26484@forte.com>
+  Files:  hints/os390.sh
+
+  Title:  "OS/2 Hints"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199710130631.CAA25426@monk.mps.ohio-state.edu>
+  Files:  hints/os2.sh
+
+  ------  TESTS  ------
+
+  Title:  "op/glob.t test failure under Win32 with CVS"
+   From:  Warren Jones <wjones@tc.fluke.com>
+ Msg-ID:  <97Aug26.091048pdt.35761-1@gateway.fluke.com>
+  Files:  t/op/glob.t
+
+  Title:  "tests fail if localhost/loopback address not defined"
+   From:  David McLean <David McLean<davem@icc.gsfc.nasa.gov>>, David McLean
+          <davem@icc.gsfc.nasa.gov>
+ Msg-ID:  <34048947.2944@icc.gsfc.nasa.gov>
+  Files:  t/lib/io_sock.t t/lib/io_udp.t
+
+  Title:  "Improve pragma/locale test 102 - and don't fail, just warn"
+   From:  Jarkko Hietaniemi <jhi@anna.in-berlin.de>
+  Files:  t/pragma/locale.t
+
+  Title:  "Invalid test output in t/op/taint.t in trial 1"
+   From:  Dan Sugalski <sugalsd@lbcc.cc.or.us>
+ Msg-ID:  <3.0.3.32.19970919160918.00857a50@stargate.lbcc.cc.or.us>
+  Files:  t/op/taint.t
+
+  Title:  "Identify t/*/*.t test failing because of file permissions"
+   From:  koenig@anna.mind.de (Andreas J. Koenig)
+ Msg-ID:  <sfcraah0xvy.fsf@anna.in-berlin.de>
+  Files:  t/TEST
+
+  Title:  "fix poor t/op/runlevel.t test"
+   From:  Gurusamy Sarathy <gsar@engin.umich.edu>, Hugo van der Sanden
+          <hv@crypt.compulink.co.uk>, Norton Allen
+          <allen@huarp.harvard.edu>
+ Msg-ID:  <199709261458.KAA28611@dolores.harvard.edu>
+  Files:  t/op/runlevel.t
+
+  ------  UTILITIES  ------
+
+  Title:  "Missing 'require' in auto-generated .pm by h2xs"
+   From:  davidk@tor.securecomputing.com (David Kerry)
+ Msg-ID:  <97Aug27.131618edt.11650@janus.tor.securecomputing.com>
+  Files:  utils/h2xs.PL
+
+  Title:  "Perldoc tiny patch to avoid $0"
+   From:  Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Msg-ID:  <199709122141.RAA16846@monk.mps.ohio-state.edu>
+  Files:  utils/perldoc.PL
+
+  Title:  "h2ph broken in 5.004_02"
+   From:  David Mazieres <dm@reeducation-labor.lcs.mit.edu>,
+          kstar@www.chapin.edu (Kurt D. Starsinic)
+ Msg-ID:  <199708201454.KAA05122@reeducation-labor.lcs.mit.edu>,
+          <199708201700.KAA02621@www.chapin.edu>
+  Files:  utils/h2ph.PL
+
+  Title:  "add key_t caddr_t to h2ph", "eg/sysvipc/ipcsem bug", "update
+          hints/bsdos.sh"
+   From:  Tony Sanders <sanders@bsdi.com>
+ Msg-ID:  <199708272301.RAA12803@austin.bsdi.com>
+  Files:  eg/sysvipc/ipcsem utils/h2ph.PL
+
+  Title:  "perldoc search ., lib and blib/* if -f 'Makefile.PL'"
+   From:  Tim Bunce
+ Msg-ID:  <199708251732.KAA19299@gadget.cscaper.com>
+  Files:  utils/perldoc.PL
+
+  Title:  "5.004m4t1: perlbug: NIS domainname gets into wrong places"
+   From:  koenig@anna.mind.de (Andreas J. Koenig)
+ Msg-ID:  <sfcg1qy38as.fsf@anna.in-berlin.de>
+  Files:  utils/perlbug.PL
+
+  Title:  "add better local patch info to perlbug", "perlbug checks perl
+          build/run version changes"
+   From:  Tim.Bunce@ig.co.uk
+  Files:  utils/perlbug.PL
+
+  Title:  "perldoc - suggest modules if requested module not found"
+   From:  Anthony David <adavid@netinfo.com.au>
+ Msg-ID:  <3439CD83.6969@netinfo.com.au>
+  Files:  utils/perldoc.PL
+
+  Title:  "perldoc mail::foo tries to read binary /usr/ucb/mail"
+   From:  "Joseph Moof-in' Hall" <joseph@cscaper.com>, Tim Bunce
+ Msg-ID:  <199710082014.NAA00808@gadget.cscaper.com>
+  Files:  utils/perldoc.PL
+
+  Title:  "perldoc -f setpwent (for example) returns no descriptive text"
+   From:  Tim Bunce
+  Files:  utils/perldoc.PL
+
+  Title:  "perldoc diffs: don't search auto - much faster"
+   From:  "Joseph N. Hall" <joseph@5sigma.com>
+ Msg-ID:  <MailDrop1.2d7dPPC.971012211957@screechy.cscaper.com>
+  Files:  utils/perldoc.PL
+
 
 
 ----------------
index 13f37ef..eb7dd8a 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -1764,7 +1764,6 @@ EOM
                        ;;
                linux) osname=linux
                        case "$3" in
-                       1*) osvers=1 ;;
                        *)      osvers="$3" ;;
                        esac
                        ;;
diff --git a/INSTALL b/INSTALL
index ffb755a..488a1ce 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -99,8 +99,11 @@ and Configure will use the defaults from then on.
 After it runs, Configure will perform variable substitution on all the
 *.SH files and offer to run make depend.
 
-Configure supports a number of useful options.  Run B<Configure -h>
-to get a listing.  To compile with gcc, for example, you can run
+Configure supports a number of useful options.  Run B<Configure -h> to
+get a listing.  See the Porting/Glossary file for a complete list of
+Configure variables you can set and their definitions.
+
+To compile with gcc, for example, you should run
 
        sh Configure -Dcc=gcc
 
@@ -325,12 +328,14 @@ and the following directories for manual pages:
 
 (Actually, Configure recognizes the SVR3-style
 /usr/local/man/l_man/man1 directories, if present, and uses those
-instead.) The module man pages are stuck in that strange spot so that
+instead.)
+
+The module man pages are stuck in that strange spot so that
 they don't collide with other man pages stored in /usr/local/man/man3,
 and so that Perl's man pages don't hide system man pages.  On some
 systems, B<man less> would end up calling up Perl's less.pm module man
-page, rather than the less program.  (This location may change in a
-future release of perl.)
+page, rather than the less program.  (This default location will likely
+change to /usr/local/man/man3 in a future release of perl.)
 
 Note:  Many users prefer to store the module man pages in
 /usr/local/man/man3.  You can do this from the command line with
@@ -423,6 +428,9 @@ installed on multiple systems.  Here's one way to do that:
     make test
     make install
     cd /tmp/perl5
+    # Edit lib/<archname>/<version>/Config.pm to change all the
+    # install* variables back to reflect where everything will
+    # really be installed.
     tar cvf ../perl5-archive.tar .
     # Then, on each machine where you want to install perl,
     cd /usr/local  # Or wherever you specified as $prefix
@@ -459,14 +467,17 @@ compatibility, answer "y".
 
 On the other hand, if you are embedding perl into another application
 and want the maximum namespace protection, then you probably ought to
-answer "n" when Configure asks if you want binary compatibility.
+answer "n" when Configure asks if you want binary compatibility, or
+disable it from the Configure command line with
+
+       sh Configure -Ud_bincompat3
 
 The default answer of "y" to maintain binary compatibility is probably
 appropriate for almost everyone.
 
-In a related issue, old extensions may possibly be affected by the changes
-in the Perl language in the current release.  Please see pod/perldelta for
-a description of what's changed.
+In a related issue, old extensions may possibly be affected by the
+changes in the Perl language in the current release.  Please see
+pod/perldelta.pod for a description of what's changed.
 
 =head2 Selecting File IO mechanisms
 
@@ -626,7 +637,7 @@ to point to the perl build directory.
 
 The only reliable answer is that you should specify a different
 directory for the architecture-dependent library for your -DDEBUGGING
-version of perl.  You can do this with by changing all the *archlib*
+version of perl.  You can do this by changing all the *archlib*
 variables in config.sh, namely archlib, archlib_exp, and
 installarchlib, to point to your new architecture-dependent library.
 
@@ -1159,9 +1170,9 @@ should run plain 'make' before 'make test' otherwise you won't have a
 complete build).  If 'make test' doesn't say "All tests successful"
 then something went wrong.  See the file t/README in the t subdirectory.
 
-If you want to run make test in the background you should 
 Note that you can't run the tests in background if this disables
-opening of /dev/tty.
+opening of /dev/tty. You can use 'make test-notty' in that case but
+a few tty tests will be skipped.
 
 If make test bombs out, just cd to the t directory and run ./TEST
 by hand to see if it makes any difference.  If individual tests
@@ -1174,10 +1185,10 @@ individual subtests is to cd to the t directory and run
 
        ./perl harness
 
-(this assumes that most tests succeed, since harness uses
+(this assumes that most basic tests succeed, since harness uses
 complicated constructs).
 
-You can also read the individual tests to see if there are any helpful
+You should also read the individual tests to see if there are any helpful
 comments that apply to your system.
 
 Note:  One possible reason for errors is that some external programs
@@ -1343,13 +1354,13 @@ to hand-edit some of the converted files to get them to parse
 correctly.  For example, h2ph breaks spectacularly on type casting and
 certain structures.
 
-=head installhtml --help
+=head1 installhtml --help
 
 Some sites may wish to make perl documentation available in HTML
 format.  The installhtml utility can be used to convert pod
-documentation into linked HTML files and install install them.
+documentation into linked HTML files and install them.
 
-The following command-line is an example of the one we use to convert
+The following command-line is an example of one used to convert
 perl documentation:
 
   ./installhtml                   \
@@ -1369,6 +1380,9 @@ see warnings like "no title", "unexpected directive" and "cannot
 resolve" as the files are processed. We are aware of these problems
 (and would welcome patches for them).
 
+You may find it helpful to run installhtml twice. That should reduce
+the number of "cannot resolve" warnings.
+
 =head1 cd pod && make tex && (process the latex files)
 
 Some sites may also wish to make the documentation in the pod/ directory
@@ -1417,10 +1431,14 @@ generate the documentation.
 
 =head1 AUTHOR
 
-Andy Dougherty doughera@lafcol.lafayette.edu , borrowing very heavily
-from the original README by Larry Wall, and also with lots of helpful
-feedback from the perl5-porters@perl.org folks.
+Original author:  Andy Dougherty doughera@lafcol.lafayette.edu ,
+borrowing very heavily from the original README by Larry Wall,
+with lots of helpful feedback and additions from the
+perl5-porters@perl.org folks.
+
+If you have problems or questions, please see L<"Reporting Problems">
+above.
 
 =head1 LAST MODIFIED
 
-$Id: INSTALL,v 1.22 1997/08/01 15:39:14 doughera Released $
+$Id: INSTALL,v 1.28 1997/10/10 16:50:59 doughera Released $
index 1977114..26a5409 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -206,7 +206,6 @@ ext/SDBM_File/typemap               SDBM extension interface types
 ext/Socket/Makefile.PL Socket extension makefile writer
 ext/Socket/Socket.pm   Socket extension Perl module
 ext/Socket/Socket.xs   Socket extension external subroutines
-ext/util/extliblist    Used by extension Makefile.PL to make lib lists
 ext/util/make_ext      Used by Makefile to execute extension Makefiles
 ext/util/mkbootstrap   Turns ext/*/*_BS into bootstrap info
 form.h                 Public declarations for the above
@@ -275,6 +274,7 @@ hints/next_3_0.sh   Hints for named architecture
 hints/next_4.sh                Hints for named architecture
 hints/opus.sh          Hints for named architecture
 hints/os2.sh           Hints for named architecture
+hints/os390.sh         Hints for named architecture
 hints/powerux.sh       Hints for named architecture
 hints/qnx.sh           Hints for named architecture
 hints/sco.sh           Hints for named architecture
@@ -400,6 +400,7 @@ lib/User/pwent.pm   By-name interface to Perl's builtin getpw*
 lib/abbrev.pl          An abbreviation table builder
 lib/assert.pl          assertion and panic with stack trace
 lib/autouse.pm         Load and call a function only when it's used
+lib/base.pm            Establish IS-A relationship at compile time
 lib/bigfloat.pl                An arbitrary precision floating point package
 lib/bigint.pl          An arbitrary precision integer arithmetic package
 lib/bigrat.pl          An arbitrary precision rational arithmetic package
@@ -652,6 +653,7 @@ t/lib/db-btree.t    See if DB_File works
 t/lib/db-hash.t                See if DB_File works
 t/lib/db-recno.t       See if DB_File works
 t/lib/dirhand.t                See if DirHandle works
+t/lib/dosglob.t                See if File::DosGlob works
 t/lib/english.t                See if English works
 t/lib/env.t            See if Env works
 t/lib/filecache.t      See if FileCache works
index 86fd6ed..f2a4a9f 100644 (file)
@@ -52,6 +52,9 @@ true)
                aixinstdir=`pwd | sed 's/\/UU$//'`
                linklibperl="-L $archlibexp/CORE -L $aixinstdir -lperl"
                ;;
+       hpux10*)
+               linklibperl="-L `pwd | sed 's/\/UU$//'` -Wl,+b$archlibexp/CORE -lperl"
+               ;;
        esac
        ;;
 *)     pldlflags=''
@@ -303,13 +306,13 @@ perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
        $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
 
 pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+       $(SHRPENV) purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
 
 purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+       $(SHRPENV) purecov $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
 
 quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+       $(SHRPENV) quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
 
 # This version, if specified in Configure, does ONLY those scripts which need
 # set-id emulation.  Suidperl must be setuid root.  It contains the "taint"
@@ -317,7 +320,7 @@ quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
 # has been invoked correctly.
 
 suidperl: $& sperl$(OBJ_EXT) perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs
-       $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+       $(SHRPENV) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain$(OBJ_EXT) sperl$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
 
 !NO!SUBS!
 
@@ -341,6 +344,8 @@ preplibrary: miniperl lib/Config.pm $(plextract)
                autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm
 
 # Take care to avoid modifying lib/Config.pm without reason
+# (If trying to create a new port and having problems with the configpm script, 
+# try 'make minitest' and/or commenting out the tests at the end of configpm.)
 lib/Config.pm: config.sh miniperl configpm
        ./miniperl configpm tmp
        sh mv-if-diff tmp lib/Config.pm
@@ -382,12 +387,14 @@ install.html: all installhtml
 run_byacc:     FORCE
        @ echo 'Expect' 113 shift/reduce and 1 reduce/reduce conflict
        $(BYACC) -d perly.y
+       chmod 664 perly.c
        sh $(shellflags) ./perly.fixer y.tab.c 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
        echo 'extern YYSTYPE yylval;' >>y.tab.h
        cmp -s y.tab.h perly.h && rm -f y.tab.h || mv y.tab.h perly.h
-       - perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms
+       chmod 664 vms/perly_c.vms vms/perly_h.vms
+       perl vms/vms_yfix.pl perly.c perly.h vms/perly_c.vms vms/perly_h.vms
 
 # We don't want to regenerate perly.c and perly.h, but they might
 # appear out-of-date after a patch is applied or a new distribution is
@@ -422,13 +429,13 @@ regen_headers:    FORCE
 # DynaLoader may be needed for extensions that use Makefile.PL.
 
 $(DYNALOADER): miniperl preplibrary FORCE
-       @sh ext/util/make_ext static $@ LIBPERL_A=$(LIBPERL)
+       @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
 
 d_dummy $(dynamic_ext):        miniperl preplibrary $(DYNALOADER) FORCE
-       @sh ext/util/make_ext dynamic $@ LIBPERL_A=$(LIBPERL)
+       @sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
 
 s_dummy $(static_ext): miniperl preplibrary $(DYNALOADER) FORCE
-       @sh ext/util/make_ext static $@ LIBPERL_A=$(LIBPERL)
+       @sh ext/util/make_ext static $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
 
 clean:         _tidy _mopup
 
@@ -453,7 +460,7 @@ _tidy:
        -cd utils; $(MAKE) clean
        -cd x2p; $(MAKE) clean
        -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \
-       sh ext/util/make_ext clean $$x ; \
+       sh ext/util/make_ext clean $$x MAKE=$(MAKE) ; \
        done
 
 # Do not 'make _cleaner' directly.
@@ -463,7 +470,7 @@ _cleaner:
        -cd utils; $(MAKE) realclean
        -cd x2p; $(MAKE) realclean
        -@for x in $(DYNALOADER) $(dynamic_ext) $(static_ext) ; do \
-       sh ext/util/make_ext realclean $$x ; \
+       sh ext/util/make_ext realclean $$x MAKE=$(MAKE) ; \
        done
        rm -f *.orig */*.orig *~ */*~ core t/core t/c t/perl
        rm -rf $(addedbyconf)
@@ -482,11 +489,13 @@ _cleaner:
 lint: perly.c $(c)
        lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz
 
-# Need to unset during recursion to go out of loop
+# Need to unset during recursion to go out of loop.
+# The README below ensures that the dependency list is never empty and
+# that when MAKEDEPEND is empty $(FIRSTMAKEFILE) doesn't need rebuilding.
 
 MAKEDEPEND = Makefile makedepend
 
-$(FIRSTMAKEFILE):      $(MAKEDEPEND)
+$(FIRSTMAKEFILE):      README $(MAKEDEPEND)
        $(MAKE) depend MAKEDEPEND=
 
 config.h: config_h.SH config.sh
@@ -497,7 +506,7 @@ perl.exp: perl_exp.SH config.sh
 
 # When done, touch perlmain.c so that it doesn't get remade each time.
 depend: makedepend
-       sh ./makedepend
+       sh ./makedepend MAKE=$(MAKE)
        - test -s perlmain.c && touch perlmain.c
        cd x2p; $(MAKE) depend
 
@@ -523,8 +532,10 @@ minitest: miniperl
        - cd t && (rm -f perl$(EXE_EXT); $(LNS) ../miniperl$(EXE_EXT) perl$(EXE_EXT)) \
                && ./perl TEST base/*.t comp/*.t cmd/*.t io/*.t op/*.t pragma/*.t </dev/tty
 
-# handy way to run perlbug -ok without having to install and run the
+# Handy way to run perlbug -ok without having to install and run the
 # installed perlbug. We don't re-run the tests here - we trust the user.
+# Please *don't* use this unless all tests pass.
+# If you want to report test failures, just use "perlbug -Ilib".
 ok:
        ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)'
 
index bc472ee..f719a5e 100644 (file)
@@ -27,6 +27,7 @@ $vers.= sprintf( "_%02d", $subversion) if $subversion;
 
 $perl = "perl$vers";
 $reldir = "$relroot/$perl";
+$reldir .= "-$ARGV[0]" if $ARGV[0];
 
 print "\nMaking a release for $perl in $reldir\n\n";
 
@@ -47,7 +48,9 @@ print "\n";
 
 
 print "Setting file permissions...\n";
-system("find . -type f -print | xargs chmod -w");
+system("find . -type f -print     | xargs chmod -w");
+system("find . -type d -print     | xargs chmod g-s");
+system("find t -name '*.t' -print | xargs chmod +x");
 system("chmod +w configure"); # special case (see pumpkin.pod)
 @exe = qw(
     Configure
@@ -76,7 +79,7 @@ print "\n";
 
 print "Creating $reldir release directory...\n";
 die "$reldir release directory already exists\n"   if -e "../$perl";
-die "$reldir.tar.gz release file already exists\n" if -e "../$perl.tar.gz";
+die "$reldir.tar.gz release file already exists\n" if -e "../$reldir.tar.gz";
 mkdir($reldir, 0755) or die "mkdir $reldir: $!\n";
 print "\n";
 
index f4de529..1d4bd5a 100644 (file)
@@ -9,33 +9,37 @@
 # modify it under the same terms as Perl itself.
 #
 # With thanks to Tom Horsley for the seed code.
-#
-# $Id: patchls,v 1.3 1997/06/10 21:38:45 timbo Exp $
+
 
 use Getopt::Std;
 use Text::Wrap qw(wrap $columns);
 use Text::Tabs qw(expand unexpand);
 use strict;
+use vars qw($VERSION);
+
+$VERSION = 2.04;
 
 sub usage {
 die q{
   patchls [options] patchfile [ ... ]
 
-    -i     Invert: for each patched file list which patch files patch it.
     -h     no filename headers (like grep), only the listing.
     -l     no listing (like grep), only the filename headers.
+    -i     Invert: for each patched file list which patch files patch it.
     -c     Categorise the patch and sort by category (perl specific).
     -m     print formatted Meta-information (Subject,From,Msg-ID etc).
     -p N   strip N levels of directory Prefix (like patch), else automatic.
     -v     more verbose (-d for noisy debugging).
     -f F   only list patches which patch files matching regexp F
            (F has $ appended unless it contains a /).
+  other options for special uses:
     -I     just gather and display summary Information about the patches.
+    -4     write to stdout the PerForce commands to prepare for patching.
+    -M T   Like -m but only output listed meta tags (eg -M 'Title From')
+    -W N   set wrap width to N (defaults to 70, use 0 for no wrap)
 }
 }
 
-$columns = 70;
-
 $::opt_p = undef;      # undef != 0
 $::opt_d = 0;
 $::opt_v = 0;
@@ -45,11 +49,21 @@ $::opt_h = 0;
 $::opt_l = 0;
 $::opt_c = 0;
 $::opt_f = '';
+
+# special purpose options
 $::opt_I = 0;
+$::opt_4 = 0;  # output PerForce commands to prepare for patching
+$::opt_M = ''; # like -m but only output these meta items (-M Title)
+$::opt_W = 70; # set wrap width columns (see Text::Wrap module)
 
 usage unless @ARGV;
 
-getopts("mihlvcp:f:I") or usage;
+getopts("mihlvc4p:f:IM:W:") or usage;
+
+$columns = $::opt_W || 9999999;
+
+$::opt_m = 1 if $::opt_M;
+my @show_meta = split(' ', $::opt_M || 'Title From Msg-ID');
 
 my %cat_title = (
     'BUILD'    => 'BUILD PROCESS',
@@ -57,7 +71,7 @@ my %cat_title = (
     'DOC'      => 'DOCUMENTATION',
     'LIB'      => 'LIBRARY AND EXTENSIONS',
     'PORT1'    => 'PORTABILITY - WIN32',
-    'PORT2'    => 'PORTABILITY - OTHER',
+    'PORT2'    => 'PORTABILITY - GENERAL',
     'TEST'     => 'TESTS',
     'UTIL'     => 'UTILITIES',
     'OTHER'    => 'OTHER CHANGES',
@@ -84,6 +98,8 @@ my %ls;
 #      Index: embed.h
 
 my($in, $prevline, $prevtype, $ls);
+my(@removed, @added);
+my $prologue = 1;      # assume prologue till patch or /^exit\b/ seen
 
 foreach my $argv (@ARGV) {
     $in = $argv;
@@ -96,16 +112,24 @@ foreach my $argv (@ARGV) {
     my $type;
     while (<F>) {
        unless (/^([-+*]{3}) / || /^(Index):/) {
-           # not an interesting patch line but possibly meta-information
+           # not an interesting patch line
+           # but possibly meta-information or prologue
+           if ($prologue) {
+               push @added, $1     if /^touch\s+(\S+)/;
+               push @removed, $1   if /^rm\s+(?:-f)?\s*(\S+)/;
+               $prologue = 0       if /^exit\b/;
+           }
            next unless $::opt_m;
-           $ls->{From}{$1}=1       if /^From:\s+(.*\S)/i;
-           $ls->{Title}{$1}=1      if /^Subject:\s+(?:Re: )?(.*\S)/i;
-           $ls->{'Msg-ID'}{$1}=1   if /^Message-Id:\s+(.*\S)/i;
-           $ls->{Date}{$1}=1       if /^Date:\s+(.*\S)/i;
+           $ls->{From}{$1}=1,next     if /^From:\s+(.*\S)/i;
+           $ls->{Title}{$1}=1,next    if /^Subject:\s+(?:Re: )?(.*\S)/i;
+           $ls->{'Msg-ID'}{$1}=1,next if /^Message-Id:\s+(.*\S)/i;
+           $ls->{Date}{$1}=1,next     if /^Date:\s+(.*\S)/i;
+           $ls->{$1}{$2}=1,next       if /^([-\w]+):\s+(.*\S)/;
            next;
        }
        $type = $1;
        next if /^--- [0-9,]+ ----$/ || /^\*\*\* [0-9,]+ \*\*\*\*$/;
+       $prologue = 0;
 
        print "Last: $prevline","This: ${_}Got:  $1\n\n" if $::opt_d;
 
@@ -113,12 +137,12 @@ foreach my $argv (@ARGV) {
        # Patch copes with this, so must we. It's also handy for
        # documenting manual changes by simply adding Index: lines
        # to the file which describes the problem bing fixed.
-       add_file($ls, $1), next if /^Index:\s+(.*)/;
+       add_file($ls, $1), next if /^Index:\s+(\S+)/;
 
        if (    ($type eq '---' and $prevtype eq '***') # Style 1
            or  ($type eq '+++' and $prevtype eq '---') # Style 2
        ) {
-           if (/^[-+*]{3} (\S+)\s+.*\d\d:\d\d:\d\d/) { # double check
+           if (/^[-+*]{3} (\S+)\s*(.*?\d\d:\d\d:\d\d)?/) {     # double check
                add_file($ls, $1);
            }
            else {
@@ -141,9 +165,9 @@ foreach my $argv (@ARGV) {
 print scalar(@ARGV)." files read.\n" if $::opt_v and @ARGV > 1;
 
 
-my @ls  = sort {
-    $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
-} values %ls;
+# --- Firstly we filter and sort as needed ---
+
+my @ls  = values %ls;
 
 if ($::opt_f) {                # filter out patches based on -f <regexp>
     my $out;
@@ -158,6 +182,24 @@ if ($::opt_f) {            # filter out patches based on -f <regexp>
     } @ls;
 }
 
+@ls  = sort {
+    $a->{category} cmp $b->{category} || $a->{in} cmp $b->{in}
+} @ls;
+
+
+# --- Handle special modes ---
+
+if ($::opt_4) {
+    print map { "p4 delete $_\n" } @removed if @removed;
+    print map { "p4 add    $_\n" } @added   if @added;
+    my @patches = grep { $_->{is_in} } @ls;
+    my %patched = map { ($_, 1) } map { keys %{$_->{out}} } @patches;
+    delete @patched{@added};
+    my @patched = sort keys %patched;
+    print map { "p4 edit   $_\n" } @patched if @patched;
+    exit 0;
+}
+
 if ($::opt_I) {
     my $n_patches = 0;
     my($in,$out);
@@ -171,12 +213,16 @@ if ($::opt_I) {
     my @all_out = sort keys %all_out;
     my @missing = grep { ! -f $_ } @all_out;
     print "$n_patches patch files patch ".@all_out." files (".@missing." missing)\n";
+    print "(use -v to list patches which patch 'missing' files)\n"
+           if @missing && !$::opt_v;
     if ($::opt_v and @missing) {
        print "Missing files:\n";
        foreach $out (@missing) {
            printf "  %-20s\t%s\n", $out, $all_out{$out};
        }
     }
+    print "Added files:   @added\n"   if @added;
+    print "Removed files: @removed\n" if @removed;
     exit 0+@missing;
 }
 
@@ -256,11 +302,27 @@ sub list_files_by_patch {
     $name = $ls->{in} unless defined $name;
     my @meta;
     if ($::opt_m) {
-       foreach(qw(Title From Msg-ID)) {
-           next unless $ls->{$_};
-           my @list = sort keys %{$ls->{$_}};
-           push @meta, sprintf "%7s:  ", $_;
-           @list = map { "\"$_\"" } @list if $_ eq 'Title';
+       my $meta;
+       foreach $meta (@show_meta) {
+           next unless $ls->{$meta};
+           my @list = sort keys %{$ls->{$meta}};
+           push @meta, sprintf "%7s:  ", $meta;
+           if ($meta eq 'Title') {
+               @list = map { s/\[?PATCH\]?:?\s*//g; "\"$_\""; } @list
+           }
+           elsif ($meta eq 'From') {
+               # fix-up bizzare addresses from japan and ibm :-)
+               foreach(@list) {
+                   s:\W+=?iso.*?<: <:;
+                   s/\d\d-\w\w\w-\d{4}\s+\d\d:\S+\s*//;
+               }
+           }
+           elsif ($meta eq 'Msg-ID') {
+               my %from; # limit long threads to one msg-id per site
+               @list = map {
+                   $from{(/@(.*?)>/ ? $1 : $_)}++ ? () : ($_);
+               } @list;
+           }
            push @meta, my_wrap("","          ", join(", ",@list)."\n");
        }
        $name = "\n$name" if @meta and $name;
index 5260e65..6706c6c 100644 (file)
@@ -41,6 +41,10 @@ Subscribe by sending the message (in the body of your letter)
 
 to perl5-porters-request@perl.org .
 
+Archives of the list are held at:
+
+    http://www.rosat.mpe-garching.mpg.de/mailing-lists/perl-porters/
+
 =head1 How are Perl Releases Numbered?
 
 Perl version numbers are floating point numbers, such as 5.004.
@@ -73,9 +77,10 @@ In addition, there may be "developer" sub-versions available.  These
 are not official releases.  They may contain unstable experimental
 features, and are subject to rapid change.  Such developer
 sub-versions are numbered with sub-version numbers.  For example,
-version 5.004_04 is the 4'th developer version built on top of
-5.004.  It might include the _01, _02, and _03 changes, but it
-also might not.  Sub-versions are allowed to be subversive.
+version 5.003_04 is the 4'th developer version built on top of
+5.003.  It might include the _01, _02, and _03 changes, but it
+also might not.  Sub-versions are allowed to be subversive. (But see
+the next section for recent changes.)
 
 These sub-versions can also be used as floating point numbers, so
 you can do things such as
@@ -100,6 +105,11 @@ way to distribute important bug fixes without waiting for the
 developers to untangle all the other problems in the current
 developer's release.
 
+Trial releases of bug-fix maintenance releases are announced on
+perl5-porters. Trial releases use the new subversion number (to avoid
+testers installing it over the previous release) and include a 'local
+patch' entry in patchlevel.h.
+
 Watch for announcements of maintenance subversions in
 comp.lang.perl.announce.
 
@@ -1157,14 +1167,14 @@ and/or fcntl() file locking.  It's a mess.
 
 =back
 
-=head1 AUTHOR
-
-Andy Dougherty <doughera@lafcol.lafayette.edu>.
+=head1 AUTHORS
 
-Additions by Chip Salzenberg <chip@perl.com>.
+Original author:  Andy Dougherty doughera@lafcol.lafayette.edu .
+Additions by Chip Salzenberg chip@perl.com and 
+Tim Bunce Tim.Bunce@ig.co.uk .
 
 All opinions expressed herein are those of the authorZ<>(s).
 
 =head1 LAST MODIFIED
 
-$Id: pumpkin.pod,v 1.10.1.1 1997/06/10 20:46:47 timbo Exp $
+$Id: pumpkin.pod,v 1.13 1997/08/28 18:26:40 doughera Released $
index 9a6a712..4b8c29d 100644 (file)
@@ -1,3 +1,383 @@
+Last Revised 11-September-1997 by Dan Sugalski <sugalsd@lbcc.cc.or.us>
+Originally by Charles Bailey <bailey@newman.upenn.edu>
+
+* Intro
+
+The VMS port of Perl is as functionally complete as any other Perl port
+(and as complete as the ports on some Unix systems). The Perl binaries
+provide all the Perl system calls that are either available under VMS or
+reasonably emulated. There are some incompatibilites in process handling
+(e.g the fork/exec model for creating subprocesses doesn't do what you
+might expect under Unix), mainly because VMS and Unix handle processes and
+sub-processes very differently.
+
+There are still some unimplemented system functions, and of coursse we
+could use modules implementing useful VMS system services, so if you'd like
+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
+relatively modern version, check the Dec C issues section later on in this
+document.
+
+* Other required software
+
+In addition to VMS, you'll need:
+        1) A C compiler. Dec C for AXP, or VAX C, 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.
+
+* Compiling Perl
+
+>From the top level of the Perl source directory, do this:
+
+MMS/DESCRIP=[.VMS]DESCRIP.MMS
+
+If you're on an Alpha, add /Macro=("__AXP__=1","decc=1")
+If you're using Dec C as your C compiler (you are on all alphas), add
+/Macro=("decc=1")
+If Vac C is your default C compiler and you want to use Dec C, add
+/Macro=("CC=CC/DECC") (Don't forget the /macro=("decc=1")
+If Dec C is your default C compiler and you want to use Vax C, add
+/Macro=("CC=CC/VAXC")
+If you want Socket support and are using the SOCKETSHR socket library, add
+/Macro=("SOCKETSHR_SOCKETS=1")
+If you want Socket support and are using the Dec C RTL socket interface
+(You must be using Dec C for this), add /Macro=("DECC_SOCKETS=1")
+
+If you have multiple /macro= items, combine them together in one /Macro=()
+switch, with all the options inside the parentheses separated by commas.
+
+Samples:
+
+VMS AXP, with Socketshr sockets:
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("decc=1","__AXP__=1","SOCKETSHR_SOCKETS=1")
+
+VMS AXP with no sockets
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("decc=1","__AXP__=1")
+
+VMS AXP with the Dec C RTL sockets
+
+$MMS/DESCRIP=[.VMS]/Macro=("decc=1","__AXP__=1","DECC_SOCKETS=1")
+
+VMS VAX with default system compiler, no sockets
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS
+
+VMS VAX with Dec C compiler, no sockets
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("CC=CC/DECC","decc=1")
+
+VMS VAX with Dec C compiler, Dec C RTL sockets
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("CC=CC/DECC","decc=1","DECC_SOCKETS=1")
+
+VMS VAX with Dec C compiler, Socketshr sockets
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("CC=CC/DECC","decc=1","SOCKETSHR_SOCKETS=1")
+
+Using Dec C is recommended over Vax C. The compiler is newer, and
+supported. (Vax C was decommisioned around 1993) Various older versions had
+some gotchas, so if you're using a version older than 5.2, check the Dec C
+Issues section.
+
+We'll also point out that Dec C will get you at least a ten-fold increase
+in line-oriented IO over Vax C. The optimizer is amazingly better, too. If
+you can use Dec C, then you *really*, *really* should.
+
+
+Once you issue your MMS command, sit back and wait. Perl should build and
+link without a problem. If it doesn't, check the Gotchas to watch out for
+section. If that doesn't help, send some mail to the VMSPERL mailing list.
+Instructions are in the Mailing Lists section.
+
+* Testing Perl
+
+Once Perl has built cleanly, you need to test it to make sure things work.
+This step is very important--there are always things that can go wrong
+somehow and get you a dysfunctional Perl.
+
+Testing is very easy, though, as there's a full test suite in the perl
+distribution. To run the tests, enter the *exact* MMS line you used to
+compile Perl and add the word "test" to the end, like this:
+
+Compile Command:
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1")
+
+Test Command:
+
+$MMS/DESCRIP=[.VMS]DESCRIP.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
+of all the tests, a summary of the tests, the number passed and failed, and
+the time taken will be displayed.
+
+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.
+
+If one or more tests fail, you can get more info on the failure by issuing
+this command sequence:
+
+$ SET DEFAULT [.T]
+$ @[-.VMS]TEST .typ -v [.subdir]test.T
+
+where ".typ" is the file type of the Perl images you just built (if you
+didn't do anything special, use .EXE), and "[.subdir]test.T" is the test
+that failed. For example, with a normal Perl build, if the test indicated
+that [.op]time failed, then you'd do this:
+
+$ SET DEFAULT [.T]
+$ @[-.VMS]TEST .EXE -v [.OP]TIME.T
+
+When you send in a bug report for failed tests, please include the output
+from this command, which is run from the main source directory:
+
+MCR []MINIPERL "-V"
+
+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.
+
+* Cleaning up and starting fresh
+
+If you need to recompile from scratch, you have to make sure you clean up
+first. There's a procedure to do it--enter the *exact* MMS line you used to
+compile and add "realclean" at the end, like this:
+
+Compile Command:
+
+$MMS/DESCRIP=[.VMS]DESCRIP.MMS/Macro=("__AXP__=1","decc=1","DECCRTL_SOCKETS=1")
+
+Cleanup Command:
+
+$MMS/DESCRIP=[.VMS]DESCRIP.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.
+
+* Installing Perl
+
+There are several steps you need to take to get Perl installed and
+running. At some point we'll have a working install in DESCRIP.MMS, but for
+right now the procedure's manual, and goes like this.
+
+1) Create a directory somewhere and define the concealed logical PERL_ROOT
+to point to it. For example, DEFINE/TRANS=(CONC,TERM) PERL_ROOT dka200:[perl.]
+
+2) Copy perl.exe into PERL_ROOT:[000000]
+
+3) Copy everything in [.LIB] and [.UTILS] (including all the
+subdirectories!) to PERL_ROOT:[LIB] and PERL_ROOT:[UTILS].
+
+4) Either copy PERLSHR.EXE to SYS$SHARE, or to somewhere globally accessble
+and define the logical PERLSHR to point to it (DEFINE PERLSHR
+PERL_ROOT:[000000]PERLSHR.EXE or something like that). The PerlShr image
+should have W:RE protections on it. (Just W:E triggers increased security in
+the image activator. Not a huge problem, but Perl will need to have any
+other shared image it accesses INSTALLed. It's a huge pain, so don't unless
+you know what you're doing)
+
+5) 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).
+
+6) Optionally define the command PERLDOC as 
+PERLDOC :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -T
+
+7) Optionally define the command PERLBUG (the Perl bug report generator) as
+PERLBUG :== $PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
+
+* Installing Perl into DCLTABLES
+
+Courtesy of Brad  Hughes:
+
+Put the following, modified to reflect where your .exe is, in PERL.CLD:
+
+define verb perl
+image perl_root:[exe]perl.exe
+cliflags (foreign)
+
+and then
+
+$ set command perl /table=sys$common:[syslib]dcltables.exe -
+ /output=sys$common:[syslib]dcltables.exe
+$ install replace sys$common:[syslib]dcltables.exe
+
+and you don't need perl :== $perl_root:[exe]perl.exe.
+
+* Changing compile-time things
+
+Most of the user-definable features of Perl are enabled or disabled in
+[.VMS]CONFIG.VMS. There's code in there to Do The Right Thing, but that may
+end up being the wrong thing for you. Make sure you understand what you're
+doing, since changes here can get you a busted perl.
+
+Odds are that there's nothing here to change, unless you're on a version of
+VMS later than 6.2 and Dec C later than 5.6. Even if you are, the correct
+values will still be chosen, most likely. Poking around here should be
+unnecessary.
+
+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.
+
+The most portable solution uses the SOCKETSHR library. In combination with
+either UCX or NetLib, this supports all the major TCP stacks (Multinet,
+Pathways, TCPWare, UCX, and CMU) on all versions of VMS Perl runs on, with
+all the compilers on both VAX and Alpha. The socket interface is also
+consistent across versions of VMS and C compilers. It has a problem with
+UDP sockets when used with Multinet, though, so you should be aware of
+that.
+
+The other solution available is to use the socket routines built into Dec
+C. Which routines are available depend on the version of VMS you're
+running, and require proper UCX emulation by your TCP/IP vendor.
+Relatively current versions of Multinet, TCPWare, Pathway, and UCX all
+provide the required libraries--check your manuals or release notes to see
+if your version is new enough.
+
+* Reporting Bugs
+
+If you come across what you think might be a bug in Perl, please report
+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
+
+Probably the single biggest gotcha in compiling Perl is giving the wrong
+switches to MMS/MMK when you build. If Perl's building oddly, double-check
+your switches. If you're on a VAX, be sure to add a /Macro=("decc=1") if
+you're using Dec C, and if you're on an alpha and using MMS, you'll need a
+/Macro=("__AXP__=1")
+
+The next big gotcha is directory depth. Perl can create directories four
+and five levels deep during the build, so you don't have to be too deep to
+start to hit the RMS 8 level point. It's best to do a
+$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.
+
+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"
+before you rebuild.
+
+* Dec C issues
+
+Note to DECC users: Some early versions (pre-5.2, some pre-4. If you're Dec
+C 5.x or higher, with current patches if anym you're fine) of the DECCRTL
+contained a few bugs which affect Perl performance:
+    - Newlines are lost on I/O through pipes, causing lines to run together.
+      This shows up as RMS RTB errors when reading from a pipe.  You can
+      work around this by having one process write data to a file, and
+      then having the other read the file, instead of the pipe.  This is
+      fixed in version 4 of DECC.
+    - The modf() routine returns a non-integral value for some values above
+      INT_MAX; the Perl "int" operator will return a non-integral value in
+      these cases.  This is fixed in version 4 of DECC.
+    - On the AXP, if SYSNAM privilege is enabled, the CRTL chdir() routine
+      changes the process default device and directory permanently, even
+      though the call specified that the change should not persist after
+      Perl exited.  This is fixed by DEC CSC patch AXPACRT04_061.
+
+* Mailing Lists
+
+There are several mailing lists available to the Perl porter. For VMS
+specific issues (including both Perl questions and installation problems)
+there is the VMSPERL mailing list. It's usually a low-volume (10-12
+messages a week) mailing list.
+
+The subscription address is VMSPERL-REQUEST@NEWMAN.UPENN.EDU. Send a mail
+message with just the words SUBSCRIBE VMSPERL in the body of the message.
+
+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
+
+A real big thanks needs to go to Charles Bailey
+<bailey@newman.upenn.edu>, who is ultimately responsible for Perl 5.004
+running on VMS. Without him, nothing the rest of us have done would be at
+all important.
+
+There are, of course, far too many people involved in the porting and testing
+of Perl to mention everyone who deserves it, so please forgive us if we've
+missed someone.  That said, special thanks are due to the following:
+  Tim Adye <T.J.Adye@rl.ac.uk>
+     for the VMS emulations of getpw*()
+  David Denholm <denholm@conmat.phys.soton.ac.uk>
+     for extensive testing and provision of pipe and SocketShr code,
+  Mark Pizzolato <mark@infocomm.com>
+     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
+gratitude is due to Larry Wall <larry@wall.org>, for having the ideas which
+have made our sleepless nights possible.
+
+Thanks,
+The VMSperl group
+
+
+---------------------------------------------------------------------------
+[Here's the pre-5.004_04 version of README.vms, for the record.]
+
 Last revised: 19-Jan-1996 by Charles Bailey  bailey@genetics.upenn.edu
 
 The VMS port of Perl is still under development.  At this time, the Perl
diff --git a/av.c b/av.c
index 6b4c03d..4a87eaf 100644 (file)
--- a/av.c
+++ b/av.c
 #include "EXTERN.h"
 #include "perl.h"
 
-static void    av_reify _((AV* av));
-
-static void
+void
 av_reify(av)
 AV* av;
 {
     I32 key;
     SV* sv;
-    
+
+    if (AvREAL(av))
+       return;
     key = AvMAX(av) + 1;
     while (key > AvFILL(av) + 1)
        AvARRAY(av)[--key] = &sv_undef;
@@ -324,6 +324,9 @@ register AV *av;
        SvPVX(av) = (char*)AvALLOC(av);
     }
     AvFILL(av) = -1;
+
+    if (SvRMAGICAL(av))
+       mg_clear((SV*)av); 
 }
 
 void
index 8ea1420..0c6a965 100755 (executable)
--- a/configpm
+++ b/configpm
@@ -180,6 +180,9 @@ ENDOFSET
 
 print CONFIG <<'ENDOFTAIL';
 
+# avoid Config..Exporter..UNIVERSAL search for DESTROY then AUTOLOAD
+sub DESTROY { }
+
 tie %Config, 'Config';
 
 1;
diff --git a/doop.c b/doop.c
index 763b1a9..571a9aa 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -440,6 +440,7 @@ SV *right;
            break;
        }
     }
+    SvTAINT(sv);
 }
 
 OP *
index 4d871b9..e0dc551 100644 (file)
@@ -18,7 +18,7 @@ print "semaphore id: $id\n";
 if ($signal) {
        while (<STDIN>) {
                print "Signalling\n";
-               unless (semop($id, 0, pack("sss", 0, 1, 0))) {
+               unless (semop($id, pack("sss", 0, 1, 0))) {
                        die "Can't signal semaphore: $!\n";
                }
        }
@@ -26,7 +26,7 @@ if ($signal) {
 else {
        $SIG{'INT'} = $SIG{'QUIT'} = "leave";
        for (;;) {
-               unless (semop($id, 0, pack("sss", 0, -1, 0))) {
+               unless (semop($id, pack("sss", 0, -1, 0))) {
                        die "Can't wait for semaphore: $!\n";
                }
                print "Unblocked\n";
index 017a7a2..b00d77a 100644 (file)
@@ -32,7 +32,7 @@
 ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
 ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
 
-;; $Id: cperl-mode.el,v 1.33 1997/03/14 06:45:51 ilya Exp ilya $
+;; $Id: cperl-mode.el,v 1.39 1997/10/14 08:28:00 ilya Exp ilya $
 
 ;;; To use this mode put the following into your .emacs file:
 
@@ -53,7 +53,7 @@
 ;;; Additional useful commands to put into your .emacs file:
 
 ;; (setq auto-mode-alist
-;;       (append '(("\\.[pP][Llm]$" . perl-mode))  auto-mode-alist ))
+;;      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
 ;; (setq interpreter-mode-alist (append interpreter-mode-alist
 ;;                                     '(("miniperl" . perl-mode))))
 
 ;;;; `cperl-use-syntax-table-text-property'.
 
 ;;;; After 1.32.3
-;;;  We scan for s{}[] as well.
+;;;  We scan for s{}[] as well (in simplest situations).
 ;;;  We scan for $blah'foo as well.
 ;;;  The default is to use `syntax-table' text property if Emacs is good enough.
 ;;;  `cperl-lineup' is put on C-M-| (=C-M-S-\\).
 ;;; Generation of Class Hierarchy was broken due to a bug in `x-popup-menu'
 ;;;  in 19.34.
 
+;;;; After 1.33:
+;;; my,local highlight vars after {} too.
+;;; TAGS could not be created before imenu was loaded.
+;;; `cperl-indent-left-aligned-comments' created.
+;;; Logic of `cperl-indent-exp' changed a little bit, should be more
+;;;  robust w.r.t. multiline strings.
+;;; Recognition of blah'foo takes into account strings.
+;;; Added '.al' to the list of Perl extensions.
+;;; Class hierarchy is "mostly" sorted (need to rethink algorthm
+;;;  of pruning one-root-branch subtrees to get yet better sorting.)
+;;; Regeneration of TAGS was busted.
+;;; Can use `syntax-table' property when generating TAGS
+;;;  (governed by  `cperl-use-syntax-table-text-property-for-tags').
+
+;;;; After 1.35:
+;;; Can process several =pod/=cut sections one after another.
+;;; Knows of `extproc' when under `emx', indents with `__END__' and `__DATA__'.
+;;; `cperl-under-as-char' implemented (XEmacs people like broken behaviour).
+;;; Beautifier for regexps fixed.
+;;; `cperl-beautify-level', `cperl-contract-level' coded
+;;;
+;;;; Emacs's 20.2 problems:
+;;; `imenu.el' has bugs, `imenu-add-to-menubar' does not work.
+;;; Couple of others problems with 20.2 were reported, my ability to check/fix
+;;; them is very reduced now.
+
+;;;; After 1.36:
+;;;  'C-M-|' in XEmacs fixed
+
+;;;; After 1.37:
+;;;  &&s was not recognized as start of regular expression;
+;;;  Will "preprocess" the contents of //e part of s///e too;
+;;;  What to do with s# blah # foo #e ?
+;;;  Should handle s;blah;foo;; better.
+;;;  Now the only known problems with regular expression recognition:
+;;;;;;;  s<foo>/bar/   - different delimiters (end ignored)
+;;;;;;;  s/foo/\\bar/  - backslash at start of subst (made into one chunk)
+;;;;;;;  s/foo//       - empty subst (made into one chunk + '/')
+;;;;;;;  s/foo/(bar)/  - start-group at start of subst (internal group will not match backwards)
+
+;;;; After 1.38:
+;;;  We highlight closing / of s/blah/foo/e;
+;;;  This handles s# blah # foo #e too;
+;;;  s//blah/, s///, s/blah// works again, and s#blah## too, the algorithm
+;;;   is much simpler now;
+;;;  Next round of changes: s\\\ works, s<blah>/foo/, 
+;;;   comments between the first and the second part allowed
+;;;  Another problem discovered:
+;;;;;;;  s[foo] <blah>e        - e part delimited by different <> (will not match)
+;;;  `cperl-find-pods-heres' somehow maybe called when string-face is undefined
+;;;   - put a stupid workaround for 20.1
+
 (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
 \f
 (defvar cperl-extra-newline-before-brace nil
@@ -474,7 +526,8 @@ Can be overwritten by `cperl-hairy' if nil.")
 Can be overwritten by `cperl-hairy' if nil.")
 
 (defvar cperl-electric-parens-string "({[]})<"
-  "*String of parentheses that should be electric in CPerl.")
+  "*String of parentheses that should be electric in CPerl.
+Closing ones are electric only if the region is highlighted.")
 
 (defvar cperl-electric-parens nil
   "*Non-nil (and non-null) means parentheses should be electric in CPerl.
@@ -488,10 +541,6 @@ Can be overwritten by `cperl-hairy' if nil.")
   "*Not-nil means that electric parens look for active mark.
 Default is yes if there is visual feedback on mark.")
 
-(defvar cperl-electric-parens-mark (and window-system transient-mark-mode)
-  "*Not-nil means that electric parens look for active mark.
-Default is yes if there is visual feedback on mark.")
-
 (defvar cperl-electric-linefeed nil
   "*If true, LFD should be hairy in CPerl, otherwise C-c LFD is hairy.
 In any case these two mean plain and hairy linefeeds together.
@@ -551,11 +600,14 @@ May require patched `imenu' and `imenu-go'.")
 Older version of this page was called `perl5', newer `perl'.")
 
 (defvar cperl-use-syntax-table-text-property 
-  (and (not cperl-xemacs-p)
-       (string< "19.34.94" emacs-version)) ; Not all .94 are good, but anyway
+  (boundp 'parse-sexp-lookup-properties)
   "*Non-nil means CPerl sets up and uses `syntax-table' text property.")
 
-(defvar cperl-scan-files-regexp "\\.\\([Pp][Llm]\\|xs\\)$"
+(defvar cperl-use-syntax-table-text-property-for-tags 
+  cperl-use-syntax-table-text-property
+  "*Non-nil means: set up and use `syntax-table' text property generating TAGS.")
+
+(defvar cperl-scan-files-regexp "\\.\\([pP][Llm]\\|xs\\)$"
   "*Regexp to match files to scan when generating TAGS.")
 
 (defvar cperl-noscan-files-regexp "/\\(\\.\\.?\\|SCCS\\|RCS\\|blib\\)$"
@@ -565,6 +617,13 @@ Older version of this page was called `perl5', newer `perl'.")
   "*indentation used when beautifying regexps.
 If `nil', the value of `cperl-indent-level' will be used.")
 
+(defvar cperl-indent-left-aligned-comments t
+  "*Non-nil means that the comment starting in leftmost column should indent.")
+
+(defvar cperl-under-as-char t
+  "*Non-nil means that the _ (underline) should be treated as word char.")
+
+
 \f
 
 ;;; Short extra-docs.
@@ -798,11 +857,14 @@ progress indicator for indentation (with `imenu' loaded).
   (put-text-property (max (point-min) (1- from))
                     to cperl-do-not-fontify t))
 
+(defvar cperl-mode-hook nil
+  "Hook run by `cperl-mode'.")
+
 \f
 ;;; Probably it is too late to set these guys already, but it can help later:
 
 (setq auto-mode-alist
-      (append '(("\\.[pP][Llm]$" . perl-mode))  auto-mode-alist ))
+      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
 (and (boundp 'interpreter-mode-alist)
      (setq interpreter-mode-alist (append interpreter-mode-alist
                                          '(("miniperl" . perl-mode)))))
@@ -847,7 +909,8 @@ progress indicator for indentation (with `imenu' loaded).
   (cperl-define-key "\C-c\C-k" 'cperl-toggle-abbrev)
   (cperl-define-key "\C-c\C-e" 'cperl-toggle-electric)
   (cperl-define-key "\e\C-q" 'cperl-indent-exp) ; Usually not bound
-  (cperl-define-key [?\C-\M-\|] 'cperl-lineup)
+  (cperl-define-key [?\C-\M-\|] 'cperl-lineup
+                   [(control meta |)])
   ;;(cperl-define-key "\M-q" 'cperl-fill-paragraph)
   ;;(cperl-define-key "\e;" 'cperl-indent-for-comment)
   (cperl-define-key "\177" 'cperl-electric-backspace)
@@ -883,6 +946,7 @@ progress indicator for indentation (with `imenu' loaded).
      'indent-for-comment 'cperl-indent-for-comment
      cperl-mode-map global-map)))
 
+(defvar cperl-menu)
 (condition-case nil
     (progn
       (require 'easymenu)
@@ -897,6 +961,10 @@ progress indicator for indentation (with `imenu' loaded).
           ["Line up a construction" cperl-lineup (cperl-use-region-p)]
           ["Beautify a regexp" cperl-beautify-regexp
            cperl-use-syntax-table-text-property]
+          ["Beautify a group in regexp" cperl-beautify-level
+           cperl-use-syntax-table-text-property]
+          ["Contract a group in regexp" cperl-contract-level
+           cperl-use-syntax-table-text-property]
           "----"
           ["Indent region" cperl-indent-region (cperl-use-region-p)]
           ["Comment region" cperl-comment-region (cperl-use-region-p)]
@@ -936,7 +1004,7 @@ progress indicator for indentation (with `imenu' loaded).
              (cperl-write-tags nil t t t) t]
             ["Add tags for Perl files in (sub)directories"
              (cperl-write-tags nil nil t t) t])
-           ["Recalculate PODs and HEREs" cperl-find-pods-heres t]
+           ["Recalculate \"hard\" constructions" cperl-find-pods-heres t]
            ["Define word at point" imenu-go-find-at-position 
             (fboundp 'imenu-go-find-at-position)]
            ["Help on function" cperl-info-on-command t]
@@ -992,7 +1060,8 @@ The expansion is entirely correct because it uses the C preprocessor."
   (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
   (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
   (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
-  (modify-syntax-entry ?_ "w" cperl-mode-syntax-table)
+  (if cperl-under-as-char
+      (modify-syntax-entry ?_ "w" cperl-mode-syntax-table))
   (modify-syntax-entry ?: "_" cperl-mode-syntax-table)
   (modify-syntax-entry ?| "." cperl-mode-syntax-table)
   (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))
@@ -1014,6 +1083,9 @@ The expansion is entirely correct because it uses the C preprocessor."
 ;; provide an alias for working with emacs 19.  the perl-mode that comes
 ;; with it is really bad, and this lets us seamlessly replace it.
 (fset 'perl-mode 'cperl-mode)
+(defvar cperl-faces-init)
+;; Fix for msb.el
+(defvar cperl-msb-fixed nil)
 (defun cperl-mode ()
   "Major mode for editing Perl code.
 Expression and list commands understand all C brackets.
@@ -1229,7 +1301,8 @@ with no args."
   (if cperl-use-syntax-table-text-property
       (progn
        (make-variable-buffer-local 'parse-sexp-lookup-properties)
-       (setq parse-sexp-lookup-properties t)))
+       ;; Do not introduce variable if not needed, we check it!
+       (set 'parse-sexp-lookup-properties t)))
   (or (fboundp 'cperl-old-auto-fill-mode)
       (progn
        (fset 'cperl-old-auto-fill-mode (symbol-function 'auto-fill-mode))
@@ -1266,8 +1339,6 @@ with no args."
                                nil nil
                                '(gud-perldb-history . 1))))
 \f
-;; Fix for msb.el
-(defvar cperl-msb-fixed nil)
 
 (defun cperl-msb-fix ()
   ;; Adds perl files to msb menu, supposes that msb is already loaded
@@ -1881,7 +1952,9 @@ Returns nil if line starts inside a string, t if in a comment."
               '(pod here-doc here-doc-delim format))
         ;; before start of POD - whitespace found since do not have 'pod!
         (and (looking-at "[ \t]*\n=")
-             (error "Spaces before pod section!")))
+             (error "Spaces before pod section!"))
+        (and (not cperl-indent-left-aligned-comments)
+             (looking-at "^#")))
        nil
      (beginning-of-line)
      (let ((indent-point (point))
@@ -2384,20 +2457,118 @@ Returns true if comment is found."
                               'syntax-table cperl-string-syntax-table))
        (cperl-protect-defun-start bb e))))
 
+(defun cperl-forward-re (is-2arg set-st st-l err-l argument
+                                &optional ostart oend)
+  ;; Unfinished
+  ;; Works *before* syntax recognition is done
+  ;; May modify syntax-type text property if the situation is too hard
+  (let (b starter ender st i i2)
+    (skip-chars-forward " \t")
+    ;; ender means matching-char matcher.
+    (setq b (point) 
+         starter (char-after b)
+         ;; ender:
+         ender (cdr (assoc starter '(( ?\( . ?\) )
+                                     ( ?\[ . ?\] )
+                                     ( ?\{ . ?\} )
+                                     ( ?\< . ?\> )
+                                     ))))
+    ;; What if starter == ?\\  ????
+    (if set-st
+       (if (car st-l)
+           (setq st (car st-l))
+         (setcar st-l (make-syntax-table))
+         (setq i 0 st (car st-l))
+         (while (< i 256)
+           (modify-syntax-entry i "." st)
+           (setq i (1+ i)))
+         (modify-syntax-entry ?\\ "\\" st)))
+    (setq set-st t)
+    ;; Whether we have an intermediate point
+    (setq i nil)
+    ;; Prepare the syntax table:
+    (and set-st
+        (if (not ender)                ; m/blah/, s/x//, s/x/y/
+            (modify-syntax-entry starter "$" st)
+          (modify-syntax-entry starter (concat "(" (list ender)) st)
+          (modify-syntax-entry ender  (concat ")" (list starter)) st)))
+    (condition-case bb
+       (progn
+         (if (and (eq starter (char-after (cperl-1+ b)))
+                  (not ender))
+             ;; $ has TeXish matching rules, so $$ equiv $...
+             (forward-char 2)
+           (set-syntax-table st)
+           (forward-sexp 1)
+           (set-syntax-table cperl-mode-syntax-table)
+           ;; Now the problem is with m;blah;;
+           (and (not ender)
+                (eq (preceding-char)
+                    (char-after (- (point) 2)))
+                (save-excursion
+                  (forward-char -2)
+                  (= 0 (% (skip-chars-backward "\\\\") 2)))
+                (forward-char -1)))
+         (and is-2arg                  ; Have trailing part
+              (not ender)
+              (eq (following-char) starter) ; Empty trailing part
+              (if (eq (char-syntax (following-char)) ?.)
+                  (setq is-2arg nil)   ; Ignore the tail
+                ;; Make trailing letter into punctuation
+                (setq is-2arg nil)     ; Ignore the tail
+                (put-text-property (point) (1+ (point))
+                                   'syntax-table cperl-st-punct)
+                (put-text-property (point) (1+ (point)) 'rear-nonsticky t)))
+         (if is-2arg                   ; Not number => have second part
+             (progn
+               (setq i (point) i2 i)
+               (if ender
+                   (if (eq (char-syntax (following-char)) ?\ )
+                       (progn
+                         (while (looking-at "\\s *#")
+                           (beginning-of-line 2))
+                         (skip-chars-forward " \t\n\f")
+                         (setq i2 (point))))
+                 (forward-char -1))
+               (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
+               (if ender (modify-syntax-entry ender "." st))           
+               (setq set-st nil)
+               (setq 
+                ender
+                (cperl-forward-re nil t st-l err-l argument starter ender)
+                ender (nth 2 ender)))))
+      (error (goto-char (point-max))
+            (message
+             "End of `%s%s%c ... %c' string not found: %s"
+             argument
+             (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
+             starter (or ender starter) bb)
+            (or (car err-l) (setcar err-l b))))
+    (if set-st
+       (progn
+         (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
+         (if ender (modify-syntax-entry ender "." st))))
+    (list i i2 ender starter)))
+
 (defun cperl-find-pods-heres (&optional min max)
-  "Scans the buffer for POD sections and here-documents.
+  "Scans the buffer for hard-to-parse Perl constructions.
 If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify 
 the sections using `cperl-pod-head-face', `cperl-pod-face', 
 `cperl-here-face'."
   (interactive)
   (or min (setq min (point-min)))
   (or max (setq max (point-max)))
-  (let (face head-face here-face b e bb tag qtag err b1 e1 argument st i c
+  (let (face head-face here-face b e bb tag qtag b1 e1 argument i c tail state 
             (cperl-pod-here-fontify (eval cperl-pod-here-fontify))
             (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
             (modified (buffer-modified-p))
             (after-change-functions nil)
-            (state-point (point-min)) state
+            (state-point (point-min)) 
+            (st-l '(nil)) (err-l '(nil)) i2
+            ;; Somehow font-lock may be not loaded yet...
+            (font-lock-string-face (if (boundp 'font-lock-string-face)
+                                       font-lock-string-face
+                                     'font-lock-string-face))
             (search
              (concat
               "\\(\\`\n?\\|\n\n\\)=" 
@@ -2434,12 +2605,16 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                    "\\$\\(['{]\\)"
                    "\\|"
                    ;; 1+6+2+1+1+2+1=14 extra () before this:
-                   "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
+                   "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'"
+                   ;; 1+6+2+1+1+2+1+1=15 extra () before this:
+                   "\\|"
+                   "__\\(END\\|DATA\\)__"  ; Commented - does not help with indent...
+                   )
                 ""))))
     (unwind-protect
        (progn
          (save-excursion
-           (message "Scanning for pods, formats and here-docs...")
+           (message "Scanning for \"hard\" Perl constructions...")
            (if cperl-pod-here-fontify
                ;; We had evals here, do not know why...
                (setq face cperl-pod-face
@@ -2449,6 +2624,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                    '(syntax-type t in-pod t syntax-table t))
            ;; Need to remove face as well...
            (goto-char min)
+           (if (and (eq system-type 'emx)
+                    (looking-at "extproc[ \t]")) ; Analogue of #!
+               (cperl-commentify min 
+                                 (save-excursion (end-of-line) (point))
+                                 nil))
            (while (re-search-forward search max t)
              (cond 
               ((match-beginning 1)     ; POD section
@@ -2456,14 +2636,14 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                (if (looking-at "\n*cut\\>")
                    (progn
                      (message "=cut is not preceded by a pod section")
-                     (or err (setq err (point))))
+                     (or (car err-l) (setcar err-l (point))))
                  (beginning-of-line)
                
                  (setq b (point) bb b)
                  (or (re-search-forward "\n\n=cut\\>" max 'toend)
                      (progn
                        (message "Cannot find the end of a pod section")
-                       (or err (setq err b))))
+                       (or (car err-l) (setcar err-l b))))
                  (beginning-of-line 2) ; An empty line after =cut is not POD!
                  (setq e (point))
                  (put-text-property b e 'in-pod t)
@@ -2499,7 +2679,9 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                (match-beginning 1) (match-end 1)
                                'face head-face))))
                  (cperl-commentify bb e nil)
-                 (goto-char e)))
+                 (goto-char e)
+                 (or (eq e (point-max))
+                     (forward-char -1)))) ; Prepare for immediate pod start.
               ;; Here document
               ;; We do only one here-per-line
               ;; 1 () ahead
@@ -2548,7 +2730,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                         (cperl-commentify b e1 nil)
                         (cperl-put-do-not-fontify b (match-end 0)))
                        (t (message "End of here-document `%s' not found." tag)
-                          (or err (setq err b))))))
+                          (or (car err-l) (setcar err-l b))))))
               ;; format
               ((match-beginning 8)
                ;; 1+6=7 extra () before this:
@@ -2587,7 +2769,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                      (cperl-commentify (point) (+ (point) 2) nil)
                      (cperl-put-do-not-fontify (point) (+ (point) 2)))
                  (message "End of format `%s' not found." name)
-                 (or err (setq err b)))
+                 (or (car err-l) (setcar err-l b)))
                (forward-line)
                (put-text-property b (point) 'syntax-type 'format)
 ;;;           (cond ((re-search-forward (concat "^[.;]$") max 'toend)
@@ -2604,23 +2786,29 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
               ;; Regexp:
               ((or (match-beginning 10) (match-beginning 11))
                ;; 1+6+2=9 extra () before this:
-               ;; "\\<\\(qx?\\|[my]\\)\\>"
+               ;; "\\<\\(q[wxq]?\\|[msy]\\|tr\\)\\>"
+               ;; "\\|"
+               ;; "\\([?/]\\)" ; /blah/ or ?blah?
                (setq b1 (if (match-beginning 10) 10 11)
                      argument (buffer-substring
                                (match-beginning b1) (match-end b1))
                      b (point)
                      i b
                      c (char-after (match-beginning b1))
-                     bb (or
-                         (memq (char-after (1- (match-beginning b1)))
-                               '(?\$ ?\@ ?\% ?\& ?\*))
-                         (and
-                          (eq (char-after (1- (match-beginning b1))) ?-)
-                          (eq (char-after (match-beginning b1)) ?s))))
+                     bb (char-after (1- (match-beginning b1))) ; tmp holder
+                     bb (and           ; user variables/whatever
+                         (match-beginning 10)
+                         (or
+                          (memq bb '(?\$ ?\@ ?\% ?\*))
+                          (and (eq bb ?-) (eq c ?s)) ; -s file test
+                          (and (eq bb ?\&) ; &&m/blah/
+                               (not (eq (char-after 
+                                         (- (match-beginning b1) 2))
+                                        ?\&))))))
                (or bb
                    (if (eq b1 11)      ; bare /blah/ or ?blah?
                        (setq argument ""
-                            bb 
+                            bb         ; Not a regexp?
                             (progn
                               (goto-char (match-beginning b1))
                               (cperl-backward-to-noncomment (point-min))
@@ -2635,7 +2823,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                                             (progn
                                               (forward-sexp -1)
                                               (looking-at 
-                                               "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\)\\>")))
+                                               "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))
                                        (and (eq (preceding-char) ?.)
                                             (eq (char-after (- (point) 2)) ?.))
                                        (bobp))))
@@ -2647,83 +2835,32 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                (if (or bb (nth 3 state) (nth 4 state))
                    (goto-char i)
                  (skip-chars-forward " \t")
-                 ;; qtag means two-argument matcher, may be reset to
-                 ;; 2 or 3 later if some special quoting is needed.
-                 (setq b (point) 
-                       tag (char-after b)
-                       qtag (if (string-match "^\\([sy]\\|tr\\)$" argument) t)
-                       e1 (cdr (assoc tag '(( ?\( . ?\) )
-                                            ( ?\[ . ?\] )
-                                            ( ?\{ . ?\} )
-                                            ( ?\< . ?\> )
-                                            ))))
-                 ;; What if tag == ?\\  ????
-                 (or st 
-                     (progn
-                       (setq st (make-syntax-table) i 0)
-                       (while (< i 256)
-                         (modify-syntax-entry i "." st)
-                         (setq i (1+ i)))
-                       (modify-syntax-entry ?\\ "\\" st)))
-                 ;; Whether we have an intermediate point
-                 (setq i nil)
-                 ;; Prepare the syntax table:
-                 (cond
-                  ;; $ has TeXish matching rules, so $$ equiv $...
-                  ((and qtag 
-                        (not e1) 
-                        (eq tag (char-after (cperl-1+ b)))
-                        (eq tag (char-after (+ 2 b))))
-                   (setq qtag 3))      ; s///
-                  ((and qtag
-                        (not e1) 
-                        (eq tag (char-after (cperl-1+ b))))
-                   (setq qtag nil))    ; s//blah/, will work anyway
-                  ((and (not e1) 
-                        (eq tag (char-after (cperl-1+ b))))
-                   (setq qtag 2))      ; m//
-                  ((not e1)
-                   (modify-syntax-entry tag "$" st)) ; m/blah/, s/x//, s/x/y/
-                  (t                   ; s{}(), m[]
-                   (modify-syntax-entry tag (concat "(" (list e1)) st)
-                   (modify-syntax-entry e1  (concat ")" (list tag)) st)))
-                 (if (numberp qtag)
-                     (forward-char qtag)
-                   (condition-case bb
-                       (progn
-                         (set-syntax-table st)
-                         (forward-sexp 1) ; Wrong if m// - taken care of...
-                         (if qtag
-                             (if e1 
-                                 (progn
-                                   (setq i (point))
-                                   (set-syntax-table cperl-mode-syntax-table)
-                                   (forward-sexp 1)) ; Should be smarter?
-                               ;; "$" has funny matching rules
-                               (if (/= (char-after (- (point) 2)) 
-                                       (preceding-char))
-                                   (progn
-                                     ;; Commenting \\ is dangerous, what about ( ?
-                                     (if (eq (following-char) ?\\) nil
-                                       (setq i (point)))
-                                     (forward-char -1)
-                                     (forward-sexp 1)))
-                               )))
-                     (error (goto-char (point-max))
-                            (message
-                             "End of `%s%c ... %c' string not found: %s"
-                             argument tag (or e1 tag) bb)
-                            (or err (setq err b)))))
-                 (set-syntax-table cperl-mode-syntax-table)
+                 ;; qtag means two-arg matcher, may be reset to
+                 ;;   2 or 3 later if some special quoting is needed.
+                 ;; e1 means matching-char matcher.
+                 (setq b (point)
+                       i (cperl-forward-re 
+                          (string-match "^\\([sy]\\|tr\\)$" argument)
+                          t st-l err-l argument)
+                       i2 (nth 1 i)    ; start of the second part
+                       e1 (nth 2 i)    ; ender, true if matching second part
+                       i (car i)       ; intermediate point
+                       tail (if (and i (not e1)) (1- (point))))
+                 ;; Commenting \\ is dangerous, what about ( ?
+                 (and i tail
+                      (eq (char-after i) ?\\)
+                      (setq i nil tail nil))
                  (if (null i)
                      (cperl-commentify b (point) t)
                    (cperl-commentify b i t)
-                   (if (looking-at "\\sw*e") nil ; s///e
-                     (cperl-commentify i (point) t)))
+                   (if (looking-at "\\sw*e") ; s///e
+                       (cperl-find-pods-heres i2 (1- (point)))
+                     (cperl-commentify i2 (point) t)
+                     (setq tail nil)))
                  (if (eq (char-syntax (following-char)) ?w)
-                     (forward-word 1)) ; skip modifiers s///s
-                 (modify-syntax-entry tag "." st)
-                 (if e1 (modify-syntax-entry e1 "." st))))
+                     (progn
+                       (forward-word 1) ; skip modifiers s///s
+                       (if tail (cperl-commentify tail (point) t))))))
               ((match-beginning 13)    ; sub with prototypes
                (setq b (match-beginning 0))
                (if (memq (char-after (1- b))
@@ -2737,6 +2874,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                    ;; Mark as string
                    (cperl-commentify (match-beginning 13) (match-end 13) t))
                  (goto-char (match-end 0))))
+              ;; 1+6+2+1+1+2=13 extra () before this:
+              ;;    "\\$\\(['{]\\)"
               ((and (match-beginning 14)
                 (eq (preceding-char) ?\')) ; $'
                (setq b (1- (point))
@@ -2748,13 +2887,38 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
                      (put-text-property (1- b) b 'syntax-table cperl-st-punct)
                      (put-text-property (1- b) b 'rear-nonsticky t)))
                (goto-char (1+ b)))
+              ;; 1+6+2+1+1+2=13 extra () before this:
+              ;;    "\\$\\(['{]\\)"
               ((match-beginning 14)    ; ${
                (setq bb (match-beginning 0))
                (put-text-property bb (1+ bb) 'syntax-table cperl-st-punct)
                (put-text-property bb (1+ bb) 'rear-nonsticky t))
-              (t                       ; old $abc'efg syntax
-               (setq bb (match-end 0))
-               (put-text-property (1- bb) bb 'syntax-table cperl-st-word))))
+              ;; 1+6+2+1+1+2+1=14 extra () before this:
+              ;;    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
+              ((match-beginning 15)    ; old $abc'efg syntax
+               (setq bb (match-end 0)
+                     b (match-beginning 0)
+                     state (parse-partial-sexp 
+                            state-point b nil nil state)
+                     state-point b)
+               (if (nth 3 state)       ; in string
+                   nil
+                 (put-text-property (1- bb) bb 'syntax-table cperl-st-word))
+               (goto-char bb))
+              ;; 1+6+2+1+1+2+1+1=15 extra () before this:
+              ;; "__\\(END\\|DATA\\)__"
+              (t                       ; __END__, __DATA__
+               (setq bb (match-end 0)
+                     b (match-beginning 0)
+                     state (parse-partial-sexp 
+                            state-point b nil nil state)
+                     state-point b)
+               (if (or (nth 3 state) (nth 4 state))
+                   nil
+                 ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
+                 (cperl-commentify b bb nil)
+                 )
+               (goto-char bb))))
 ;;;        (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
 ;;;          (if (looking-at "\n*cut\\>")
 ;;;              (progn
@@ -2850,8 +3014,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 ;;;                 (cperl-put-do-not-fontify b (match-beginning 0)))
 ;;;                (t (message "End of format `%s' not found." name))))
 )
-         (if err (goto-char err)
-           (message "Scan for pods, formats and here-docs completed.")))
+         (if (car err-l) (goto-char (car err-l))
+           (message "Scan for \"hard\" Perl constructions completed.")))
       (and (buffer-modified-p)
           (not modified)
           (set-buffer-modified-p nil))
@@ -2864,9 +3028,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
       (skip-chars-backward " \t\n\f" lim)
       (setq p (point))
       (beginning-of-line)
-      (if (looking-at "^[ \t]*\\(#\\|$\\)") nil        ; Only comment, skip
+      (if (or (looking-at "^[ \t]*\\(#\\|$\\)")
+             (progn (cperl-to-comment-or-eol) (bolp)))
+         nil   ; Only comment, skip
        ;; Else
-       (cperl-to-comment-or-eol) 
        (skip-chars-backward " \t")
        (if (< p (point)) (goto-char p))
        (setq stop t)))))
@@ -2931,8 +3096,8 @@ or looks like continuation of the comment on the previous line."
   (save-excursion
     (let ((tmp-end (progn (end-of-line) (point))) top done)
       (save-excursion
+       (beginning-of-line)
        (while (null done)
-         (beginning-of-line)
          (setq top (point))
          (while (= (nth 0 (parse-partial-sexp (point) tmp-end
                                               -1)) -1)
@@ -3147,6 +3312,7 @@ indentation and initial hashes. Behaves usually outside of comment."
 
 (defun imenu-example--create-perl-index (&optional regexp)
   (require 'cl)
+  (require 'imenu)                     ; May be called from TAGS creator
   (let ((index-alist '()) (index-pack-alist '()) (index-pod-alist '()) 
        (index-unsorted-alist '()) (i-s-f (default-value 'imenu-sort-function))
        (index-meth-alist '()) meth
@@ -3162,6 +3328,12 @@ indentation and initial hashes. Behaves usually outside of comment."
        (imenu-progress-message prev-pos)
        ;;(backward-up-list 1)
        (cond
+        ((and                          ; Skip some noise if building tags
+          (match-beginning 2)          ; package or sub
+          (eq (char-after (match-beginning 2)) ?p) ; package
+          (not (save-match-data
+                 (looking-at "[ \t\n]*;"))))  ; Plain text word 'package'
+         nil)
         ((and
           (match-beginning 2)          ; package or sub
           ;; Skip if quoted (will not skip multi-line ''-comments :-():
@@ -3473,12 +3645,12 @@ indentation and initial hashes. Behaves usually outside of comment."
                                   (2 '(restart 2 nil) nil t))) 
                        nil t)))        ; local variables, multiple
                  (font-lock-anchored
-                  '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
+                  '("^[ \t{}]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
                     (3 font-lock-variable-name-face)
                     ("\\=[ \t]*,[ \t]*\\([$@%*][a-zA-Z0-9_:]+\\)"
                      nil nil
                      (1 font-lock-variable-name-face))))
-                 (t '("^[ \t]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
+                 (t '("^[ \t{}]*\\(my\\|local\\)[ \t]*\\(([ \t]*\\)?\\([$@%*][a-zA-Z0-9_:]+\\)"
                       3 font-lock-variable-name-face)))
            '("\\<for\\(each\\)?[ \t]*\\(\\$[a-zA-Z_][a-zA-Z_0-9]*\\)[ \t]*("
              2 font-lock-variable-name-face)))
@@ -4037,7 +4209,7 @@ in subdirectories too."
      ((eq all 'recursive)
       ;;(error "Not implemented: recursive")
       (setq args (append (list "-e" 
-                              "sub wanted {push @ARGV, $File::Find::name if /\\.[Pp][Llm]$/}
+                              "sub wanted {push @ARGV, $File::Find::name if /\\.[pP][Llm]$/}
                                use File::Find;
                                find(\\&wanted, '.');
                                exec @ARGV;" 
@@ -4086,7 +4258,12 @@ in subdirectories too."
   (set-buffer (get-buffer-create cperl-tmp-buffer))
   (set-syntax-table cperl-mode-syntax-table)
   (buffer-disable-undo)
-  (auto-fill-mode 0))
+  (auto-fill-mode 0)
+  (if cperl-use-syntax-table-text-property-for-tags
+      (progn
+       (make-variable-buffer-local 'parse-sexp-lookup-properties)
+       ;; Do not introduce variable if not needed, we check it!
+       (set 'parse-sexp-lookup-properties t))))
 
 (defun cperl-xsub-scan ()
   (require 'cl)
@@ -4136,13 +4313,16 @@ in subdirectories too."
     index-alist))
 
 (defun cperl-find-tags (file xs)
-  (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret)
+  (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret
+           (cperl-pod-here-fontify nil))
     (save-excursion
       (if b (set-buffer b)
          (cperl-setup-tmp-buf))
       (erase-buffer)
       (setq file (car (insert-file-contents file)))
       (message "Scanning file %s..." file)
+      (if cperl-use-syntax-table-text-property-for-tags
+         (cperl-find-pods-heres))
       (if xs
          (setq lst (cperl-xsub-scan))
        (setq ind (imenu-example--create-perl-index))
@@ -4242,10 +4422,11 @@ in subdirectories too."
                   (progn
                     (search-backward "\f\n")
                     (delete-region (point)
-                                   (progn 
+                                   (save-excursion
                                      (forward-char 1)
-                                     (search-forward "\f\n" nil 'toend)
-                                     (point))))
+                                     (if (search-forward "\f\n" nil 'toend)
+                                      (- (point) 2)
+                                      (point-max)))))
                 (goto-char (point-max)))))
        (insert (cperl-find-tags file xs))))
       (if inbuffer nil         ; Delegate to the caller
@@ -4362,7 +4543,7 @@ One may build such TAGS files from CPerl mode menu."
   (if (eq update -999) (cperl-tags-hier-init t)))
 
 (defun cperl-tags-treeify (to level)
-  ;; cadr of to is read-write. On start it is a cons
+  ;; cadr of `to' is read-write. On start it is a cons
   (let* ((regexp (concat "^\\(" (mapconcat 
                                 'identity
                                 (make-list level "[_a-zA-Z0-9]+")
@@ -4403,23 +4584,33 @@ One may build such TAGS files from CPerl mode menu."
        (mapcar (function (lambda (elt)
                          (cperl-tags-treeify elt (1+ level))))
                (cdr to)))
+    ;;Now clean up leaders with one child only
+    (mapcar (function (lambda (elt)
+                       (if (not (and (listp (cdr elt)) 
+                                     (eq (length elt) 2))) nil
+                           (setcar elt (car (nth 1 elt)))
+                           (setcdr elt (cdr (nth 1 elt))))))
+           (cdr to))
+    ;; Sort the roots of subtrees
+    (if (default-value 'imenu-sort-function)
+       (setcdr to
+               (sort (cdr to) (default-value 'imenu-sort-function))))
     ;; Now add back functions removed from display
     (mapcar (function (lambda (elt)
                        (setcdr to (cons elt (cdr to)))))
-           root-functions)
+           (if (default-value 'imenu-sort-function)
+               (nreverse
+                (sort root-functions (default-value 'imenu-sort-function)))
+             root-functions))
     ;; Now add back packages removed from display
     (mapcar (function (lambda (elt)
                        (setcdr to (cons (cons (concat "package " (car elt)) 
                                               (cdr elt)) 
                                         (cdr to)))))
-           root-packages)
-    ;;Now clean up leaders with one child only
-    (mapcar (function (lambda (elt)
-                       (if (not (and (listp (cdr elt)) 
-                                     (eq (length elt) 2))) nil
-                           (setcar elt (car (nth 1 elt)))
-                           (setcdr elt (cdr (nth 1 elt))))))
-           (cdr to))
+           (if (default-value 'imenu-sort-function)
+               (nreverse 
+                (sort root-packages (default-value 'imenu-sort-function)))
+             root-packages))
     ))
 
 ;;;(x-popup-menu t
@@ -5136,7 +5327,7 @@ prototype \&SUB   Returns prototype of the function given a reference.
 (defun cperl-beautify-regexp-piece (b e embed)
   ;; b is before the starting delimiter, e before the ending
   ;; e should be a marker, may be changed, but remains "correct".
-  (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline)
+  (let (s c tmp (m (make-marker)) (m1 (make-marker)) c1 spaces inline code)
     (if (not embed)
        (goto-char (1+ b))
       (goto-char b)
@@ -5150,7 +5341,7 @@ prototype \&SUB   Returns prototype of the function given a reference.
             (forward-char 2))
            (t
             (forward-char 1))))
-    (setq c (1- (current-column))
+    (setq c (if embed (current-indentation) (1- (current-column)))
          c1 (+ c (or cperl-regexp-indent-step cperl-indent-level)))
     (or (looking-at "[ \t]*[\n#]")
        (progn
@@ -5175,18 +5366,18 @@ prototype \&SUB Returns prototype of the function given a reference.
       (while (and
              inline
              (looking-at 
-              (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1
-                      "\\|"
+              (concat "\\([a-zA-Z0-9]+[^*+{?]\\)" ; 1 word
+                      "\\|"            ; Embedded variable
                       "\\$\\([a-zA-Z0-9_]+\\([[{]\\)?\\|[^\n \t)|]\\)" ; 2 3
-                      "\\|"
+                      "\\|"            ; $ ^
                       "[$^]"
-                      "\\|"
+                      "\\|"            ; simple-code simple-code*?
                       "\\(\\\\.\\|[^][()#|*+?\n]\\)\\([*+{?]\\??\\)?" ; 4 5
-                      "\\|"
+                      "\\|"            ; Class
                       "\\(\\[\\)"      ; 6
-                      "\\|"
+                      "\\|"            ; Grouping
                       "\\((\\(\\?\\)?\\)" ; 7 8
-                      "\\|"
+                      "\\|"            ; |
                       "\\(|\\)"        ; 9
                       )))
        (goto-char (match-end 0))
@@ -5223,7 +5414,17 @@ prototype \&SUB  Returns prototype of the function given a reference.
               ;;                    (error "()-group not terminated")))
               (set-marker m (1- (point)))
               (set-marker m1 (point))
-              (cperl-beautify-regexp-piece tmp m t)
+              (cond
+               ((not (match-beginning 8))
+                (cperl-beautify-regexp-piece tmp m t))
+               ((eq (char-after (+ 2 tmp)) ?\{) ; Code
+                t)
+               ((eq (char-after (+ 2 tmp)) ?\() ; Conditional
+                (goto-char (+ 2 tmp))
+                (forward-sexp 1)
+                (cperl-beautify-regexp-piece (point) m t))
+               (t
+                (cperl-beautify-regexp-piece tmp m t)))
               (goto-char m1)
               (cond ((looking-at "[*+?]\\??")
                      (goto-char (match-end 0)))
@@ -5234,7 +5435,9 @@ prototype \&SUB   Returns prototype of the function given a reference.
               (skip-chars-forward " \t")
               (setq spaces nil)
               (if (looking-at "[#\n]")
-                  (beginning-of-line 2)
+                  (progn
+                    (or (eolp) (indent-for-comment))
+                    (beginning-of-line 2))
                 (insert "\n"))
               (end-of-line)
               (setq inline nil))
@@ -5262,39 +5465,109 @@ prototype \&SUB        Returns prototype of the function given a reference.
            (insert " "))
        (skip-chars-forward " \t"))
        (or (looking-at "[#\n]")
-           (error "unknown code in a regexp"))
+           (error "unknown code \"%s\" in a regexp" (buffer-substring (point)
+                                                                       (1+ (point)))))
        (and inline (end-of-line 2)))
+    ;; Special-case the last line of group
+    (if (and (>= (point) (marker-position e))
+            (/= (current-indentation) c))
+       (progn
+        (beginning-of-line)
+        (setq s (point))
+        (skip-chars-forward " \t")
+        (delete-region s (point))
+        (indent-to-column c)))
   ))
 
+(defun cperl-make-regexp-x ()
+  (save-excursion
+    (or cperl-use-syntax-table-text-property
+       (error "I need to have regex marked!"))
+    ;; Find the start
+    (re-search-backward "\\s|")                ; Assume it is scanned already.
+    ;;(forward-char 1)
+    (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
+         (sub-p (eq (preceding-char) ?s)) s)
+      (forward-sexp 1)
+      (set-marker e (1- (point)))
+      (setq delim (preceding-char))
+      (if (and sub-p (eq delim (char-after (- (point) 2))))
+         (error "Possible s/blah// - do not know how to deal with"))
+      (if sub-p (forward-sexp 1))
+      (if (looking-at "\\sw*x") 
+         (setq have-x t)
+       (insert "x"))
+      ;; Protect fragile " ", "#"
+      (if have-x nil
+       (goto-char (1+ b))
+       (while (re-search-forward "\\(\\=\\|[^\\\\]\\)\\(\\\\\\\\\\)*[ \t\n#]" e t) ; Need to include (?#) too?
+         (forward-char -1)
+         (insert "\\")
+         (forward-char 1)))
+      b)))
+
 (defun cperl-beautify-regexp ()
-  "do it. (Experimental, may change semantics, recheck afterwards.)
+  "do it. (Experimental, may change semantics, recheck the result.)
 We suppose that the regexp is scanned already."
   (interactive)
-  (or cperl-use-syntax-table-text-property
-      (error "I need to have regex marked!"))
-  ;; Find the start
+  (cperl-make-regexp-x)
   (re-search-backward "\\s|")          ; Assume it is scanned already.
   ;;(forward-char 1)
-  (let ((b (point)) (e (make-marker)) have-x delim (c (current-column))
-       (sub-p (eq (preceding-char) ?s)) s)
+  (let ((b (point)) (e (make-marker)))
     (forward-sexp 1)
     (set-marker e (1- (point)))
-    (setq delim (preceding-char))
-    (if (and sub-p (eq delim (char-after (- (point) 2))))
-       (error "Possible s/blah// - do not know how to deal with"))
-    (if sub-p (forward-sexp 1))
-    (if (looking-at "\\sw*x") 
-       (setq have-x t)
-      (insert "x"))
-    ;; Protect fragile " ", "#"
-    (if have-x nil
-       (goto-char (1+ b))
-       (while (re-search-forward "\\(\\=\\|[^\\\\]\\)\\(\\\\\\\\\\)*[ \t\n#]" e t) ; Need to include (?#) too?
-         (forward-char -1)
-         (insert "\\")
-         (forward-char 1)))
     (cperl-beautify-regexp-piece b e nil)))
 
+(defun cperl-contract-level ()
+  "Find an enclosing group in regexp and contract it. (Experimental, may change semantics, recheck the result.) Unfinished.
+We suppose that the regexp is scanned already."
+  (interactive)
+  (let ((bb (cperl-make-regexp-x)) done)
+    (while (not done)
+      (or (eq (following-char) ?\()
+         (search-backward "(" (1+ bb) t)
+         (error "Cannot find `(' which starts a group"))
+      (setq done
+           (save-excursion
+             (skip-chars-backward "\\")
+             (looking-at "\\(\\\\\\\\\\)*(")))
+      (or done (forward-char -1)))
+    (let ((b (point)) (e (make-marker)) s c)
+      (forward-sexp 1)
+      (set-marker e (1- (point)))
+      (goto-char b)
+      (while (re-search-forward "\\(#\\)\\|\n" e t)
+       (cond 
+        ((match-beginning 1)           ; #-comment
+         (or c (setq c (current-indentation)))
+         (beginning-of-line 2)         ; Skip
+         (setq s (point))
+         (skip-chars-forward " \t")
+         (delete-region s (point))
+         (indent-to-column c))
+        (t
+         (delete-char -1)
+         (just-one-space)))))))
+
+(defun cperl-beautify-level ()
+  "Find an enclosing group in regexp and beautify it. (Experimental, may change semantics, recheck the result.)
+We suppose that the regexp is scanned already."
+  (interactive)
+  (let ((bb (cperl-make-regexp-x)) done)
+    (while (not done)
+      (or (eq (following-char) ?\()
+         (search-backward "(" (1+ bb) t)
+         (error "Cannot find `(' which starts a group"))
+      (setq done
+           (save-excursion
+             (skip-chars-backward "\\")
+             (looking-at "\\(\\\\\\\\\\)*(")))
+      (or done (forward-char -1)))
+    (let ((b (point)) (e (make-marker)))
+      (forward-sexp 1)
+      (set-marker e (1- (point)))
+      (cperl-beautify-regexp-piece b e nil))))
+
 (if (fboundp 'run-with-idle-timer)
     (progn
       (defvar cperl-help-shown nil
diff --git a/embed.h b/embed.h
index 4be72d7..51e5f40 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -46,6 +46,7 @@
 #define av_make                        Perl_av_make
 #define av_pop                 Perl_av_pop
 #define av_push                        Perl_av_push
+#define av_reify               Perl_av_reify
 #define av_shift               Perl_av_shift
 #define av_store               Perl_av_store
 #define av_undef               Perl_av_undef
 #define magic_len              Perl_magic_len
 #define magic_nextpack         Perl_magic_nextpack
 #define magic_set              Perl_magic_set
+#define magic_set_all_env      Perl_magic_set_all_env
 #define magic_setamagic                Perl_magic_setamagic
 #define magic_setarylen                Perl_magic_setarylen
 #define magic_setbm            Perl_magic_setbm
index 04404b7..712d575 100644 (file)
@@ -12,16 +12,21 @@ package DynaLoader;
 #
 # Tim.Bunce@ig.co.uk, August 1994
 
-use vars qw($VERSION);
+$VERSION = $VERSION = "1.03";  # avoid typo warning
 
-$VERSION = "1.02";
-
-require Carp;
 require Config;
 
 require AutoLoader;
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;
 
+# The following require can't be removed during maintenance
+# releases, sadly, because of the risk of buggy code that does 
+# require Carp; Carp::croak "..."; without brackets dying 
+# if Carp hasn't been loaded in earlier compile time. :-( 
+# We'll let those bugs get found on the development track.
+require Carp if $] < 5.00450; 
+
+
 # enable debug/trace messages from DynaLoader perl code
 $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;
 
@@ -82,6 +87,8 @@ if ($dl_debug) {
 1; # End of main code
 
 
+sub croak   { require Carp; Carp::croak(@_)   }
+
 # The bootstrap function cannot be autoloaded (without complications)
 # so we define it here:
 
@@ -91,11 +98,14 @@ sub bootstrap {
     local($module) = $args[0];
     local(@dirs, $file);
 
-    Carp::confess("Usage: DynaLoader::bootstrap(module)") unless $module;
+    unless ($module) {
+       require Carp;
+       Carp::confess("Usage: DynaLoader::bootstrap(module)");
+    }
 
     # A common error on platforms which don't support dynamic loading.
     # Since it's fatal and potentially confusing we give a detailed message.
-    Carp::croak("Can't load module $module, dynamic loading not available in this perl.\n".
+    croak("Can't load module $module, dynamic loading not available in this perl.\n".
        "  (You may need to build a new perl executable which either supports\n".
        "  dynamic loading or has the $module module statically linked into it.)\n")
        unless defined(&dl_load_file);
@@ -119,16 +129,17 @@ sub bootstrap {
        next unless -d $dir; # skip over uninteresting directories
 
        # check for common cases to avoid autoload of dl_findfile
-       last if ($file=_check_file("$dir/$modfname.$dl_dlext"));
+       my $try = "$dir/$modfname.$dl_dlext";
+       last if $file = ($do_expand) ? dl_expandspec($try) : (-f $try && $try);
 
        # no luck here, save dir for possible later dl_findfile search
-       push(@dirs, "-L$dir");
+       push @dirs, $dir;
     }
     # last resort, let dl_findfile have a go in all known locations
-    $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file;
+    $file = dl_findfile(map("-L$_",@dirs,@INC), $modfname) unless $file;
 
-    Carp::croak("Can't find loadable object for module $module in \@INC (@INC)")
-       unless $file;
+    croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
+       unless $file;   # wording similar to error from 'require'
 
     my $bootname = "boot_$module";
     $bootname =~ s/\W/_/g;
@@ -153,16 +164,18 @@ sub bootstrap {
     # it executed.
 
     my $libref = dl_load_file($file, $module->dl_load_flags) or
-       Carp::croak("Can't load '$file' for module $module: ".dl_error()."\n");
+       croak("Can't load '$file' for module $module: ".dl_error()."\n");
 
     push(@dl_librefs,$libref);  # record loaded object
 
     my @unresolved = dl_undef_symbols();
-    Carp::carp("Undefined symbols present after loading $file: @unresolved\n")
-        if @unresolved;
+    if (@unresolved) {
+       require Carp;
+       Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
+    }
 
     my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
-         Carp::croak("Can't find '$bootname' symbol in $file\n");
+         croak("Can't find '$bootname' symbol in $file\n");
 
     my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);
 
@@ -173,12 +186,12 @@ sub bootstrap {
 }
 
 
-sub _check_file {   # private utility to handle dl_expandspec vs -f tests
-    my($file) = @_;
-    return $file if (!$do_expand && -f $file); # the common case
-    return $file if ( $do_expand && ($file=dl_expandspec($file)));
-    return undef;
-}
+#sub _check_file {   # private utility to handle dl_expandspec vs -f tests
+#    my($file) = @_;
+#    return $file if (!$do_expand && -f $file); # the common case
+#    return $file if ( $do_expand && ($file=dl_expandspec($file)));
+#    return undef;
+#}
 
 
 # Let autosplit and the autoloader deal with these functions:
@@ -243,7 +256,8 @@ sub dl_findfile {
             foreach $name (@names) {
                my($file) = "$dir/$name";
                 print STDERR " checking in $dir for $name\n" if $dl_debug;
-               $file = _check_file($file);
+               $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
+               #$file = _check_file($file);
                if ($file) {
                     push(@found, $file);
                     next arg; # no need to look any further
@@ -279,6 +293,7 @@ sub dl_expandspec {
     my $file = $spec; # default output to input
 
     if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs
+       require Carp;
        Carp::croak("dl_expandspec: should be defined in XS file!\n");
     } else {
        return undef unless -f $file;
index ab19170..aadb502 100644 (file)
@@ -39,6 +39,11 @@ C<new> only looks for one key C<Domain> which tells new which domain
 the socket will be in. All other arguments will be passed to the
 configuration method of the package for that domain, See below.
 
+C<IO::Socket>s will be in autoflush mode after creation.  Note that
+versions of IO::Socket prior to 1.1603 (as shipped with Perl 5.004_04)
+did not do this.   So if you need backward compatibility, you should
+set autoflush explicitly.
+
 =back
 
 =head1 METHODS
@@ -118,7 +123,7 @@ use Exporter;
 
 @ISA = qw(IO::Handle);
 
-$VERSION = "1.1602";
+$VERSION = "1.1603";
 
 sub import {
     my $pkg = shift;
@@ -129,6 +134,7 @@ sub import {
 sub new {
     my($class,%arg) = @_;
     my $fh = $class->SUPER::new();
+    $fh->autoflush;
 
     ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
 
@@ -392,7 +398,7 @@ and some related methods. The constructor can take the following options
     PeerPort   Remote port or service       <service>[(<no>)] | <no>
     LocalAddr  Local host bind address      hostname[:port]
     LocalPort  Local host bind port         <service>[(<no>)] | <no>
-    Proto      Protocol name                "tcp" | "udp" | ...
+    Proto      Protocol name (or number)    "tcp" | "udp" | ...
     Type       Socket type                  SOCK_STREAM | SOCK_DGRAM | ...
     Listen     Queue size for listen
     Reuse      Set SO_REUSEADDR before binding
@@ -410,10 +416,13 @@ parenthesis which is used if the service is not known by the system.
 The C<PeerPort> specification can also be embedded in the C<PeerAddr>
 by preceding it with a ":".
 
-Only one of C<Type> or C<Proto> needs to be specified, one will be
-assumed from the other.  If you specify a symbolic C<PeerPort> port,
-then the constructor will try to derive C<Type> and C<Proto> from
-the service name.
+If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
+then the constructor will try to derive C<Proto> from the service
+name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
+parameter will be deduced from C<Proto> if not specified.
+
+If the constructor is only passed a single argument, it is assumed to
+be a C<PeerAddr> specification.
 
 Examples:
 
@@ -428,6 +437,9 @@ Examples:
                                  LocalPort => 9000,
                                  Proto     => 'tcp');
 
+   $sock = IO::Socket::INET->new('127.0.0.1:25');
+
+
 =head2 METHODS
 
 =over 4
@@ -463,6 +475,13 @@ peer host in a text form xx.xx.xx.xx
 
 =cut
 
+sub new
+{
+  my $class = shift;
+  unshift(@_, "PeerAddr") if @_ == 1;
+  return $class->SUPER::new(@_);
+}
+
 sub _sock_info {
   my($addr,$port,$proto) = @_;
   my @proto = ();
@@ -535,6 +554,7 @@ sub configure {
                unless(defined $raddr);
     }
 
+    $proto ||= (getprotobyname "tcp")[2];
     return _error($fh,'Cannot determine protocol')
        unless($proto);
 
diff --git a/ext/util/extliblist b/ext/util/extliblist
deleted file mode 100755 (executable)
index 2351ddf..0000000
+++ /dev/null
@@ -1,155 +0,0 @@
-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
-: extliblist
-:
-: Author:  Andy Dougherty    doughera@lafcol.lafayette.edu
-:
-: This utility was only used by the old Makefile.SH extension
-: mechanism.  It is now obsolete and may be removed in a future
-: release.
-:
-: This utility takes a list of libraries in the form
-: -llib1 -llib2 -llib3
-: and prints out lines suitable for inclusion in an extension
-: Makefile.  
-: Extra library paths may be included with the form -L/another/path
-: this will affect the searches for all subsequent libraries.
-:
-: It is intended to be "dotted" from within an extension Makefile.SH.
-: see ext/POSIX/Makefile.SH for an example.
-: Prior to calling this, the variable potential_libs should be set 
-: to the potential list of libraries
-:
-: It sets the following
-: extralibs = full list of libraries needed for static linking.
-:              Only those libraries that actually exist are included.
-: dynaloadlibs = full path names of those libraries that are needed 
-:              but can be linked in dynamically on this platform.  On 
-:              SunOS, for example, this would be .so* libraries, 
-:              but not archive libraries.
-:              Eventually, this list can be used to write a bootstrap file.
-: statloadlibs = list of those libraries which must be statically
-:              linked into the shared library.  On SunOS 4.1.3, 
-:              for example,  I have only an archive version of
-:              -lm, and it must be linked in statically.
-:
-:  This script uses config.sh variables libs, libpth, and so.  It is mostly
-:  taken from the metaconfig libs.U unit.
-extralibs=''
-dynaloadlibs=''
-statloadlibs=''
-Llibpth=''
-for thislib in `echo "XXX $potential_libs " | $sed 's/ -l/ /g'` ; do
-       case "$thislib" in
-       XXX)
-               : Handle case where potential_libs is empty.
-               ;;
-       -L*)
-               : Handle possible linker path arguments.
-               newpath=`echo $thislib | $sed 's/^-L//'`
-               if $test -d $newpath; then
-                       Llibpth="$Llibpth $newpath"
-                       extralibs="$extralibs $thislib"
-                       statloadlibs="$statloadlibs $thislib"
-               fi
-               ;;
-       *)
-               : Handle possible library arguments.
-               for thispth in $Llibpth $libpth; do
-                       : Loop over possible wildcards and take the last one.
-                       for fullname in $thispth/lib$thislib.$so.[0-9]* ; do
-                               :
-                       done
-                       if $test -f $fullname; then
-                               break
-                       elif fullname=$thispth/lib$thislib.$so && $test -f $fullname; then
-                               break
-                       elif fullname=$thispth/lib${thislib}_s.a && $test -f $fullname; then
-                               thislib=${thislib}_s
-                               break
-                       elif fullname=$thispth/lib${thislib}.a && $test -f $fullname; then
-                               break
-                       elif fullname=$thispth/Slib${thislib}.a && $test -f $fullname; then
-                               break
-                       else
-                               fullname=''
-                       fi
-               done
-               : Now update library lists
-               case "$fullname" in
-               '') 
-                       : Skip nonexistent files
-                       ;;
-               *)
-                       : Do not add it into the extralibs if it is already linked in
-                       : with the main perl executable.
-                       case " $libs " in
-                       *" -l$thislib "*|*" -l${thislib}_s "*) ;;
-                       *)      extralibs="$extralibs -l$thislib" ;;
-                       esac
-                       :
-                       : For NeXT and DLD, put files into DYNALOADLIBS to be
-                       : converted into a boostrap file.  For other systems,
-                       : we will use ld with what I have misnamed STATLOADLIBS
-                       : to assemble the shared object.
-                       case "$dlsrc" in
-                       dl_dld*|dl_next*)
-                               dynaloadlibs="$dynaloadlibs $fullname"   ;;
-                       *)
-                               case "$fullname" in
-                               *.a)
-                                       statloadlibs="$statloadlibs -l$thislib" 
-                                       ;;
-                               *)   
-                                       : For SunOS4, do not add in this shared library
-                                       : if it is already linked in the main
-                                       : perl executable
-                                       case "$osname" in
-                                       sunos)
-                                               case " $libs " in
-                                               *" -l$thislib "*) ;;
-                                               *)      statloadlibs="$statloadlibs -l$thislib" ;;
-                                               esac
-                                               ;;
-                                       *)
-                                               statloadlibs="$statloadlibs -l$thislib" 
-                                               ;;
-                                       esac
-                                       ;;
-                               esac
-                               ;;
-                       esac
-                       ;;
-               esac
-               ;;
-       esac
-done
-
-case "$dlsrc" in
-dl_next*)
-       extralibs=`echo " $extralibs "| $sed -e 's/ -lm / /'` ;;
-esac
-
-set X $extralibs
-shift
-extralibs="$*"
-
-set X $dynaloadlibs
-shift
-dynaloadlibs="$*"
-
-set X $statloadlibs
-shift
-statloadlibs="$*"
-
index bfbcc83..70a5d2e 100644 (file)
@@ -4,16 +4,35 @@
 # It primarily used by the perl Makefile:
 #
 # d_dummy $(dynamic_ext): miniperl preplibrary FORCE
-#        ext/util/make_ext dynamic $@
+#      @sh ext/util/make_ext dynamic $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
 #
 # It may be deleted in a later release of perl so try to
 # avoid using it for other purposes.
 
 target=$1;  shift
 extspec=$1; shift
+makecmd=$1; shift  # Should be something like MAKE=make
 passthru="$*" # allow extra macro=value to be passed through
 echo ""
 
+# Previously, $make was taken from config.sh.  However, the user might
+# instead be running a possibly incompatible make.  This might happen if
+# the user types "gmake" instead of a plain "make", for example.  The
+# correct current value of MAKE will come through from the main perl
+# makefile as MAKE=/whatever/make in $makecmd.  We'll be cautious in
+# case third party users of this script (are there any?) don't have the
+# MAKE=$(MAKE) argument, which was added after 5.004_03.
+case "$makecmd" in
+MAKE=*)
+       eval $makecmd
+       ;;
+*)     echo 'ext/util/make_ext:  WARNING:  Please include MAKE=$(MAKE)'
+       echo '  in your call to make_ext.  See ext/util/make_ext for details.'
+       exit 1
+       ;;
+esac
+
+
 case $CONFIG in
 '')
     if test -f config.sh; then TOP=.;
@@ -107,10 +126,10 @@ clean)            ;;
 realclean)     ;;
 *)     # Give makefile an opportunity to rewrite itself.
        # reassure users that life goes on...
-       $make config $passthru || echo "$make config failed, continuing anyway..."
+       $MAKE config $passthru || echo "$MAKE config failed, continuing anyway..."
        ;;
 esac
 
-$make $makeopts $target $makeargs $passthru || exit
+$MAKE $makeopts $target $makeargs $passthru || exit
 
 exit $?
index a8d99d7..864be81 100644 (file)
@@ -310,6 +310,7 @@ av_len
 av_make
 av_pop
 av_push
+av_reify
 av_shift
 av_store
 av_undef
@@ -530,6 +531,7 @@ magic_setsubstr
 magic_settaint
 magic_setuvar
 magic_setvec
+magic_set_all_env
 magic_wipepack
 magicname
 markstack_grow
diff --git a/gv.c b/gv.c
index 6658259..fff3bcf 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -170,8 +170,8 @@ I32 level;
     gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
     av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav;
 
-    /* create @.*::SUPER::ISA on demand */
-    if (!av) {
+    /* create and re-create @.*::SUPER::ISA on demand */
+    if (!av || !SvMAGIC(av)) {
        char* packname = HvNAME(stash);
        STRLEN packlen = strlen(packname);
 
@@ -740,6 +740,7 @@ I32 sv_type;
     case '7':
     case '8':
     case '9':
+    case '\023':
       ro_magicalize:
        SvREADONLY_on(GvSV(gv));
       magicalize:
index ef98ace..53adfa3 100644 (file)
@@ -1,39 +1,60 @@
 # hints/bsdos.sh
 #
-# hints file for BSD/OS 2.x (adapted from bsd386.sh)
-# Original by Neil Bowers <neilb@khoros.unm.edu>
-#     Tue Oct  4 12:01:34 EDT 1994
-# Updated by Tony Sanders <sanders@bsdi.com>
-#     Mon Nov 27 17:25:51 CST 1995
+# hints file for BSD/OS (adapted from bsd386.sh)
+# Original by Neil Bowers <neilb@khoros.unm.edu>; Tue Oct  4 12:01:34 EDT 1994
+# Updated by Tony Sanders <sanders@bsdi.com>; Sat Aug 23 12:47:45 MDT 1997
+#     Added 3.1 with ELF dynamic libraries
+#     SYSV IPC tested Ok so I re-enabled.
 #
-# You can override the compiler and loader on the Configure command line:
-#     ./Configure -Dcc=shlicc2 -Dld=shlicc2
-
-# filename extension for shared library objects
-so='o'
+# To override the compiler on the command line:
+#     ./Configure -Dcc=gcc2
+#
+# The BSD/OS distribution is built with:
+#     ./Configure -des -Dbsdos_distribution=defined
 
-# Don't use this for Perl 5.002, which needs parallel sig_name and sig_num lists
-#sig_name='ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH INFO USR1 USR2 '
 signal_t='void'
 d_voidsig='define'
 
+usemymalloc='n'
+
+# setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS versions.
+# See http://www.bsdi.com/bsdi-man?setuid(2)
+d_setregid='undef'
+d_setreuid='undef'
+d_setrgid='undef'
+d_setruid='undef'
+
 # we don't want to use -lnm, since exp() is busted (in 1.1 anyway)
 set `echo X "$libswanted "| sed -e 's/ nm / /'`
 shift
 libswanted="$*"
 
-# BSD/OS X libraries are in their own tree
+# X libraries are in their own tree
 glibpth="$glibpth /usr/X11/lib"
 ldflags="$ldflags -L/usr/X11/lib"
 
 # Avoid telldir prototype conflict in pp_sys.c
 pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"'
 
+case "$optimize" in
+'')     optimize='-O2' ;;
+esac
+
 case "$bsdos_distribution" in
-defined)
-       d_portable='no'
+''|undef|false)        ;;
+*)
+       d_dosuid='define'
+       d_portable='undef'
        prefix='/usr/contrib'
+       perlpath='/usr/bin/perl5'
+       startperl='#!/usr/bin/perl5'
+       scriptdir='/usr/contrib/bin'
+       privlib='/usr/libdata/perl5'
+       man1dir='/usr/contrib/man/man1'
        man3dir='/usr/contrib/man/man3'
+       # phlib added by BSDI -- we share the *.ph include dir with perl4
+       phlib="/usr/libdata/perl5/site_perl/$(arch)-$osname/include"
+       phlibexp="/usr/libdata/perl5/site_perl/$(arch)-$osname/include"
        ;;
 esac
 
@@ -48,120 +69,41 @@ case "$osvers" in
        '')     cc='gcc2' ;;
        esac
        ;;
-2.0*)
-       # default to GCC 2.X w/shared libraries
-       case "$cc" in
-       '')     cc='shlicc2' ;;
-       esac
-
-       # default ld to shared library linker
-       case "$ld" in
-       '')     ld='shlicc2' ;;
-       esac
-
-       # setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS stuff
-       # in 4.4BSD-based systems (including BSD/OS 2.0 and later).
-       # See http://www.bsdi.com/bsdi-man?setuid(2)
-       d_setregid='undef'
-       d_setreuid='undef'
-       d_setrgid='undef'
-       d_setruid='undef'
-       ;;
-2.1*)
-       # Use 2.1's shlicc2 for dynamic linking
-       # Since cc -o is linking, use it for compiling too.
-       # I'm not sure whether Configure is careful about
-       # distinguishing between the two.
+2.0*|2.1*|3.0*)
+       so='o'
 
+       # default to GCC 2.X w/shared libraries
        case "$cc" in
        '')     cc='shlicc2'
                cccdlflags=' ' ;; # Avoid the dreaded -fpic
        esac
 
-       # Link with shared libraries in 2.1
-       # Turns out that shlicc2 will automatically use the
-       # shared libs, so don't explicitly specify -lc_s.2.1.*
+       # default ld to shared library linker
        case "$ld" in
        '')     ld='shlicc2'
                lddlflags='-r' ;; # this one is necessary
        esac
 
-       # setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS  stuff
-       # in 4.4BSD-based systems (including BSD/OS 2.0 and later).
-       # See http://www.bsdi.com/bsdi-man?setuid(2)
-       # This stuff may or may not be right, but it works.
-       d_setregid='undef'
-       d_setreuid='undef'
-       d_setrgid='undef'
-       d_setruid='undef'
-
-       # based on the 5.001m hints file from BSD/OS source disk
-       # (this is needed for pTk to work)
-
-       # BSD/OS 2.1 doesn't (yet) support true dynamic linking.
-       # So we "preload' the shared libraries by linking against
-       # them, even though we don't pull in any symbols thereby.
+       # Must preload the static shared libraries.
        libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted"
        libswanted="rpc curses termcap $libswanted"
-
        ;;
-3.0*)
-       # adapted from 2.1 entry by Christopher Davis <ckd@kei.com
-       # Use 3.0's shlicc2 for dynamic linking
-       # Since cc -o is linking, use it for compiling too.
-       # I'm not sure whether Configure is careful about
-       # distinguishing between the two.
+3.1*)
+       # ELF dynamic link libraries starting in 3.1
+        useshrplib='true'
+       so='so'
+       dlext='so'
 
        case "$cc" in
-       '')     cc='shlicc2'
-               cccdlflags=' ' ;; # Avoid the dreaded -fpic
+       '')     cc='cc'                 # cc is gcc2 in 3.1
+               cccdlflags="-fPIC"
+               ccdlflags=" " ;;
        esac
 
-       # Link with shared libraries in 3.0
-       # Turns out that shlicc2 will automatically use the
-       # shared libs, so don't explicitly specify them
        case "$ld" in
-       '')     ld='shlicc2'
-               lddlflags='-r' ;; # this one is necessary
+       '')     ld='ld'
+               lddlflags="-shared -x $lddlflags" ;;
        esac
-
-       # setre?[ug]id() have been replaced by the _POSIX_SAVED_IDS  stuff
-       # in 4.4BSD-based systems (including BSD/OS 2.0 and later).
-       # See http://www.bsdi.com/bsdi-man?setuid(2)
-       # This stuff may or may not be right, but it works.
-       d_setregid='undef'
-       d_setreuid='undef'
-       d_setrgid='undef'
-       d_setruid='undef'
-
-       # this may still be needed for Tk and such
-       # BSD/OS doesn't (yet) support true dynamic linking.
-       # So we "preload' the shared libraries by linking against
-       # them, even though we don't pull in any symbols thereby.
-       libswanted="Xpm Xaw Xmu Xt SM ICE Xext X11 $libswanted"
-       libswanted="rpc curses termcap $libswanted"
-
-       # the IPC stuff doesn't work the way perl expects
-       d_msg='undef'
-       d_msgctl='undef'
-       d_msgget='undef'
-       d_msgrcv='undef'
-       d_msgsnd='undef'
-       d_sem='undef'
-       d_semctl='undef'
-       d_semget='undef'
-       d_semop='undef'
-       d_shm='undef'
-       d_shmat='undef'
-       d_shmatprototype='undef'
-       d_shmctl='undef'
-       d_shmdt='undef'
-       d_shmget='undef'
-
-       # use system malloc instead of perl's
-       d_mymalloc='undef'
-       i_malloc='undef'
-       usemymalloc='n'
-
        ;;
 esac
+
index 0ba4dad..255505b 100644 (file)
@@ -117,6 +117,9 @@ libswanted="`echo $libswanted | sed -e 's/ dl / /'`"
 # libPW contains nothing useful for perl
 libswanted="`echo $libswanted | sed -e 's/ PW / /'`"
 
+# libnet contains nothing useful for perl here, and doesn't work
+libswanted="`echo $libswanted | sed -e 's/ net / /'`"
+
 # libbsd contains nothing used by perl that is not already in libc
 libswanted="`echo $libswanted | sed -e 's/ bsd / /'`"
 
@@ -171,6 +174,13 @@ unset _DEC_uname_r
 #
 # History:
 #
+# perl5.004_04:
+#
+#       19-Sep-1997 Spider Boardman <spider@Orb.Nashua.NH.US>
+#
+#      * libnet on Digital UNIX is for JAVA, not for sockets.
+#
+#
 # perl5.003_28:
 #
 #       22-Feb-1997 Jarkko Hietaniemi <jhi@iki.fi>
index 55824f6..78a45e4 100644 (file)
@@ -15,3 +15,10 @@ libswanted=`echo $libswanted | sed -e 's/ inet / /'`
 # 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'
index 060d972..795b6ab 100644 (file)
@@ -63,6 +63,10 @@ case "$cc" in
        ld=ld
        ldflags=' -L/usr/local/lib -L/usr/lib32 -L/lib32'
        cccdlflags=' '
+    # From: David Billinghurst <David.Billinghurst@riotinto.com.au>
+    # If you get complaints about so_locations then change the following
+    # line to something like:
+    #  lddlflags="-n32 -shared -check_registry /usr/lib32/so_locations"
        lddlflags="-n32 -shared"
        libc='/usr/lib32/libc.so'
        plibpth='/usr/lib32 /lib32 /usr/ccs/lib'
index 6a11a42..8ddb765 100644 (file)
@@ -29,6 +29,14 @@ esac
 # gcc-2.6.3 defines _G_HAVE_BOOL to 1, but doesn't actually supply bool.
 ccflags="-Dbool=char -DHAS_BOOL $ccflags"
 
+# libc6, aka glibc2, seems to need STRUCT_TM_HASZONE defined.
+# Thanks to Bart Schuller <schuller@Lunatech.com>
+# See Message-ID: <19971009002636.50729@tanglefoot>
+# This is currently commented out for maintenance releases
+# but should probably be uncommented for 5.005 or after
+# more widespread testing.
+#POSIX_cflags='ccflags="$ccflags -DSTRUCT_TM_HASZONE"'
+
 # BSD compatability library no longer needed
 set `echo X "$libswanted "| sed -e 's/ bsd / /'`
 shift
index 55feadc..380f702 100644 (file)
@@ -1,8 +1,8 @@
 # machten.sh
-# This is for MachTen 4.0.3.  It might work on other versions too.
+# This is for MachTen 4.0.3.  It might work on other versions and variants too.
 #
-# MachTen users might need a fixed tr from ftp.tenon.com.  This should
-# be described in the MachTen release notes.
+# Users of earlier MachTen versions might need a fixed tr from ftp.tenon.com.
+# This should be described in the MachTen release notes.
 #
 # MachTen 2.x has its own hint file.
 #
@@ -13,6 +13,7 @@
 #      Martijn Koster <m.koster@webcrawler.com>
 #      Richard Yeh <rcyeh@cco.caltech.edu>
 #
+# Raise perl's stack size -- Dominic Dunlop <domo@tcp.ip.lu> 970922
 # Reinstate sigsetjmp iff version is 4.0.3 or greater; use nm
 # (assumes Configure change); prune libswanted -- Dominic Dunlop 970113
 # Warn about test failure due to old Berkeley db -- Dominic Dunlop 970105
@@ -24,9 +25,6 @@
 #
 # MachTen 4.X does support dynamic loading, but perl doesn't
 # know how to use it yet.
-#
-#  Updated by Dominic Dunlop <domo@tcp.ip.lu>
-#  Tue Jan 14 10:17:18 WET 1997
 
 # Power MachTen is a real memory system and its standard malloc
 # has been optimized for this. Using this malloc instead of Perl's
@@ -36,6 +34,11 @@ usemymalloc='false'
 # Make symbol table listings les voluminous
 nmopts=-gp
 
+# Increase perl's stack size.  Without this, lib/complex.t crashes out.
+# Particularly perverse programs may require that perl has an even larger
+# stack allocation than that specified here.  (See  man setstackspace )
+ldflags='-Xlstack=0x014000'
+
 # Install in /usr/local by default
 prefix='/usr/local'
 
index b468f2d..2a589b5 100644 (file)
@@ -6,14 +6,11 @@
 # Trimmed and comments added by 
 #     Andy Dougherty  <doughera@lafcol.lafayette.edu>
 #     Exactly what is required beyond a standard OS/2 installation?
-#     There are notes about "patched pdksh" I do not understand.
+#     (see in README.os2)
 
 # Note that symbol extraction code gives wrong answers (sometimes?) on
 # gethostent and setsid.
 
-# Note that during the .obj compile you need to move the perl.dll file
-# to LIBPATH :-(
-
 # Optimization (GNU make 3.74 cannot be loaded :-():
 emxload -m 30 sh.exe ls.exe tr.exe id.exe sed.exe # make.exe 
 emxload -m 30 grep.exe egrep.exe fgrep.exe cat.exe rm.exe mv.exe cp.exe
@@ -24,28 +21,59 @@ path_sep=\;
 if test -f $sh.exe; then sh=$sh.exe; fi
 
 startsh="#!$sh"
-
-sysman=`../UU/loc . /man/man1 c:/man/man1 c:/usr/man/man1 d:/man/man1 d:/usr/man/man1 e:/man/man1 e:/usr/man/man1 f:/man/man1 f:/usr/man/man1 g:/man/man1 g:/usr/man/man1 /usr/man/man1`
 cc='gcc'
-usrinc='/emx/include'
-emxpath="`../UU/loc . /emx c:/emx d:/emx e:/emx f:/emx g:/emx h:/emx /emx`"
 
-libemx="$emxpath/lib"
+# Get some standard things (indented to avoid putting in config.sh):
+ oifs="$IFS"
+ IFS=" ;"
+ set $MANPATH
+ tryman="$@"
+ set $LIBRARY_PATH
+ libemx="$@"
+ set $C_INCLUDE_PATH
+ usrinc="$@"
+ IFS="$oifs"
+ tryman="`../UU/loc . /man $tryman`"
+ tryman="`echo $tryman | tr '\\\' '/'`"
+ # indented to avoid having it *two* times at start
+ libemx="`../UU/loc os2.a /emx/lib $libemx`"
+
+usrinc="`../UU/loc stdlib.h /emx/include $usrinc`"
+usrinc="`dirname $usrinc | tr '\\\' '/'`"
+libemx="`dirname $libemx | tr '\\\' '/'`"
+
+if test -d $tryman/man1; then
+  sysman="$tryman/man1"
+else
+  sysman="`../UU/loc . /man/man1 c:/man/man1 c:/usr/man/man1 d:/man/man1 d:/usr/man/man1 e:/man/man1 e:/usr/man/man1 f:/man/man1 f:/usr/man/man1 g:/man/man1 g:/usr/man/man1 /usr/man/man1`"
+fi
+
+emxpath="`dirname $libemx`"
+if test ! -d "$emxpath"; then 
+  emxpath="`../UU/loc . /emx c:/emx d:/emx e:/emx f:/emx g:/emx h:/emx /emx`"
+fi
+
+if test ! -d "$libemx"; then 
+  libemx="$emxpath/lib"
+fi
 if test ! -d "$libemx"; then 
   if test -d "$LIBRARY_PATH"; then
-    usrinc="$LIBRARY_PATH"
+    libemx="$LIBRARY_PATH"
   else
     libemx="`../UU/loc . X c:/emx/lib d:/emx/lib e:/emx/lib f:/emx/lib g:/emx/lib h:/emx/lib /emx/lib`"
   fi
 fi
 
-if test -d "$emxpath/include"; then 
-  usrinc="$emxpath/include"
-else
-  if test -d "$C_INCLUDE_PATH"; then
-    usrinc="$C_INCLUDE_PATH"
+if test ! -d "$usrinc"; then 
+  if test -d "$emxpath/include"; then 
+    usrinc="$emxpath/include"
   else
-    usrinc="`../UU/loc . X c:/emx/include d:/emx/include e:/emx/include f:/emx/include g:/emx/include h:/emx/include /emx/include`"
+    if test -d "$C_INCLUDE_PATH"; then
+      usrinc="$C_INCLUDE_PATH"
+    else
+      usrinc="`../UU/loc . X c:/emx/include d:/emx/include e:/emx/include f:/emx/include g:/emx/include h:/emx/include /emx/include`"
+    fi
   fi
 fi
 
diff --git a/hints/os390.sh b/hints/os390.sh
new file mode 100644 (file)
index 0000000..fd590ea
--- /dev/null
@@ -0,0 +1,33 @@
+# hints/os390.sh
+# OS/390 OpenEdition Release 3 Mon Sep 22 1997 thanks to:
+#     
+#     John Pfuntner <pfuntner@vnet.ibm.com>
+#     Len Johnson <lenjay@ibm.net>
+#     Bud Huff  <BAHUFF@us.oracle.com>
+#     Peter Prymmer <pvhp@forte.com>
+#     Andy Dougherty  <doughera@lafcol.lafayette.edu>
+#     Tim Bunce  <Tim.Bunce@ig.co.uk>
+#
+#  as well as the authors of the aix.sh file
+#
+
+cc='c89'
+ccflags='-DMAXSIG=38 -DOEMVS -D_OE_SOCKETS -D_XOPEN_SOURCE_EXTENDED -D_ALL_SOURCE'
+optimize='none'
+alignbytes=8
+usemymalloc='y'
+so='a'
+dlext='none'
+d_shmatprototype='define'
+usenm='false'
+i_time='define'
+i_systime='define'
+d_select='undef'
+
+# (from aix.sh)
+# uname -m output is too specific and not appropriate here
+#
+case "$archname" in
+'') archname="$osname" ;;
+esac
+
index 9334c94..947c98f 100644 (file)
@@ -1,10 +1,10 @@
 #----------------------------------------------------------------
 # QNX hints
 #
-# As of perl5.003_09, perl5 will compile without errors
-# and pass almost all the tests in the test suite. The remaining
-# failures have been identified as bugs in the Watcom libraries
-# which I hope will be fixed in the near future.
+# As of perl5.004_04, all tests pass under:
+#  QNX 4.23A
+#  Watcom 10.6 with Beta/970211.wcc.update.tar.F
+#  socket3r.lib Nov21 1996.
 #
 # As with many unix ports, this one depends on a few "standard"
 # unix utilities which are not necessarily standard for QNX.
 #----------------------------------------------------------------
 # Outstanding Issues:
 #   lib/posix.t test fails on test 17 because acos(1) != 0.
-#      Watcom promises to fix this in next release.
+#      Resolved in 970211 Beta
 #   lib/io_udp.t test hangs because of a bug in getsockname().
 #      Fixed in latest BETA socket3r.lib
 #   If there is a softlink in your path, Findbin will fail.
-#      This is a documented feature of getpwd().
+#      This is a documented feature of perl's getpwd().
 #   There is currently no support for dynamically linked
 #      libraries.
+#   op/magic.t failure due to a feature of QNX which rewrites script
+#      names before they are executed. I think you'll find that if
+#      you cd `fullpath -t` before doing the make, the test will pass.
 #----------------------------------------------------------------
 # At present, all QNX systems are equivalent architectures,
 # so it might be reasonable to call archname=qnx rather than
 # If you have suggestions or changes, please let me know.
 #----------------------------------------------------------------
 
+echo ""
+echo "Some tests may fail. Please read the hints/qnx.sh file."
+echo ""
+
 #----------------------------------------------------------------
 # QNX doesn't come with a csh and the ports of tcsh I've used
 # don't work reliably:
@@ -63,6 +70,16 @@ d_csh='undef'
 full_csh=''
 
 #----------------------------------------------------------------
+# setuid scripts are secure under QNX.
+#  (Basically, the same race conditions apply, but assuming
+#  the scripts are located in a secure directory, the methods
+#  for exploiting the race condition are defeated because
+#  the loader expands the script name fully before executing
+#  the interpreter.)
+#----------------------------------------------------------------
+d_suidsafe='define'
+
+#----------------------------------------------------------------
 # difftime is implemented as a preprocessor macro, so it doesn't show
 # up in the libraries:
 #----------------------------------------------------------------
@@ -74,16 +91,6 @@ d_difftime='define'
 #----------------------------------------------------------------
 d_strtod='define'
 
-#----------------------------------------------------------------
-# The following exist in the libraries, but there are no
-# prototypes available:
-#----------------------------------------------------------------
-d_setregid='undef'
-d_setreuid='undef'
-d_setlinebuf='undef'
-d_truncate='undef'
-d_getpgid='undef'
-
 lib_ext='3r.lib'
 libc='/usr/lib/clib3r.lib'
 
@@ -107,7 +114,7 @@ ccflags='-DHIDEMYMALLOC -mf -w4 -Wc,-wcd=202 -Wc,-wcd=203 -Wc,-wcd=302 -Wc,-fi=u
 # link as well as the compile. If optimize != -g, you should
 # remove this.
 #----------------------------------------------------------------
-ldflags="-g"
+ldflags="-g -N1M"
 
 so='none'
 selecttype='fd_set *'
@@ -144,6 +151,7 @@ if [ -z "`which nm 2>/dev/null`" ]; then
        #%C     <lib> [<lib> ...]
        #       Designed to mimic Unix's nm utility to list
        #       defined symbols in a library
+       unset WLIB
        for i in $*; do wlib $i; done |
          awk '
            /^  / {
diff --git a/hv.c b/hv.c
index f63dff8..4eaae0f 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -886,7 +886,7 @@ HV *hv;
     }
     xhv->xhv_riter = -1;
     xhv->xhv_eiter = Null(HE*);
-    return xhv->xhv_fill;
+    return xhv->xhv_fill;      /* should be xhv->xhv_keys? May change later */
 }
 
 HE *
@@ -962,7 +962,10 @@ register HE *entry;
 I32 *retlen;
 {
     if (HeKLEN(entry) == HEf_SVKEY) {
-       return SvPV(HeKEY_sv(entry), *(STRLEN*)retlen);
+       STRLEN len;
+       char *p = SvPV(HeKEY_sv(entry), len);
+       *retlen = len;
+       return p;
     }
     else {
        *retlen = HeKLEN(entry);
index 9686bfb..e999d3b 100755 (executable)
@@ -128,9 +128,9 @@ push(@corefiles,'perl.exp') if $^O eq 'aix';
 push(@corefiles,'sperl.o') if -f 'sperl.o';
 foreach $file (@corefiles) {
     # HP-UX (at least) needs to maintain execute permissions
-    # on dynamically-loaded libraries.
+    # on dynamically-loadable libraries. So we do it for all.
     copy_if_diff($file,"$installarchlib/CORE/$file")
-       and chmod($file =~ /^\.(so|$dlext)$/ ? 0555 : 0444,
+       and chmod($file =~ /\.(so|\Q$dlext\E)$/ ? 0555 : 0444,
                   "$installarchlib/CORE/$file");
 }
 
@@ -401,6 +401,11 @@ sub installlib {
     local($depth) = $dir ? "lib/$dir" : "lib";
 
     my $name = $_;
+
+    if ($name eq 'CVS' && -d $name) {
+       $File::Find::prune = 1;
+       return;
+    }
     
     # ignore patch backups and the .exists files.
     return if $name =~ m{\.orig$|~$|^\.exists};
index c45483b..2773a90 100644 (file)
@@ -1,6 +1,5 @@
 package AutoLoader;
 
-use Carp;
 use vars qw(@EXPORT @EXPORT_OK);
 
 BEGIN {
@@ -42,7 +41,9 @@ AUTOLOAD {
            }
            if ($@){
                $@ =~ s/ at .*\n//;
-               croak $@;
+               my $error = $@;
+               require Carp;
+               Carp::croak($error);
            }
        }
     }
@@ -83,7 +84,11 @@ sub import {
            $path ="auto/$calldir/autosplit.ix";
            eval { require $path; };
        }
-       carp $@ if ($@);  
+       if ($@) {
+           my $error = $@;
+           require Carp;
+           Carp::carp($error);
+       }
     } 
 }
 
@@ -169,6 +174,7 @@ Instead, they should define their own AUTOLOAD subroutines along these
 lines:
 
     use AutoLoader;
+    use Carp;
 
     sub AUTOLOAD {
         my $constname;
@@ -183,7 +189,7 @@ lines:
                 croak "Your vendor has not defined constant $constname";
             }
         }
-        eval "sub $AUTOLOAD { $val }";
+       *$AUTOLOAD = sub { $val }; # same as: eval "sub $AUTOLOAD { $val }";
         goto &$AUTOLOAD;
     }
 
index 8271076..11af0a6 100644 (file)
@@ -1,12 +1,17 @@
 package CPAN;
-use vars qw{$Try_autoload 
-           $META $Signal $Cwd $End $Suppress_readline %Dontload};
+use vars qw{$Try_autoload $Revision
+           $META $Signal $Cwd $End
+           $Suppress_readline %Dontload
+           $Frontend
+          };
 
-$VERSION = '1.27';
+$VERSION = '1.3102';
 
-# $Id: CPAN.pm,v 1.160 1997/07/28 12:21:56 k Exp $
+# $Id: CPAN.pm,v 1.202 1997/09/23 18:30:36 k Exp k $
 
-# my $version = substr q$Revision: 1.160 $, 10; # only used during development
+# only used during development:
+$Revision = "";
+# $Revision = "[".substr(q$Revision: 1.202 $, 10)."]";
 
 use Carp ();
 use Config ();
@@ -43,14 +48,19 @@ END { $End++; &cleanup; }
 
 $CPAN::DEBUG ||= 0;
 $CPAN::Signal ||= 0;
+$CPAN::Frontend ||= "CPAN::Shell";
 
 package CPAN;
 use vars qw($VERSION @EXPORT $AUTOLOAD $DEBUG $META $term);
 use strict qw(vars);
 
-@CPAN::ISA = qw(CPAN::Debug Exporter MM); # the MM class from
-                                          # MakeMaker, gives us
-                                          # catfile and catdir
+@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
@@ -69,14 +79,12 @@ sub AUTOLOAD {
        my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
        if ($ok) {
            goto &$AUTOLOAD;
-       } else {
-           warn "not OK: $@";
+#      } else {
+#          $CPAN::Frontend->mywarn("Could not autoload $AUTOLOAD");
        }
-       warn "CPAN doesn't know how to autoload $AUTOLOAD :-(
-Nothing Done.
-";
-       sleep 1;
-       CPAN::Shell->h;
+       $CPAN::Frontend->mywarn(qq{Unknown command "$AUTOLOAD". }.
+                               qq{Type ? for help.
+});
     }
 }
 
@@ -103,11 +111,13 @@ sub shell {
        ($term->ReadLine ne "Term::ReadLine::Stub") ? "enabled" :
            "available (try ``install Bundle::CPAN'')";
 
-    print qq{
-cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION)
-Readline support $rl_avail
+    $CPAN::Frontend->myprint(
+                            qq{
+cpan shell -- CPAN exploration and modules installation (v$CPAN::VERSION$CPAN::Revision)
+ReadLine support $rl_avail
 
-} unless $CPAN::Config->{'inhibit_startup_message'} ;
+}) unless $CPAN::Config->{'inhibit_startup_message'} ;
+    my($continuation) = "";
     while () {
        if ($Suppress_readline) {
            print $prompt;
@@ -116,10 +126,17 @@ Readline support $rl_avail
        } else {
            last unless defined ($_ = $term->readline($prompt));
        }
+       $_ = "$continuation$_" if $continuation;
        s/^\s+//;
        next if /^$/;
        $_ = 'h' if $_ eq '?';
-       if (/^\!/) {
+       if (/^q(?:uit)?$/i) {
+           last;
+       } elsif (s/\\$//s) {
+           chomp;
+           $continuation = $_;
+           $prompt = "    > ";
+       } elsif (/^\!/) {
            s/^\!//;
            my($eval) = $_;
            package CPAN::Eval;
@@ -128,8 +145,8 @@ Readline support $rl_avail
            CPAN->debug("eval[$eval]") if $CPAN::DEBUG;
            eval($eval);
            warn $@ if $@;
-       } elsif (/^q(?:uit)?$/i) {
-           last;
+           $continuation = "";
+           $prompt = "cpan> ";
        } elsif (/./) {
            my(@line);
            if ($] < 5.00322) { # parsewords had a bug until recently
@@ -142,17 +159,19 @@ Readline support $rl_avail
            my $command = shift @line;
            eval { CPAN::Shell->$command(@line) };
            warn $@ if $@;
+           chdir $cwd;
+           $CPAN::Frontend->myprint("\n");
+           $continuation = "";
+           $prompt = "cpan> ";
        }
     } continue {
-       &cleanup, die "Goodbye\n" if $Signal;
-       chdir $cwd;
-       print "\n";
+       &cleanup, $CPAN::Frontend->mydie("Goodbye\n") if $Signal;
     }
 }
 
 package CPAN::CacheMgr;
 use vars qw($Du);
-@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj);
+@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
 use File::Find;
 
 package CPAN::Config;
@@ -166,7 +185,7 @@ use vars qw(%can $dot_cpan);
 );
 
 package CPAN::FTP;
-use vars qw($Ua);
+use vars qw($Ua $Thesite $Themethod);
 @CPAN::FTP::ISA = qw(CPAN::Debug);
 
 package CPAN::Complete;
@@ -200,30 +219,29 @@ use vars qw($AUTOLOAD $redef @ISA);
 #-> sub CPAN::Shell::AUTOLOAD ;
 sub AUTOLOAD {
     my($autoload) = $AUTOLOAD;
+    my $class = shift(@_);
     $autoload =~ s/.*:://;
     if ($autoload =~ /^w/) {
        if ($CPAN::META->has_inst('CPAN::WAIT')) {
-           CPAN::WAIT->wh;
+           CPAN::WAIT->$autoload(@_);
        } else {
-           print STDERR qq{
+           $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
-}
+});
        }
     } else {
        my $ok = CPAN::Shell->try_dot_al($AUTOLOAD);
        if ($ok) {
            goto &$AUTOLOAD;
-       } else {
-           warn "not OK: $@";
+#      } else {
+#          $CPAN::Frontend->mywarn("Could not autoload $autoload");
        }
-       warn "CPAN::Shell doesn't know how to autoload $autoload :-(
-Nothing Done.
-";
-       sleep 1;
-       CPAN::Shell->h;
+       $CPAN::Frontend->mywarn(qq{Unknown command '$autoload'. }.
+                               qq{Type ? for help.
+});
     }
 }
 
@@ -269,17 +287,11 @@ sub try_dot_al {
        $ok = 1;
     }
     $@ = $save;
-    my $lm = Carp::longmess();
+#    my $lm = Carp::longmess();
 #    warn "ok[$ok] autoload[$autoload] longmess[$lm]"; # debug
     return $ok;
 }
 
-# This should be left to a runtime evaluation
-eval {require CPAN::WAIT;};
-unless ($@) {
-    unshift @ISA, "CPAN::WAIT";
-}
-
 #### autoloader is experimental
 #### to try it we have to set $Try_autoload and uncomment
 #### the use statement and uncomment the __END__ below
@@ -289,7 +301,8 @@ unless ($@) {
 # $Try_autoload = 1;
 
 if ($CPAN::Try_autoload) {
-    for my $p (qw(
+    my $p;
+    for $p (qw(
               CPAN::Author CPAN::Bundle CPAN::CacheMgr CPAN::Complete
               CPAN::Config CPAN::Debug CPAN::Distribution CPAN::FTP
               CPAN::FTP::netrc CPAN::Index CPAN::InfoObj CPAN::Module
@@ -340,7 +353,7 @@ sub all {
 #-> sub CPAN::checklock ;
 sub checklock {
     my($self) = @_;
-    my $lockfile = CPAN->catfile($CPAN::Config->{cpan_home},".lock");
+    my $lockfile = MM->catfile($CPAN::Config->{cpan_home},".lock");
     if (-f $lockfile && -M _ > 0) {
        my $fh = FileHandle->new($lockfile);
        my $other = <$fh>;
@@ -348,20 +361,23 @@ sub checklock {
        if (defined $other && $other) {
            chomp $other;
            return if $$==$other; # should never happen
-           print qq{There seems to be running another CPAN process }.
-               qq{($other). Trying to contact...\n};
+           $CPAN::Frontend->mywarn(
+                                   qq{
+There seems to be running another CPAN process ($other). Contacting...
+});
            if (kill 0, $other) {
-               Carp::croak qq{Other job is running.\n}.
-                   qq{You may want to kill it and delete the lockfile, }.
-                       qq{maybe. On UNIX try:\n}.
-                       qq{    kill $other\n}.
-                           qq{    rm $lockfile\n};
+               $CPAN::Frontend->mydie(qq{Other job is running.
+You may want to kill it and delete the lockfile, maybe. On UNIX try:
+    kill $other
+    rm $lockfile
+});
            } elsif (-w $lockfile) {
                my($ans) =
                    ExtUtils::MakeMaker::prompt
                        (qq{Other job not responding. Shall I overwrite }.
                         qq{the lockfile? (Y/N)},"y");
-               print("Ok, bye\n"), exit unless $ans =~ /^y/i;
+               $CPAN::Frontend->myexit("Ok, bye\n")
+                   unless $ans =~ /^y/i;
            } else {
                Carp::croak(
                            qq{Lockfile $lockfile not writeable by you. }.
@@ -379,7 +395,7 @@ sub checklock {
        if ($! =~ /Permission/) {
            my $incc = $INC{'CPAN/Config.pm'};
            my $myincc = MM->catfile($ENV{HOME},'.cpan','CPAN','MyConfig.pm');
-           print qq{
+           $CPAN::Frontend->myprint(qq{
 
 Your configuration suggests that CPAN.pm should use a working
 directory of
@@ -396,17 +412,20 @@ this variable in either
 or
     $myincc
 
-};
+});
        }
-       Carp::croak "Could not open >$lockfile: $!";
+       $CPAN::Frontend->mydie("Could not open >$lockfile: $!");
     }
-    print $fh $$, "\n";
+    $fh->print($$, "\n");
     $self->{LOCK} = $lockfile;
     $fh->close;
-    $SIG{'TERM'} = sub { &cleanup; die "Got SIGTERM, leaving"; };
+    $SIG{'TERM'} = sub {
+       &cleanup;
+       $CPAN::Frontend->mydie("Got SIGTERM, leaving");
+    };
     $SIG{'INT'} = sub {
        my $s = $Signal == 2 ? "a second" : "another";
-       &cleanup, die "Got $s SIGINT" if $Signal;
+       &cleanup, $CPAN::Frontend->mydie("Got $s SIGINT") if $Signal;
        $Signal = 1;
     };
     $SIG{'__DIE__'} = \&cleanup;
@@ -445,43 +464,38 @@ sub has_inst {
        return 0;
     }
     my $file = $mod;
+    my $obj;
     $file =~ s|::|/|g;
     $file =~ s|/|\\|g if $^O eq 'MSWin32';
     $file .= ".pm";
-    if (exists $INC{$file} && $INC{$file}) {
+    if ($INC{$file}) {
 #      warn "$file in %INC"; #debug
        return 1;
-    } elsif ( my($obj) = CPAN::Shell->expand('Module',$mod) ) {
-       if ($obj->inst_file) {
-           require $file;
-           print "CPAN: $mod successfully required\n";
-
-           if ($mod eq "CPAN::WAIT") {
-               push @CPAN::Shell::ISA, CPAN::WAIT unless $@;
-           }
-           warn $@ if $@;
-           return $@ ? 0 : 1;
-       } elsif ($mod eq "MD5"){
-           print qq{
-  CPAN: MD5 security checks disabled because MD5 not installed.
-  Please consider installing the MD5 module
-
-};
-           sleep 2;
-       }
     } elsif (eval { require $file }) {
-       # we can still have luck, if the program is fed with a bogus
-       # database or what
+       # 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;
+       }
        return 1;
     } elsif ($mod eq "Net::FTP") {
        warn qq{
   Please, install Net::FTP as soon as possible. CPAN.pm installs it for you
   if you just type
       install Bundle::libnet
-  Thank you.
 
 };
        sleep 2;
+    } elsif ($mod eq "MD5"){
+       $CPAN::Frontend->myprint(qq{
+  CPAN: MD5 security checks disabled because MD5 not installed.
+  Please consider installing the MD5 module.
+
+});
+       sleep 2;
     }
     return 0;
 }
@@ -510,7 +524,7 @@ sub cleanup {
     return unless defined $META->{'LOCK'};
     return unless -f $META->{'LOCK'};
     unlink $META->{'LOCK'};
-    print STDERR "Lockfile removed.\n";
+    $CPAN::Frontend->mywarn("Lockfile removed.\n");
 }
 
 package CPAN::CacheMgr;
@@ -570,11 +584,11 @@ sub entries {
     for ($dh->read) {
        next if $_ eq "." || $_ eq "..";
        if (-f $_) {
-           push @entries, $CPAN::META->catfile($dir,$_);
+           push @entries, MM->catfile($dir,$_);
        } elsif (-d _) {
-           push @entries, $CPAN::META->catdir($dir,$_);
+           push @entries, MM->catdir($dir,$_);
        } else {
-           print STDERR "Warning: weird direntry in $dir: $_\n";
+           $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
        }
     }
     chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
@@ -603,8 +617,12 @@ sub disk_usage {
     $self->{DU} += $Du/1024/1024;
     if ($self->{DU} > $self->{'MAX'} ) {
        my($toremove) = shift @{$self->{FIFO}};
-       printf "...Hold on a sec... cleaning from cache (%.1f>%.1f MB): $toremove\n",
-               $self->{DU}, $self->{'MAX'};
+       $CPAN::Frontend->myprint(sprintf(
+                                        "...Hold on a sec... ".
+                                        "cleaning from cache ".
+                                        "(%.1f>%.1f MB): $toremove\n",
+                                        $self->{DU}, $self->{'MAX'})
+                               );
        $self->force_clean_cache($toremove);
     }
     $self->{DU};
@@ -658,23 +676,17 @@ sub debug {
     ($caller) = caller(0);
     $caller =~ s/.*:://;
     $arg = "" unless defined $arg;
-    my $rest = join ":", map { defined $_ ? $_ : "UNDEF" } @rest;
-#    print "caller[$caller]\n";
-#    print "func[$func]\n";
-#    print "line[$line]\n";
-#    print "rest[@rest]\n";
-#    print "CPAN::DEBUG{caller}[$CPAN::DEBUG{$caller}]\n";
-#    print "CPAN::DEBUG[$CPAN::DEBUG]\n";
+    my $rest = join "|", map { defined $_ ? $_ : "UNDEF" } @rest;
     if ($CPAN::DEBUG{$caller} & $CPAN::DEBUG){
        if ($arg and ref $arg) {
            eval { require Data::Dumper };
            if ($@) {
-               print $arg->as_string;
+               $CPAN::Frontend->myprint($arg->as_string);
            } else {
-               print Data::Dumper::Dumper($arg);
+               $CPAN::Frontend->myprint(Data::Dumper::Dumper($arg));
            }
        } else {
-           print "Debug($caller:$func,$line,[$rest]): $arg\n"
+           $CPAN::Frontend->myprint("Debug($caller:$func,$line,[$rest]): $arg\n");
        }
     }
 }
@@ -709,17 +721,18 @@ sub edit {
            } elsif (@args) {
                $CPAN::Config->{$o} = [@args];
            } else {
-               print(
-                     "  $o  ",
-                     ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
-                     "\n"
+               $CPAN::Frontend->myprint(
+                                        join "",
+                                        "  $o  ",
+                                        ExtUtils::MakeMaker::neatvalue($CPAN::Config->{$o}),
+                                        "\n"
                     );
            }
        } else {
            $CPAN::Config->{$o} = $args[0] if defined $args[0];
-           print "    $o    ";
-           print defined $CPAN::Config->{$o} ?
-               $CPAN::Config->{$o} : "UNDEFINED";
+           $CPAN::Frontend->myprint("    $o    " .
+                                    (defined $CPAN::Config->{$o} ?
+                                     $CPAN::Config->{$o} : "UNDEFINED"));
        }
     }
 }
@@ -755,7 +768,7 @@ EOF
     $msg ||= "\n";
     my($fh) = FileHandle->new;
     open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
-    print $fh qq[$msg\$CPAN::Config = \{\n];
+    $fh->print(qq[$msg\$CPAN::Config = \{\n]);
     foreach (sort keys %$CPAN::Config) {
        $fh->print(
                   "  '$_' => ",
@@ -764,13 +777,13 @@ EOF
                  );
     }
 
-    print $fh "};\n1;\n__END__\n";
+    $fh->print("};\n1;\n__END__\n");
     close $fh;
 
     #$mode = 0444 | ( $mode & 0111 ? 0111 : 0 );
     #chmod $mode, $configpm;
 ###why was that so?    $self->defaults;
-    print "commit: wrote $configpm\n";
+    $CPAN::Frontend->myprint("commit: wrote $configpm\n");
     1;
 }
 
@@ -798,10 +811,13 @@ sub init {
 sub load {
     my($self) = shift;
     my(@miss);
-    eval {require CPAN::Config;};       # We eval, because of some MakeMaker problems
-    unshift @INC, $CPAN::META->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
-    eval {require CPAN::MyConfig;};     # where you can override system wide settings
+    eval {require CPAN::Config;};       # We eval because of some
+                                        # MakeMaker problems
+    unshift @INC, MM->catdir($ENV{HOME},".cpan") unless $dot_cpan++;
+    eval {require CPAN::MyConfig;};     # where you can override
+                                        # system wide settings
     return unless @miss = $self->not_loaded;
+    # XXX better check for arrayrefs too
     require CPAN::FirstTime;
     my($configpm,$fh,$redo,$theycalled);
     $redo ||= "";
@@ -856,14 +872,14 @@ sub load {
        }
     }
     local($") = ", ";
-    print qq{
+    $CPAN::Frontend->myprint(qq{
 We have to reconfigure CPAN.pm due to following uninitialized parameters:
 
 @miss
-} if $redo && ! $theycalled;
-    print qq{
+}) if $redo && ! $theycalled;
+    $CPAN::Frontend->myprint(qq{
 $configpm initialized.
-};
+});
     sleep 2;
     CPAN::FirstTime::init($configpm);
 }
@@ -890,7 +906,7 @@ sub unload {
 *h = \&help;
 #-> sub CPAN::Config::help ;
 sub help {
-    print <<EOF;
+    $CPAN::Frontend->myprint(qq{
 Known options:
   defaults  reload default config values from disk
   commit    commit session changes to disk
@@ -906,7 +922,7 @@ You may edit key values in the follow fashion:
 
   o conf urllist unshift ftp://ftp.foo.bar/
 
-EOF
+});
     undef; #don't reprint CPAN::Config
 }
 
@@ -914,6 +930,17 @@ EOF
 sub cpl {
     my($word,$line,$pos) = @_;
     $word ||= "";
+    CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
+    my(@words) = split " ", substr($line,0,$pos+1);
+    if (
+       $words[2] =~ /list$/ && @words == 3
+       ||
+       $words[2] =~ /list$/ && @words == 4 && length($word) 
+       ) {
+       return grep /^\Q$word\E/, qw(splice shift unshift pop push);
+    } elsif (@words >= 4) {
+       return ();
+    }
     my(@o_conf) = (keys %CPAN::Config::can, keys %$CPAN::Config);
     return grep /^\Q$word\E/, @o_conf;
 }
@@ -924,9 +951,9 @@ package CPAN::Shell;
 sub h {
     my($class,$about) = @_;
     if (defined $about) {
-       print "Detailed help not yet implemented\n";
+       $CPAN::Frontend->myprint("Detailed help not yet implemented\n");
     } else {
-       print q{
+       $CPAN::Frontend->myprint(q{
 command   arguments       description
 a         string                  authors
 b         or              display bundles
@@ -949,34 +976,34 @@ h or ?                  display this menu
 o         various       set and query options
 !         perl-code     eval a perl command
 q                       quit the shell subroutine
-};
+});
     }
 }
 
 #-> sub CPAN::Shell::a ;
-sub a { print shift->format_result('Author',@_);}
+sub a { $CPAN::Frontend->myprint(shift->format_result('Author',@_));}
 #-> sub CPAN::Shell::b ;
 sub b {
     my($self,@which) = @_;
     CPAN->debug("which[@which]") if $CPAN::DEBUG;
     my($incdir,$bdir,$dh);
     foreach $incdir ($CPAN::Config->{'cpan_home'},@INC) {
-       $bdir = $CPAN::META->catdir($incdir,"Bundle");
+       $bdir = MM->catdir($incdir,"Bundle");
        if ($dh = DirHandle->new($bdir)) { # may fail
            my($entry);
            for $entry ($dh->read) {
-               next if -d $CPAN::META->catdir($bdir,$entry);
+               next if -d MM->catdir($bdir,$entry);
                next unless $entry =~ s/\.pm$//;
                $CPAN::META->instance('CPAN::Bundle',"Bundle::$entry");
            }
        }
     }
-    print $self->format_result('Bundle',@which);
+    $CPAN::Frontend->myprint($self->format_result('Bundle',@which));
 }
 #-> sub CPAN::Shell::d ;
-sub d { print shift->format_result('Distribution',@_);}
+sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
 #-> sub CPAN::Shell::m ;
-sub m { print shift->format_result('Module',@_);}
+sub m { $CPAN::Frontend->myprint(shift->format_result('Module',@_));}
 
 #-> sub CPAN::Shell::i ;
 sub i {
@@ -993,7 +1020,7 @@ sub i {
        $result[0]->as_string :
            join "", map {$_->as_glimpse} @result;
     $result ||= "No objects found of any type for argument @args\n";
-    print $result;
+    $CPAN::Frontend->myprint($result);
 }
 
 #-> sub CPAN::Shell::o ;
@@ -1005,24 +1032,32 @@ sub o {
        shift @o_what if @o_what && $o_what[0] eq 'help';
        if (!@o_what) {
            my($k,$v);
-           print "CPAN::Config options:\n";
+           $CPAN::Frontend->myprint("CPAN::Config options:\n");
            for $k (sort keys %CPAN::Config::can) {
                $v = $CPAN::Config::can{$k};
-               printf "    %-18s %s\n", $k, $v;
+               $CPAN::Frontend->myprint(sprintf "    %-18s %s\n", $k, $v);
            }
-           print "\n";
+           $CPAN::Frontend->myprint("\n");
            for $k (sort keys %$CPAN::Config) {
                $v = $CPAN::Config->{$k};
                if (ref $v) {
-                   printf "    %-18s\n", $k;
-                   print map {"\t$_\n"} @{$v};
+                   $CPAN::Frontend->myprint(
+                                            join(
+                                                 "",
+                                                 sprintf(
+                                                         "    %-18s\n",
+                                                         $k
+                                                        ),
+                                                 map {"\t$_\n"} @{$v}
+                                                )
+                                           );
                } else {
-                   printf "    %-18s %s\n", $k, $v;
+                   $CPAN::Frontend->myprint(sprintf "    %-18s %s\n", $k, $v);
                }
            }
-           print "\n";
+           $CPAN::Frontend->myprint("\n");
        } elsif (!CPAN::Config->edit(@o_what)) {
-           print qq[Type 'o conf' to view configuration edit options\n\n];
+           $CPAN::Frontend->myprint(qq[Type 'o conf' to view configuration edit options\n\n]);
        }
     } elsif ($o_type eq 'debug') {
        my(%valid);
@@ -1047,31 +1082,32 @@ sub o {
                        $CPAN::DEBUG |= $CPAN::DEBUG{$_};
                        $known = 1;
                    }
-                   print "unknown argument [$what]\n" unless $known;
+                   $CPAN::Frontend->myprint("unknown argument [$what]\n")
+                       unless $known;
                }
            }
        } else {
-           print "Valid options for debug are ".
-               join(", ",sort(keys %CPAN::DEBUG), 'all').
+           $CPAN::Frontend->myprint("Valid options for debug are ".
+                                    join(", ",sort(keys %CPAN::DEBUG), 'all').
                    qq{ or a number. Completion works on the options. }.
-                       qq{Case is ignored.\n\n};
+                       qq{Case is ignored.\n\n});
        }
        if ($CPAN::DEBUG) {
-           print "Options set for debugging:\n";
+           $CPAN::Frontend->myprint("Options set for debugging:\n");
            my($k,$v);
            for $k (sort {$CPAN::DEBUG{$a} <=> $CPAN::DEBUG{$b}} keys %CPAN::DEBUG) {
                $v = $CPAN::DEBUG{$k};
-               printf "    %-14s(%s)\n", $k, $v if $v & $CPAN::DEBUG;
+               $CPAN::Frontend->myprint(sprintf "    %-14s(%s)\n", $k, $v) if $v & $CPAN::DEBUG;
            }
        } else {
-           print "Debugging turned off completely.\n";
+           $CPAN::Frontend->myprint("Debugging turned off completely.\n");
        }
     } else {
-       print qq{
+       $CPAN::Frontend->myprint(qq{
 Known options:
   conf    set or get configuration variables
   debug   set or get debugging options
-};
+});
     }
 }
 
@@ -1091,19 +1127,20 @@ sub reload {
                if ( $_[0] =~ /Subroutine \w+ redefined/ ) {
                    ++$redef;
                    local($|) = 1;
-                   print ".";
+                   $CPAN::Frontend->myprint(".");
                    return;
                }
                warn @_;
            };
        eval <$fh>;
        warn $@ if $@;
-       print "\n$redef subroutines redefined\n";
+       $CPAN::Frontend->myprint("\n$redef subroutines redefined\n");
     } elsif ($command =~ /index/) {
        CPAN::Index->force_reload;
     } else {
-       print qq{cpan     re-evals the CPAN.pm file\n};
-       print qq{index    re-reads the index files\n};
+       $CPAN::Frontend->myprint(qq{cpan     re-evals the CPAN.pm file
+index    re-reads the index files
+});
     }
 }
 
@@ -1111,18 +1148,19 @@ sub reload {
 sub _binary_extensions {
     my($self) = shift @_;
     my(@result,$module,%seen,%need,$headerdone);
+    my $isaperl = q{perl5[._-]\\d{3}(_[0-4][0-9])?\\.tar[._-]gz$};
     for $module ($self->expand('Module','/./')) {
        my $file  = $module->cpan_file;
        next if $file eq "N/A";
        next if $file =~ /^Contact Author/;
-       next if $file =~ /perl5[._-]\d{3}(?:[\d_]+)?\.tar[._-]gz$/;
+       next if $file =~ / $isaperl /xo;
        next unless $module->xs_file;
        local($|) = 1;
-       print ".";
+       $CPAN::Frontend->myprint(".");
        push @result, $module;
     }
 #    print join " | ", @result;
-    print "\n";
+    $CPAN::Frontend->myprint("\n");
     return @result;
 }
 
@@ -1131,14 +1169,15 @@ sub recompile {
     my($self) = shift @_;
     my($module,@module,$cpan_file,%dist);
     @module = $self->_binary_extensions();
-    for $module (@module){  # we force now and compile later, so we don't do it twice
+    for $module (@module){  # we force now and compile later, so we
+                            # don't do it twice
        $cpan_file = $module->cpan_file;
        my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
        $pack->force;
        $dist{$cpan_file}++;
     }
     for $cpan_file (sort keys %dist) {
-       print "  CPAN: Recompiling $cpan_file\n\n";
+       $CPAN::Frontend->myprint("  CPAN: Recompiling $cpan_file\n\n");
        my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
        $pack->install;
        $CPAN::Signal = 0; # it's tempting to reset Signal, so we can
@@ -1156,13 +1195,14 @@ sub _u_r_common {
     Carp::croak "Usage: \$obj->_u_r_common(a|r|u)" unless $what =~ /^[aru]$/;
     my(@args) = @_;
     @args = '/./' unless @args;
-    my(@result,$module,%seen,%need,$headerdone,$version_zeroes);
-    $version_zeroes = 0;
+    my(@result,$module,%seen,%need,$headerdone,
+       $version_undefs,$version_zeroes);
+    $version_undefs = $version_zeroes = 0;
     my $sprintf = "%-25s %9s %9s  %s\n";
     for $module ($self->expand('Module',@args)) {
        my $file  = $module->cpan_file;
        next unless defined $file; # ??
-       my($latest) = $module->cpan_version || 0;
+       my($latest) = $module->cpan_version;
        my($inst_file) = $module->inst_file;
        my($have);
        if ($inst_file){
@@ -1171,8 +1211,15 @@ sub _u_r_common {
            } elsif ($what eq "r") {
                $have = $module->inst_version;
                local($^W) = 0;
-               $version_zeroes++ unless $have;
+               if ($have eq "undef"){
+                   $version_undefs++;
+               } elsif ($have == 0){
+                   $version_zeroes++;
+               }
                next if $have >= $latest;
+# to be pedantic we should probably say:
+#    && !($have eq "undef" && $latest ne "undef" && $latest gt "");
+# to catch the case where CPAN has a version 0 and we have a version undef
            } elsif ($what eq "u") {
                next;
            }
@@ -1198,30 +1245,38 @@ sub _u_r_common {
            next if $file =~ /^Contact/;
        }
        unless ($headerdone++){
-           print "\n";
-           printf(
+           $CPAN::Frontend->myprint("\n");
+           $CPAN::Frontend->myprint(sprintf(
                   $sprintf,
                   "Package namespace",
                   "installed",
                   "latest",
                   "in CPAN file"
-                  );
+                  ));
        }
        $latest = substr($latest,0,8) if length($latest) > 8;
        $have = substr($have,0,8) if length($have) > 8;
-       printf $sprintf, $module->id, $have, $latest, $file;
+       $CPAN::Frontend->myprint(sprintf $sprintf, $module->id, $have, $latest, $file);
        $need{$module->id}++;
     }
     unless (%need) {
        if ($what eq "u") {
-           print "No modules found for @args\n";
+           $CPAN::Frontend->myprint("No modules found for @args\n");
        } elsif ($what eq "r") {
-           print "All modules are up to date for @args\n";
+           $CPAN::Frontend->myprint("All modules are up to date for @args\n");
        }
     }
-    if ($what eq "r" && $version_zeroes) {
-       my $s = $version_zeroes > 1 ? "s have" : " has";
-       print qq{$version_zeroes installed module$s no version number to compare\n};
+    if ($what eq "r") {
+       if ($version_zeroes) {
+           my $s_has = $version_zeroes > 1 ? "s have" : " has";
+           $CPAN::Frontend->myprint(qq{$version_zeroes installed module$s_has }.
+               qq{a version number of 0\n});
+       }
+       if ($version_undefs) {
+           my $s_has = $version_undefs > 1 ? "s have" : " has";
+           $CPAN::Frontend->myprint(qq{$version_undefs installed module$s_has no }.
+               qq{parseable version number\n});
+       }
     }
     @result;
 }
@@ -1240,10 +1295,10 @@ sub u {
 sub autobundle {
     my($self) = shift;
     my(@bundle) = $self->_u_r_common("a",@_);
-    my($todir) = $CPAN::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
+    my($todir) = MM->catdir($CPAN::Config->{'cpan_home'},"Bundle");
     File::Path::mkpath($todir);
     unless (-d $todir) {
-       print "Couldn't mkdir $todir for some reason\n";
+       $CPAN::Frontend->myprint("Couldn't mkdir $todir for some reason\n");
        return;
     }
     my($y,$m,$d) =  (localtime)[5,4,3];
@@ -1251,10 +1306,10 @@ sub autobundle {
     $m++;
     my($c) = 0;
     my($me) = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, $c;
-    my($to) = $CPAN::META->catfile($todir,"$me.pm");
+    my($to) = MM->catfile($todir,"$me.pm");
     while (-f $to) {
        $me = sprintf "Snapshot_%04d_%02d_%02d_%02d", $y, $m, $d, ++$c;
-       $to = $CPAN::META->catfile($todir,"$me.pm");
+       $to = MM->catfile($todir,"$me.pm");
     }
     my($fh) = FileHandle->new(">$to") or Carp::croak "Can't open >$to: $!";
     $fh->print(
@@ -1278,8 +1333,8 @@ sub autobundle {
               "by the autobundle routine in CPAN.pm.\n",
              );
     $fh->close;
-    print "\nWrote bundle file
-    $to\n\n";
+    $CPAN::Frontend->myprint("\nWrote bundle file
+    $to\n\n");
 }
 
 #-> sub CPAN::Shell::expand ;
@@ -1341,6 +1396,67 @@ sub format_result {
     $result;
 }
 
+# The only reason for this method is currently to have a reliable
+# debugging utility that reveals which output is going through which
+# channel. No, I don't like the colors ;-)
+sub print_ornamented {
+    my($self,$what,$ornament) = @_;
+    my $longest = 0;
+    my $ornamenting = 0; # turn the colors on
+
+    if ($ornamenting) {
+       unless (defined &color) {
+           if ($CPAN::META->has_inst("Term::ANSIColor")) {
+               import Term::ANSIColor "color";
+           } else {
+               *color = sub { return "" };
+           }
+       }
+       for my $line (split /\n/, $what) {
+           $longest = length($line) if length($line) > $longest;
+       }
+       my $sprintf = "%-" . $longest . "s";
+       while ($what){
+           $what =~ s/(.*\n?)//m;
+           my $line = $1;
+           last unless $line;
+           my($nl) = chomp $line ? "\n" : "";
+           #   print "line[$line]ornament[$ornament]sprintf[$sprintf]\n";
+           print color($ornament), sprintf($sprintf,$line), color("reset"), $nl;
+       }
+    } else {
+       print $what;
+    }
+}
+
+sub myprint {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold blue on_yellow');
+}
+
+sub myexit {
+    my($self,$what) = @_;
+    $self->myprint($what);
+    exit;
+}
+
+sub mywarn {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold red on_yellow');
+}
+
+sub myconfess {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold red on_white');
+    Carp::confess "died";
+}
+
+sub mydie {
+    my($self,$what) = @_;
+    $self->print_ornamented($what, 'bold red on_white');
+    die "\n";
+}
+
 #-> sub CPAN::Shell::rematein ;
 sub rematein {
     shift;
@@ -1378,15 +1494,20 @@ sub rematein {
            $obj->$meth();
        } elsif ($CPAN::META->exists('CPAN::Author',$s)) {
            $obj = $CPAN::META->instance('CPAN::Author',$s);
-           print "Don't be silly, you can't $meth ", $obj->fullname, " ;-)\n";
+           $CPAN::Frontend->myprint(
+                                    join "",
+                                    "Don't be silly, you can't $meth ",
+                                    $obj->fullname,
+                                    " ;-)\n"
+                                   );
        } else {
-           print qq{Warning: Cannot $meth $s, don\'t know what it is.
+           $CPAN::Frontend->myprint(qq{Warning: Cannot $meth $s, don\'t know what it is.
 Try the command
 
     i /$s/
 
 to find objects with similar identifiers.
-};
+});
        }
     }
 }
@@ -1425,7 +1546,6 @@ sub ftp_get {
        warn "Couldn't login on $host";
        return;
     }
-    # print qq[Going to ->cwd("$dir")\n];
     unless ( $ftp->cwd($dir) ){
        warn "Couldn't cwd $dir";
        return;
@@ -1440,6 +1560,22 @@ sub ftp_get {
     return 1;
 }
 
+sub is_reachable {
+    my($self,$url) = @_;
+    return 1; # we can't simply roll our own, firewalls may break ping
+    return 0 unless $url;
+    return 1 if substr($url,0,4) eq "file";
+    return 1 unless $url =~ m|://([^/]+)|;
+    my $host = $1;
+    require Net::Ping;
+    return 1 unless $Net::Ping::VERSION >= 2;
+    my $p;
+    eval {$p = Net::Ping->new("icmp");};
+    eval {$p = Net::Ping->new("tcp");} if $@;
+    $CPAN::Frontend->mydie($@) if $@;
+    return $p->ping($host, 3);
+}
+
 #-> sub CPAN::FTP::localize ;
 # sorry for the ugly code here, I'll clean it up as soon as Net::FTP
 # is in the core
@@ -1451,7 +1587,7 @@ sub localize {
     $self->debug("file[$file] aslocal[$aslocal] force[$force]")
        if $CPAN::DEBUG;
 
-    return $aslocal if -f $aslocal && -r _ && ! $force;
+    return $aslocal if -f $aslocal && -r _ && !($force & 1);
     my($restore) = 0;
     if (-f $aslocal){
        rename $aslocal, "$aslocal.bak";
@@ -1460,10 +1596,10 @@ sub localize {
 
     my($aslocal_dir) = File::Basename::dirname($aslocal);
     File::Path::mkpath($aslocal_dir);
-    print STDERR qq{Warning: You are not allowed to write into }.
+    $CPAN::Frontend->mywarn(qq{Warning: You are not allowed to write into }.
        qq{directory "$aslocal_dir".
-    I\'ll continue, but if you face any problems, they may be due
-    to insufficient permissions.\n} unless -w $aslocal_dir;
+    I\'ll continue, but if you encounter problems, they may be due
+    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')) {
@@ -1482,12 +1618,78 @@ sub localize {
 
     # Try the list of urls for each single object. We keep a record
     # where we did get a file from
+    my(@reordered,$last);
+#line 1621
+    $last = $#{$CPAN::Config->{urllist}};
+    if ($force & 2) { # local cpans probably out of date, don't reorder
+       @reordered = (0..$last);
+    } else {
+       @reordered =
+           sort {
+               (substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
+                   <=> 
+               (substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
+                   or
+               defined($Thesite)
+                   and
+               ($b == $Thesite)
+                   <=>
+               ($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) {
+       @levels = ($Themethod, grep {$_ ne $Themethod} qw/easy hard hardest/);
+    } else {
+       @levels = qw/easy hard hardest/;
+    }
+    for $level (@levels) {
+       my $method = "host$level";
+       my @host_seq = $level eq "easy" ?
+           @reordered : 0..$last;  # reordered has CDROM up front
+       my $ret = $self->$method(\@host_seq,$file,$aslocal);
+       if ($ret) {
+           $Themethod = $level;
+           $self->debug("level[$level]") if $CPAN::DEBUG;
+           return $ret;
+       }
+    }
+    my(@mess);
+    push @mess,
+    qq{Please check, if the URLs I found in your configuration file \(}.
+       join(", ", @{$CPAN::Config->{urllist}}).
+           qq{\) are valid. The urllist can be edited.},
+           qq{E.g. with ``o conf urllist push ftp://myurl/''};
+    $CPAN::Frontend->myprint(Text::Wrap::wrap("","",@mess). "\n\n");
+    sleep 2;
+    $CPAN::Frontend->myprint("Cannot fetch $file\n\n");
+    if ($restore) {
+       rename "$aslocal.bak", $aslocal;
+       $CPAN::Frontend->myprint("Trying to get away with old file:\n" .
+                                $self->ls($aslocal));
+       return $aslocal;
+    }
+    return;
+}
+
+sub hosteasy {
+    my($self,$host_seq,$file,$aslocal) = @_;
     my($i);
-    for $i (0..$#{$CPAN::Config->{urllist}}) {
+  HOSTEASY: for $i (@$host_seq) {
        my $url = $CPAN::Config->{urllist}[$i];
+       unless ($self->is_reachable($url)) {
+           $CPAN::Frontend->myprint("Skipping $url (seems to be not reachable)\n");
+           sleep 2;
+           next;
+       }
        $url .= "/" unless substr($url,-1) eq "/";
        $url .= $file;
-       $self->debug("localizing[$url]") if $CPAN::DEBUG;
+       $self->debug("localizing perlish[$url]") if $CPAN::DEBUG;
        if ($url =~ /^file:/) {
            my $l;
            if ($CPAN::META->has_inst('LWP')) {
@@ -1495,27 +1697,51 @@ sub localize {
                my $u =  URI::URL->new($url);
                $l = $u->path;
            } else { # works only on Unix, is poorly constructed, but
-                     # hopefully better than nothing.
-                    # RFC 1738 says fileurl BNF is
-                    # fileurl = "file://" [ host | "localhost" ] "/" fpath
-                    # Thanks to "Mark D. Baushke" <mdb@cisco.com> for the code
+               # hopefully better than nothing.
+               # RFC 1738 says fileurl BNF is
+               # 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
            }
-           return $l if -f $l && -r _;
+           if ( -f $l && -r _) {
+               $Thesite = $i;
+               return $l;
+           }
            # Maybe mirror has compressed it?
            if (-f "$l.gz") {
                $self->debug("found compressed $l.gz") if $CPAN::DEBUG;
                system("$CPAN::Config->{gzip} -dc $l.gz > $aslocal");
-               return $aslocal if -f $aslocal;
+               if ( -f $aslocal) {
+                   $Thesite = $i;
+                   return $aslocal;
+               }
            }
        }
-
        if ($CPAN::META->has_inst('LWP')) {
-           print "Fetching $url with LWP\n";
+           $CPAN::Frontend->myprint("Fetching with LWP:
+  $url
+");
            my $res = $Ua->mirror($url, $aslocal);
            if ($res->is_success) {
+               $Thesite = $i;
                return $aslocal;
+           } elsif ($url !~ /\.gz$/) {
+               my $gzurl = "$url.gz";
+               $CPAN::Frontend->myprint("Fetching with LWP:
+  $gzurl
+");
+               $res = $Ua->mirror($gzurl, "$aslocal.gz");
+               if ($res->is_success &&
+                   system("$CPAN::Config->{gzip} -d $aslocal.gz")==0) {
+                   $Thesite = $i;
+                   return $aslocal;
+               } else {
+                   next HOSTEASY ;
+               }
+           } else {
+               next HOSTEASY ;
            }
        }
        if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
@@ -1523,202 +1749,259 @@ sub localize {
            my($host,$dir,$getfile) = ($1,$2,$3);
            if ($CPAN::META->has_inst('Net::FTP')) {
                $dir =~ s|/+|/|g;
-               $self->debug("Going to fetch file [$getfile]
-  from dir [$dir]
-  on host  [$host]
-  as local [$aslocal]") if $CPAN::DEBUG;
-               CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal) && return $aslocal;
-               warn "Net::FTP failed for some reason\n";
+               $CPAN::Frontend->myprint("Fetching with Net::FTP:
+  $aslocal
+");
+               $self->debug("getfile[$getfile]dir[$dir]host[$host]" .
+                            "aslocal[$aslocal]") if $CPAN::DEBUG;
+               if (CPAN::FTP->ftp_get($host,$dir,$getfile,$aslocal)) {
+                   $Thesite = $i;
+                   return $aslocal;
+               }
+               if ($aslocal !~ /\.gz$/) {
+                   my $gz = "$aslocal.gz";
+                   $CPAN::Frontend->myprint("Fetching with Net::FTP
+   $gz
+");
+                   if (CPAN::FTP->ftp_get($host,
+                                      $dir,
+                                      "$getfile.gz",
+                                      $gz) &&
+                       system("$CPAN::Config->{gzip} -d $gz")==0 ){
+                       $Thesite = $i;
+                       return $aslocal;
+                   }
+               }
+               next HOSTEASY;
            }
        }
+    }
+}
 
-       # 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...
+sub hosthard {
+    my($self,$host_seq,$file,$aslocal) = @_;
 
-       my($funkyftp);
-       # does ncftp handle http?
-       for $funkyftp ($CPAN::Config->{'lynx'},$CPAN::Config->{'ncftp'}) {
+    # 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];
+       unless ($self->is_reachable($url)) {
+           $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
+           next;
+       }
+       $url .= "/" unless substr($url,-1) eq "/";
+       $url .= $file;
+       my($host,$dir,$getfile);
+       if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+           ($host,$dir,$getfile) = ($1,$2,$3);
+       } else {
+           next HOSTHARD; # who said, we could ftp anything except ftp?
+       }
+       $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;
            next if $funkyftp =~ /^\s*$/;
            my($want_compressed);
-           print(
-                 qq{
-Trying with $funkyftp to get
-  $url
-});
-           $want_compressed = $aslocal =~ s/\.gz//;
+           my $aslocal_uncompressed;
+           ($aslocal_uncompressed = $aslocal) =~ s/\.gz//;
            my($source_switch) = "";
            $source_switch = "-source" if $funkyftp =~ /\blynx$/;
            $source_switch = "-c" if $funkyftp =~ /\bncftp$/;
-           my($system) = "$funkyftp $source_switch '$url' > $aslocal";
+           $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);
            if (($wstatus = system($system)) == 0
                &&
-               -s $aslocal   # lynx returns 0 on my system even if it fails
+               -s $aslocal_uncompressed   # lynx returns 0 on my
+                                           # system even if it fails
               ) {
-               if ($want_compressed) {
-                   $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
+               if ($aslocal_uncompressed ne $aslocal) {
+                   # test gzip integrity
+                   $system =
+                       "$CPAN::Config->{'gzip'} -dt $aslocal_uncompressed";
                    if (system($system) == 0) {
-                       rename $aslocal, "$aslocal.gz";
+                       rename $aslocal_uncompressed, $aslocal;
                    } else {
-                       $system = "$CPAN::Config->{'gzip'} $aslocal";
+                       $system =
+                           "$CPAN::Config->{'gzip'} $aslocal_uncompressed";
                        system($system);
                    }
-                   return "$aslocal.gz";
-               } else {
-                   $system = "$CPAN::Config->{'gzip'} -dt $aslocal";
+                   $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
+                   $system =
+                       "$CPAN::Config->{'gzip'} -dt $aslocal_uncompressed.gz";
+                   $CPAN::Frontend->mywarn("system[$system]");
                    if (system($system) == 0) {
-                       $system = "$CPAN::Config->{'gzip'} -d $aslocal";
+                       $system = "$CPAN::Config->{'gzip'} -dc ".
+                           "$aslocal_uncompressed.gz > $aslocal";
+                       $CPAN::Frontend->mywarn("system[$system]");
                        system($system);
                    } else {
-                       # should be fine, eh?
+                       rename $aslocal_uncompressed, $aslocal;
                    }
+#line 1739
+                   $Thesite = $i;
                    return $aslocal;
                }
            } else {
                my $estatus = $wstatus >> 8;
-               my $size = -s $aslocal;
-               print qq{
+               my $size = -f $aslocal ? ", left\n$aslocal with size ".-s _ : "";
+               $CPAN::Frontend->myprint(qq{
 System call "$system"
-returned status $estatus (wstat $wstatus), left
-$aslocal with size $size
-};
+returned status $estatus (wstat $wstatus)$size
+});
            }
        }
+    }
+}
 
-       if ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
-           my($host,$dir,$getfile) = ($1,$2,$3);
-           my($netrcfile,$fh);
-           if (-x $CPAN::Config->{'ftp'}) {
-               my $timestamp = 0;
-               my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
-                  $ctime,$blksize,$blocks) = stat($aslocal);
-               $timestamp = $mtime ||= 0;
-
-               my($netrc) = CPAN::FTP::netrc->new;
-               my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
-
-               my $targetfile = File::Basename::basename($aslocal);
-               my(@dialog);
-               push(
-                    @dialog,
-                    "lcd $aslocal_dir",
-                    "cd /",
-                    map("cd $_", split "/", $dir), # RFC 1738
-                    "bin",
-                    "get $getfile $targetfile",
-                    "quit"
-                   );
-               if (! $netrc->netrc) {
-                   CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
-               } elsif ($netrc->hasdefault || $netrc->contains($host)) {
-                   CPAN->debug(
-                               sprint(
-                                      "hasdef[%d]cont($host)[%d]",
-                                      $netrc->hasdefault,
-                                      $netrc->contains($host)
-                                     )
-                              ) if $CPAN::DEBUG;
-                   if ($netrc->protected) {
-                       print(
-                             qq{
+sub hosthardest {
+    my($self,$host_seq,$file,$aslocal) = @_;
+
+    my($i);
+    my($aslocal_dir) = File::Basename::dirname($aslocal);
+    File::Path::mkpath($aslocal_dir);
+  HOSTHARDEST: for $i (@$host_seq) {
+       unless (length $CPAN::Config->{'ftp'}) {
+           $CPAN::Frontend->myprint("No external ftp command available\n\n");
+           last HOSTHARDEST;
+       }
+       my $url = $CPAN::Config->{urllist}[$i];
+       unless ($self->is_reachable($url)) {
+           $CPAN::Frontend->myprint("Skipping $url (not reachable)\n");
+           next;
+       }
+       $url .= "/" unless substr($url,-1) eq "/";
+       $url .= $file;
+       $self->debug("localizing ftpwise[$url]") if $CPAN::DEBUG;
+       unless ($url =~ m|^ftp://(.*?)/(.*)/(.*)|) {
+           next;
+       }
+       my($host,$dir,$getfile) = ($1,$2,$3);
+       my($netrcfile,$fh);
+       my $timestamp = 0;
+       my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
+          $ctime,$blksize,$blocks) = stat($aslocal);
+       $timestamp = $mtime ||= 0;
+       my($netrc) = CPAN::FTP::netrc->new;
+       my($verbose) = $CPAN::DEBUG{'FTP'} & $CPAN::DEBUG ? " -v" : "";
+       my $targetfile = File::Basename::basename($aslocal);
+       my(@dialog);
+       push(
+            @dialog,
+            "lcd $aslocal_dir",
+            "cd /",
+            map("cd $_", split "/", $dir), # RFC 1738
+            "bin",
+            "get $getfile $targetfile",
+            "quit"
+           );
+       if (! $netrc->netrc) {
+           CPAN->debug("No ~/.netrc file found") if $CPAN::DEBUG;
+       } elsif ($netrc->hasdefault || $netrc->contains($host)) {
+           CPAN->debug(sprintf("hasdef[%d]cont($host)[%d]",
+                               $netrc->hasdefault,
+                               $netrc->contains($host))) if $CPAN::DEBUG;
+           if ($netrc->protected) {
+               $CPAN::Frontend->myprint(qq{
   Trying with external ftp to get
     $url
   As this requires some features that are not thoroughly tested, we\'re
   not sure, that we get it right....
 
 }
-                            );
-                       my $fh = FileHandle->new;
-                       $fh->open("|$CPAN::Config->{'ftp'}$verbose $host")
-                           or die "Couldn't open ftp: $!";
-                       # pilot is blind now
-                       CPAN->debug("dialog [".(join "|",@dialog)."]")
-                           if $CPAN::DEBUG;
-                       foreach (@dialog) { $fh->print("$_\n") }
-                       $fh->close;             # Wait for process to complete
-                       my $wstatus = $?;
-                       my $estatus = $wstatus >> 8;
-                       print qq{
-Subprocess "|$CPAN::Config->{'ftp'}$verbose $host"
-  returned status $estatus (wstat $wstatus)
-} if $wstatus;
-                       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-                        $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
-                       $mtime ||= 0;
-                       if ($mtime > $timestamp) {
-                           print "GOT $aslocal\n";
-                           return $aslocal;
-                       } else {
-                           print "Hmm... Still failed!\n";
-                       }
-                   } else {
-                       warn "Your $netrcfile is not correctly protected.\n";
-                   }
-               } else {
-                   warn "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.
-               print qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n};
-               unshift(
-                       @dialog,
-                       "open $host",
-                       "user anonymous $Config::Config{'cf_email'}"
-                      );
-               CPAN->debug("dialog [".(join "|",@dialog)."]") if $CPAN::DEBUG;
-               $fh = FileHandle->new;
-               $fh->open("|$CPAN::Config->{'ftp'}$verbose -n") or
-                   die "Cannot fork: $!\n";
-               foreach (@dialog) { $fh->print("$_\n") }
-               $fh->close;
-               my $wstatus = $?;
-               my $estatus = $wstatus >> 8;
-               print qq{
-Subprocess "|$CPAN::Config->{'ftp'}$verbose -n"
-  returned status $estatus (wstat $wstatus)
-} if $wstatus;
+                    );
+               $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose $host",
+                               @dialog);
                ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-                  $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+                $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
                $mtime ||= 0;
                if ($mtime > $timestamp) {
-                   print "GOT $aslocal\n";
+                   $CPAN::Frontend->myprint("GOT $aslocal\n");
+                   $Thesite = $i;
                    return $aslocal;
                } else {
-                   print "Bad luck... Still failed!\n";
+                   $CPAN::Frontend->myprint("Hmm... Still failed!\n");
                }
+           } else {
+               $CPAN::Frontend->mywarn(qq{Your $netrcfile is not }.
+                                       qq{correctly protected.\n});
            }
-           sleep 2;
+       } else {
+           $CPAN::Frontend->mywarn("Your ~/.netrc neither contains $host
+  nor does it have a default entry\n");
        }
-
-       print "Can't access URL $url.\n\n";
-       my(@mess,$mess);
-       push @mess, "LWP" unless CPAN->has_inst('LWP');
-       push @mess, "Net::FTP" unless CPAN->has_inst('Net::FTP');
-       my($ext);
-       for $ext (qw/lynx ncftp ftp/) {
-           $CPAN::Config->{$ext} ||= "";
-           push @mess, "an external $ext" unless -x $CPAN::Config->{$ext};
+       
+       # OK, they don't have a valid ~/.netrc. Use 'ftp -n'
+       # then and login manually to host, using e-mail as
+       # password.
+       $CPAN::Frontend->myprint(qq{Issuing "$CPAN::Config->{'ftp'}$verbose -n"\n});
+       unshift(
+               @dialog,
+               "open $host",
+               "user anonymous $Config::Config{'cf_email'}"
+              );
+       $self->talk_ftp("$CPAN::Config->{'ftp'}$verbose -n", @dialog);
+       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+        $atime,$mtime,$ctime,$blksize,$blocks) = stat($aslocal);
+       $mtime ||= 0;
+       if ($mtime > $timestamp) {
+           $CPAN::Frontend->myprint("GOT $aslocal\n");
+           $Thesite = $i;
+           return $aslocal;
+       } else {
+           $CPAN::Frontend->myprint("Bad luck... Still failed!\n");
        }
-       $mess = qq{Either get }.
-           join(" or ",@mess).
-           qq{ or check, if the URL found in your configuration file, }.
-           $CPAN::Config->{urllist}[$i].
-           qq{, is valid.};
-       print Text::Wrap::wrap("","",$mess), "\n";
-    }
-    print "Cannot fetch $file\n";
-    if ($restore) {
-       rename "$aslocal.bak", $aslocal;
-       print "Trying to get away with old file:\n";
-       print $self->ls($aslocal);
-       return $aslocal;
+       $CPAN::Frontend->myprint("Can't access URL $url.\n\n");
+       sleep 2;
     }
-    return;
+}
+
+sub talk_ftp {
+    my($self,$command,@dialog) = @_;
+    my $fh = FileHandle->new;
+    $fh->open("|$command") or die "Couldn't open ftp: $!";
+    foreach (@dialog) { $fh->print("$_\n") }
+    $fh->close;                # Wait for process to complete
+    my $wstatus = $?;
+    my $estatus = $wstatus >> 8;
+    $CPAN::Frontend->myprint(qq{
+Subprocess "|$command"
+  returned status $estatus (wstat $wstatus)
+}) if $wstatus;
+    
 }
 
 # find2perl needs modularization, too, all the following is stolen
@@ -1811,7 +2094,6 @@ sub new {
                my($t) = shift @tokens;
                if ($t eq "default"){
                    $hasdefault++;
-                   # warn "saw a default entry before tokens[@tokens]";
                    last NETRC;
                }
                last TOKEN if $t eq "macdef";
@@ -1923,7 +2205,7 @@ sub cpl_option {
     CPAN->debug("word[$word] line[$line] pos[$pos]") if $CPAN::DEBUG;
     my(@ok) = qw(conf debug);
     return @ok if @words == 1;
-    return grep /^\Q$word\E/, @ok if @words == 2 && $word;
+    return grep /^\Q$word\E/, @ok if @words == 2 && length($word);
     if (0) {
     } elsif ($words[1] eq 'index') {
        return ();
@@ -1948,34 +2230,38 @@ sub reload {
     my($cl,$force) = @_;
     my $time = time;
 
-    # XXX check if a newer one is available. (We currently read it from time to time)
+    # XXX check if a newer one is available. (We currently read it
+    # from time to time)
     for ($CPAN::Config->{index_expire}) {
        $_ = 0.001 unless $_ > 0.001;
     }
-    return if $last_time + $CPAN::Config->{index_expire}*86400 > $time;
+    return if $last_time + $CPAN::Config->{index_expire}*86400 > $time
+       and ! $force;
     my($debug,$t2);
     $last_time = $time;
 
+    my $needshort = $^O eq "dos";
+
     $cl->rd_authindex($cl->reload_x(
-                                     "authors/01mailrc.txt.gz",
-                                     "01mailrc.gz",
-                                     $force));
+                                   "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",
-                                    "02packag.gz",
-                                    $force));
+                                  "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",
-                                   "03mlist.gz",
-                                   $force));
+                                 "modules/03modlist.data.gz",
+                                 $needshort ? "03mlist.gz" : "",
+                                 $force));
     $t2 = time;
     $debug .= "03[".($t2 - $time)."]";
     $time = $t2;
@@ -1985,24 +2271,23 @@ sub reload {
 #-> sub CPAN::Index::reload_x ;
 sub reload_x {
     my($cl,$wanted,$localname,$force) = @_;
-    $force ||= 0;
+    $force |= 2; # means we're dealing with an index here
     CPAN::Config->load; # we should guarantee loading wherever we rely
                         # on Config XXX
-    my $abs_wanted = CPAN->catfile($CPAN::Config->{'keep_source_where'},
+    $localname ||= $wanted;
+    my $abs_wanted = MM->catfile($CPAN::Config->{'keep_source_where'},
                                   $localname);
     if (
        -f $abs_wanted &&
        -M $abs_wanted < $CPAN::Config->{'index_expire'} &&
-       !$force
+       !($force & 1)
        ) {
        my $s = $CPAN::Config->{'index_expire'} == 1 ? "" : "s";
-#      use Devel::Symdump;
-#      print Devel::Symdump->isa_tree, "\n";
        $cl->debug(qq{$abs_wanted younger than $CPAN::Config->{'index_expire'} }.
                   qq{day$s. I\'ll use that.});
        return $abs_wanted;
     } else {
-       $force ||= 1;
+       $force |= 1; # means we're quite serious about it.
     }
     return CPAN::FTP->localize($wanted,$abs_wanted,$force);
 }
@@ -2010,12 +2295,14 @@ sub reload_x {
 #-> sub CPAN::Index::rd_authindex ;
 sub rd_authindex {
     my($cl,$index_target) = @_;
+    return unless defined $index_target;
     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
-    print "Going to read $index_target\n";
+    $CPAN::Frontend->myprint("Going to read $index_target\n");
     my $fh = FileHandle->new("$pipe|");
     while (<$fh>) {
        chomp;
-       my($userid,$fullname,$email) = /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
+       my($userid,$fullname,$email) =
+           /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
        next unless $userid && $fullname && $email;
 
        # instantiate an author object
@@ -2030,8 +2317,9 @@ sub rd_authindex {
 #-> sub CPAN::Index::rd_modpacks ;
 sub rd_modpacks {
     my($cl,$index_target) = @_;
+    return unless defined $index_target;
     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
-    print "Going to read $index_target\n";
+    $CPAN::Frontend->myprint("Going to read $index_target\n");
     my $fh = FileHandle->new("$pipe|");
     while (<$fh>) {
        last if /^\s*$/;
@@ -2039,7 +2327,6 @@ sub rd_modpacks {
     while (<$fh>) {
        chomp;
        my($mod,$version,$dist) = split;
-$dist = '' unless defined $dist;
 ###    $version =~ s/^\+//;
 
        # if it as a bundle, instatiate a bundle object
@@ -2048,16 +2335,16 @@ $dist = '' unless defined $dist;
        if ($mod eq 'CPAN') {
            local($^W)= 0;
            if ($version > $CPAN::VERSION){
-               print qq{
+               $CPAN::Frontend->myprint(qq{
   There\'s a new CPAN.pm version (v$version) available!
   You might want to try
     install CPAN
     reload cpan
-  without quitting the current session. It should be a seemless upgrade
+  without quitting the current session. It should be a seamless upgrade
   while we are running...
-};
+});
                sleep 2;
-               print qq{\n};
+               $CPAN::Frontend->myprint(qq{\n});
            }
            last if $CPAN::Signal;
        } elsif ($mod =~ /^Bundle::(.*)/) {
@@ -2066,16 +2353,19 @@ $dist = '' unless defined $dist;
 
        if ($bundle){
            $id =  $CPAN::META->instance('CPAN::Bundle',$mod);
-###        $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist);
+           # Let's make it a module too, because bundles have so much
+           # in common with modules
+           $CPAN::META->instance('CPAN::Module',$mod);
+
 # 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.
 #      } elsif ($CPAN::META->exists('CPAN::Module',$mod)) {
 #          next;
-       } else {
+
+       }
+       else {
            # instantiate a module object
            $id = $CPAN::META->instance('CPAN::Module',$mod);
-###        $id->set('CPAN_VERSION' => $version, 'CPAN_FILE' => $dist)
-###            if $id->cpan_version ne $version || $id->cpan_file ne $dist; # good speed in here
        }
 
        if ($id->cpan_file ne $dist){
@@ -2106,8 +2396,9 @@ $dist = '' unless defined $dist;
 #-> sub CPAN::Index::rd_modlist ;
 sub rd_modlist {
     my($cl,$index_target) = @_;
+    return unless defined $index_target;
     my $pipe = "$CPAN::Config->{gzip} --decompress --stdout $index_target";
-    print "Going to read $index_target\n";
+    $CPAN::Frontend->myprint("Going to read $index_target\n");
     my $fh = FileHandle->new("$pipe|");
     my $eval;
     while (<$fh>) {
@@ -2224,11 +2515,11 @@ sub get {
        my @e;
        exists $self->{'build_dir'} and push @e,
            "Unwrapped into directory $self->{'build_dir'}";
-       print join "", map {"  $_\n"} @e and return if @e;
+       $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
     my($local_file);
     my($local_wanted) =
-        CPAN->catfile(
+        MM->catfile(
                        $CPAN::Config->{keep_source_where},
                        "authors",
                        "id",
@@ -2236,7 +2527,9 @@ sub get {
                       );
 
     $self->debug("Doing localize") if $CPAN::DEBUG;
-    $local_file = CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted);
+    $local_file =
+       CPAN::FTP->localize("authors/id/$self->{ID}", $local_wanted)
+           or $CPAN::Frontend->mydie("Giving up on '$local_wanted'\n");
     $self->{localfile} = $local_file;
     my $builddir = $CPAN::META->{cachemgr}->dir;
     $self->debug("doing chdir $builddir") if $CPAN::DEBUG;
@@ -2255,7 +2548,9 @@ sub get {
     mkdir "tmp", 0755 or Carp::croak "Couldn't mkdir tmp: $!";
     chdir "tmp";
     $self->debug("Changed directory to tmp") if $CPAN::DEBUG;
-    if ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
+    if (! $local_file) {
+       Carp::croak "bad download, can't do anything :-(\n";
+    } elsif ($local_file =~ /(\.tar\.(gz|Z)|\.tgz)$/i){
        $self->untar_me($local_file);
     } elsif ( $local_file =~ /\.zip$/i ) {
        $self->unzip_me($local_file);
@@ -2274,19 +2569,19 @@ sub get {
        my ($distdir,$packagedir);
        if (@readdir == 1 && -d $readdir[0]) {
            $distdir = $readdir[0];
-           $packagedir = $CPAN::META->catdir($builddir,$distdir);
-           -d $packagedir and print "Removing previously used $packagedir\n";
+           $packagedir = MM->catdir($builddir,$distdir);
+           -d $packagedir and $CPAN::Frontend->myprint("Removing previously used $packagedir\n");
            File::Path::rmtree($packagedir);
            rename($distdir,$packagedir) or Carp::confess("Couldn't rename $distdir to $packagedir: $!");
        } else {
            my $pragmatic_dir = $self->{'CPAN_USERID'} . '000';
            $pragmatic_dir =~ s/\W_//g;
            $pragmatic_dir++ while -d "../$pragmatic_dir";
-           $packagedir = $CPAN::META->catdir($builddir,$pragmatic_dir);
+           $packagedir = MM->catdir($builddir,$pragmatic_dir);
            File::Path::mkpath($packagedir);
            my($f);
            for $f (@readdir) { # is already without "." and ".."
-               my $to = $CPAN::META->catdir($packagedir,$f);
+               my $to = MM->catdir($packagedir,$f);
                rename($f,$to) or Carp::confess("Couldn't rename $f to $to: $!");
            }
        }
@@ -2297,12 +2592,12 @@ sub get {
            if $CPAN::DEBUG;
        File::Path::rmtree("tmp");
        if ($CPAN::Config->{keep_source_where} =~ /^no/i ){
-           print "Going to unlink $local_file\n";
+           $CPAN::Frontend->myprint("Going to unlink $local_file\n");
            unlink $local_file or Carp::carp "Couldn't unlink $local_file";
        }
-       my($makefilepl) = $CPAN::META->catfile($packagedir,"Makefile.PL");
+       my($makefilepl) = MM->catfile($packagedir,"Makefile.PL");
        unless (-f $makefilepl) {
-           my($configure) = $CPAN::META->catfile($packagedir,"Configure");
+           my($configure) = MM->catfile($packagedir,"Configure");
            if (-f $configure) {
                # do we have anything to do?
                $self->{'configure'} = $configure;
@@ -2319,8 +2614,8 @@ qq{# This Makefile.PL has been autogenerated by the module CPAN.pm
                    WriteMakefile(NAME => q[$cf]);
 
 });
-               print qq{Package comes without Makefile.PL.\n}.
-                   qq{  Writing one on our own (calling it $cf)\n};
+               $CPAN::Frontend->myprint(qq{Package comes without Makefile.PL.\n}.
+                   qq{  Writing one on our own (calling it $cf)\n});
            }
        }
     }
@@ -2355,7 +2650,8 @@ sub pm2dir_me {
     $self->{archived} = "pm";
     my $to = File::Basename::basename($local_file);
     $to =~ s/\.(gz|Z)$//;
-    my $system = "$CPAN::Config->{gzip} --decompress --stdout $local_file > $to";
+    my $system = "$CPAN::Config->{gzip} --decompress --stdout ".
+       "$local_file > $to";
     if (system($system) == 0) {
        $self->{unwrapped} = "YES";
     } else {
@@ -2377,14 +2673,14 @@ sub new {
 sub look {
     my($self) = @_;
     if (  $CPAN::Config->{'shell'} ) {
-       print qq{
+       $CPAN::Frontend->myprint(qq{
 Trying to open a subshell in the build directory...
-};
+});
     } else {
-       print qq{
+       $CPAN::Frontend->myprint(qq{
 Your configuration does not define a value for subshells.
 Please define it with "o conf shell <your shell>"
-};
+});
        return;
     }
     my $dist = $self->id;
@@ -2394,8 +2690,9 @@ Please define it with "o conf shell <your shell>"
     $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
     my $pwd  = CPAN->$getcwd();
     chdir($dir);
-    print qq{Working directory is $dir.\n};
-    system($CPAN::Config->{'shell'}) == 0 or die "Subprocess shell error";
+    $CPAN::Frontend->myprint(qq{Working directory is $dir\n});
+    system($CPAN::Config->{'shell'}) == 0
+       or $CPAN::Frontend->mydie("Subprocess shell error");
     chdir($pwd);
 }
 
@@ -2407,19 +2704,29 @@ sub readme {
     $self->debug("sans[$sans] suffix[$suffix]\n") if $CPAN::DEBUG;
     my($local_file);
     my($local_wanted) =
-        CPAN->catfile(
+        MM->catfile(
                        $CPAN::Config->{keep_source_where},
                        "authors",
                        "id",
                        split("/","$sans.readme"),
                       );
     $self->debug("Doing localize") if $CPAN::DEBUG;
-    $local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
+    $local_file = CPAN::FTP->localize("authors/id/$sans.readme",
+                                     $local_wanted)
+       or $CPAN::Frontend->mydie(qq{No $sans.readme found});;
     my $fh_pager = FileHandle->new;
+    local($SIG{PIPE}) = "IGNORE";
     $fh_pager->open("|$CPAN::Config->{'pager'}")
        or die "Could not open pager $CPAN::Config->{'pager'}: $!";
     my $fh_readme = FileHandle->new;
-    $fh_readme->open($local_file) or die "Could not open $local_file: $!";
+    $fh_readme->open($local_file)
+       or $CPAN::Frontend->mydie(qq{Could not open "$local_file": $!});
+    $CPAN::Frontend->myprint(qq{
+Displaying file
+  $local_file
+with pager "$CPAN::Config->{'pager'}"
+});
+    sleep 2;
     $fh_pager->print(<$fh_readme>);
 }
 
@@ -2430,32 +2737,36 @@ sub verifyMD5 {
        my @e;
        $self->{MD5_STATUS} ||= "";
        $self->{MD5_STATUS} eq "OK" and push @e, "MD5 Checksum was ok";
-       print join "", map {"  $_\n"} @e and return if @e;
+       $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
     my($lc_want,$lc_file,@local,$basename);
     @local = split("/",$self->{ID});
     pop @local;
     push @local, "CHECKSUMS";
     $lc_want =
-       CPAN->catfile($CPAN::Config->{keep_source_where},
+       MM->catfile($CPAN::Config->{keep_source_where},
                      "authors", "id", @local);
     local($") = "/";
     if (
-       -f $lc_want
+       -s $lc_want
        &&
        $self->MD5_check_file($lc_want)
        ) {
        return $self->{MD5_STATUS} = "OK";
     }
     $lc_file = CPAN::FTP->localize("authors/id/@local",
-                                  $lc_want,'force>:-{');
+                                  $lc_want,1);
     unless ($lc_file) {
        $local[-1] .= ".gz";
        $lc_file = CPAN::FTP->localize("authors/id/@local",
-                                      "$lc_want.gz",'force>:-{');
-       my @system = ($CPAN::Config->{gzip}, '--decompress', $lc_file);
-       system(@system) == 0 or die "Could not uncompress $lc_file";
-       $lc_file =~ s/\.gz$//;
+                                      "$lc_want.gz",1);
+       if ($lc_file) {
+           my @system = ($CPAN::Config->{gzip}, '--decompress', $lc_file);
+           system(@system) == 0 or die "Could not uncompress $lc_file";
+           $lc_file =~ s/\.gz$//;
+       } else {
+           return;
+       }
     }
     $self->MD5_check_file($lc_file);
 }
@@ -2464,11 +2775,11 @@ sub verifyMD5 {
 sub MD5_check_file {
     my($self,$chk_file) = @_;
     my($cksum,$file,$basename);
-    $file =  $self->{localfile};
+    $file = $self->{localfile};
     $basename = File::Basename::basename($file);
     my $fh = FileHandle->new;
-    local($/);
     if (open $fh, $chk_file){
+       local($/);
        my $eval = <$fh>;
        close $fh;
        my($comp) = Safe->new();
@@ -2494,22 +2805,23 @@ sub MD5_check_file {
            binmode $fh  &&
            $self->eq_MD5($fh,$cksum->{$basename}->{'md5-ungz'})
           ){
-           print "Checksum for $file ok\n";
+           $CPAN::Frontend->myprint("Checksum for $file ok\n");
            return $self->{MD5_STATUS} = "OK";
        } else {
-           print qq{Checksum mismatch for distribution file. }.
-               qq{Please investigate.\n\n};
-           print $self->as_string;
-           print $CPAN::META->instance(
-                                       'CPAN::Author',
-                                       $self->{CPAN_USERID}
-                                      )->as_string;
+           $CPAN::Frontend->myprint(qq{Checksum mismatch for }.
+                                    qq{distribution file. }.
+                                    qq{Please investigate.\n\n}.
+                                    $self->as_string,
+                                    $CPAN::META->instance(
+                                                          'CPAN::Author',
+                                                          $self->{CPAN_USERID}
+                                                         )->as_string);
            my $wrap = qq{I\'d recommend removing $file. It seems to
 be a bogus file.  Maybe you have configured your \`urllist\' with a
 bad URL.  Please check this array with \`o conf urllist\', and
 retry.};
-           print Text::Wrap::wrap("","",$wrap);
-           print "\n\n";
+           $CPAN::Frontend->myprint(Text::Wrap::wrap("","",$wrap));
+           $CPAN::Frontend->myprint("\n\n");
            sleep 3;
            return;
        }
@@ -2517,9 +2829,11 @@ retry.};
     } else {
        $self->{MD5_STATUS} ||= "";
        if ($self->{MD5_STATUS} eq "NIL") {
-           print "\nNo md5 checksum for $basename in local $chk_file.";
-           print "Removing $chk_file\n";
-           unlink $chk_file or print "Could not unlink: $!";
+           $CPAN::Frontend->myprint(qq{
+No md5 checksum for $basename in local $chk_file.
+Removing $chk_file
+});
+           unlink $chk_file or $CPAN::Frontend->myprint("Could not unlink: $!");
            sleep 1;
        }
        $self->{MD5_STATUS} = "NIL";
@@ -2556,12 +2870,13 @@ sub perl {
     my($perl) = MM->file_name_is_absolute($^X) ? $^X : "";
     my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
     my $pwd  = CPAN->$getcwd();
-    my $candidate = $CPAN::META->catfile($pwd,$^X);
+    my $candidate = MM->catfile($pwd,$^X);
     $perl ||= $candidate if MM->maybe_command($candidate);
     unless ($perl) {
        my ($component,$perl_name);
       DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") {
-           PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) {
+           PATH_COMPONENT: foreach $component (MM->path(),
+                                               $Config::Config{'binexp'}) {
                  next unless defined($component) && $component;
                  my($abs) = MM->catfile($component,$perl_name);
                  if (MM->maybe_command($abs)) {
@@ -2577,8 +2892,7 @@ sub perl {
 #-> sub CPAN::Distribution::make ;
 sub make {
     my($self) = @_;
-    $self->debug($self->id) if $CPAN::DEBUG;
-    print "Running make\n";
+    $CPAN::Frontend->myprint(sprintf "Running make for %s\n", $self->id);
     $self->get;
   EXCUSE: {
        my @e;
@@ -2595,9 +2909,9 @@ sub make {
        defined $self->{'make'} and push @e,
        "Has already been processed within this session";
 
-       print join "", map {"  $_\n"} @e and return if @e;
+       $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
-    print "\n  CPAN.pm: Going to build ".$self->id."\n\n";
+    $CPAN::Frontend->myprint("\n  CPAN.pm: Going to build ".$self->id."\n\n");
     my $builddir = $self->dir;
     chdir $builddir or Carp::croak("Couldn't chdir $builddir: $!");
     $self->debug("Changed directory to $builddir") if $CPAN::DEBUG;
@@ -2629,7 +2943,7 @@ sub make {
                        exec $system;
                    }
                } else {
-                   print "Cannot fork: $!";
+                   $CPAN::Frontend->myprint("Cannot fork: $!");
                    return;
                }
            };
@@ -2637,7 +2951,7 @@ sub make {
            if ($@){
                kill 9, $pid;
                waitpid $pid, 0;
-               print $@;
+               $CPAN::Frontend->myprint($@);
                $self->{writemakefile} = "NO - $@";
                $@ = "";
                return;
@@ -2654,12 +2968,12 @@ sub make {
     return if $CPAN::Signal;
     $system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
     if (system($system) == 0) {
-        print "  $system -- OK\n";
+        $CPAN::Frontend->myprint("  $system -- OK\n");
         $self->{'make'} = "YES";
     } else {
         $self->{writemakefile} = "YES";
         $self->{'make'} = "NO";
-        print "  $system -- NOT OK\n";
+        $CPAN::Frontend->myprint("  $system -- NOT OK\n");
     }
 }
 
@@ -2668,7 +2982,7 @@ sub test {
     my($self) = @_;
     $self->make;
     return if $CPAN::Signal;
-    print "Running make test\n";
+    $CPAN::Frontend->myprint("Running make test\n");
   EXCUSE: {
        my @e;
        exists $self->{'make'} or push @e,
@@ -2679,34 +2993,37 @@ sub test {
                push @e, "Oops, make had returned bad status";
 
        exists $self->{'build_dir'} or push @e, "Has no own directory";
-       print join "", map {"  $_\n"} @e and return if @e;
+       $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
-    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;
+    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;
     my $system = join " ", $CPAN::Config->{'make'}, "test";
     if (system($system) == 0) {
-        print "  $system -- OK\n";
+        $CPAN::Frontend->myprint("  $system -- OK\n");
         $self->{'make_test'} = "YES";
     } else {
         $self->{'make_test'} = "NO";
-        print "  $system -- NOT OK\n";
+        $CPAN::Frontend->myprint("  $system -- NOT OK\n");
     }
 }
 
 #-> sub CPAN::Distribution::clean ;
 sub clean {
     my($self) = @_;
-    print "Running make clean\n";
+    $CPAN::Frontend->myprint("Running make clean\n");
   EXCUSE: {
        my @e;
        exists $self->{'build_dir'} or push @e, "Has no own directory";
-       print join "", map {"  $_\n"} @e and return if @e;
+       $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
-    chdir $self->{'build_dir'} or Carp::croak("Couldn't chdir to $self->{'build_dir'}");
+    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;
     my $system = join " ", $CPAN::Config->{'make'}, "clean";
     if (system($system) == 0) {
-       print "  $system -- OK\n";
+       $CPAN::Frontend->myprint("  $system -- OK\n");
        $self->force;
     } else {
        # Hmmm, what to do if make clean failed?
@@ -2718,7 +3035,7 @@ sub install {
     my($self) = @_;
     $self->test;
     return if $CPAN::Signal;
-    print "Running make install\n";
+    $CPAN::Frontend->myprint("Running make install\n");
   EXCUSE: {
        my @e;
        exists $self->{'build_dir'} or push @e, "Has no own directory";
@@ -2730,7 +3047,8 @@ sub install {
            $self->{'make'} eq 'NO' and
                push @e, "Oops, make had returned bad status";
 
-       push @e, "make test had returned bad status, won't install without force"
+       push @e, "make test had returned bad status, ".
+           "won't install without force"
            if exists $self->{'make_test'} and
            $self->{'make_test'} eq 'NO' and
            ! $self->{'force_update'};
@@ -2739,26 +3057,30 @@ sub install {
        $self->{'install'} eq "YES" ?
            "Already done" : "Already tried without success";
 
-       print join "", map {"  $_\n"} @e and return if @e;
+       $CPAN::Frontend->myprint(join "", map {"  $_\n"} @e) and return if @e;
     }
-    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;
-    my $system = join " ", $CPAN::Config->{'make'}, "install", $CPAN::Config->{make_install_arg};
+    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;
+    my $system = join(" ", $CPAN::Config->{'make'},
+                     "install", $CPAN::Config->{make_install_arg});
     my($pipe) = FileHandle->new("$system 2>&1 |");
     my($makeout) = "";
     while (<$pipe>){
-       print;
+       $CPAN::Frontend->myprint($_);
        $makeout .= $_;
     }
     $pipe->close;
     if ($?==0) {
-        print "  $system -- OK\n";
+        $CPAN::Frontend->myprint("  $system -- OK\n");
         $self->{'install'} = "YES";
     } else {
         $self->{'install'} = "NO";
-        print "  $system -- NOT OK\n";
+        $CPAN::Frontend->myprint("  $system -- NOT OK\n");
         if ($makeout =~ /permission/s && $> > 0) {
-            print "    You may have to su to root to install the package\n";
+            $CPAN::Frontend->myprint(qq{    You may have to su }.
+                                     qq{to root to install the package\n});
         }
     }
 }
@@ -2782,19 +3104,26 @@ sub as_string {
 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;
-       my $dist = $CPAN::META->instance('CPAN::Distribution',$self->{'CPAN_FILE'});
+       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::META->catdir($CPAN::Config->{'cpan_home'},"Bundle");
-       File::Path::mkpath($todir);
-       my($me,$from,$to);
-       ($me = $self->id) =~ s/.*://;
-       $from = $self->find_bundle_file($dist->{'build_dir'},"$me.pm");
-       $to = $CPAN::META->catfile($todir,"$me.pm");
-       File::Copy::copy($from, $to) or Carp::confess("Couldn't copy $from to $to: $!");
+       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;
@@ -2804,7 +3133,8 @@ sub contains {
     my $inpod = 0;
     $self->debug("parsefile[$parsefile]") if $CPAN::DEBUG;
     while (<$fh>) {
-       $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 : /^=head1\s+CONTENTS/ ? 1 : $inpod;
+       $inpod = /^=(?!head1\s+CONTENTS)/ ? 0 :
+           /^=head1\s+CONTENTS/ ? 1 : $inpod;
        next unless $inpod;
        next if /^=/;
        next if /^\s+$/;
@@ -2821,9 +3151,10 @@ sub contains {
 #-> sub CPAN::Bundle::find_bundle_file
 sub find_bundle_file {
     my($self,$where,$what) = @_;
-    my $bu = $CPAN::META->catfile($where,$what);
+    $self->debug("where[$where]what[$what]") if $CPAN::DEBUG;
+    my $bu = MM->catfile($where,$what);
     return $bu if -f $bu;
-    my $manifest = $CPAN::META->catfile($where,"MANIFEST");
+    my $manifest = MM->catfile($where,"MANIFEST");
     unless (-f $manifest) {
        require ExtUtils::Manifest;
        my $getcwd = $CPAN::Config->{'getcwd'} || 'cwd';
@@ -2832,17 +3163,24 @@ sub find_bundle_file {
        ExtUtils::Manifest::mkmanifest();
        chdir $cwd;
     }
-    my $fh = FileHandle->new($manifest) or Carp::croak("Couldn't open $manifest: $!");
+    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|Bundle/$what$|) {
+       if ($file =~ m|\Q$what\E$|) {
            $bu = $file;
-           return $CPAN::META->catfile($where,$bu);
+           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("Could't find a Bundle file in $where");
+    Carp::croak("Couldn't find a Bundle file in $where");
 }
 
 #-> sub CPAN::Bundle::inst_file ;
@@ -2850,7 +3188,12 @@ sub inst_file {
     my($self) = @_;
     my($me,$inst_file);
     ($me = $self->id) =~ s/.*://;
-    $inst_file = $CPAN::META->catfile($CPAN::Config->{'cpan_home'},"Bundle", "$me.pm");
+##    my(@me,$inst_file);
+##    @me = split /::/, $self->id;
+##    $me[-1] .= ".pm";
+    $inst_file = MM->catfile($CPAN::Config->{'cpan_home'},
+                                     "Bundle", "$me.pm");
+##                                   "Bundle", @me);
     return $self->{'INST_FILE'} = $inst_file if -f $inst_file;
 #    $inst_file =
     $self->SUPER::inst_file;
@@ -2862,15 +3205,18 @@ sub inst_file {
 sub rematein {
     my($self,$meth) = @_;
     $self->debug("self[$self] meth[$meth]") if $CPAN::DEBUG;
+    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';
        if ($type eq 'CPAN::Distribution') {
-           warn qq{
+           $CPAN::Frontend->mywarn(qq{
 The Bundle }.$self->id.qq{ contains
 explicitly a file $s.
-};
+});
            sleep 3;
        }
        $CPAN::META->instance($type,$s)->$meth();
@@ -2900,7 +3246,8 @@ sub clean   { shift->rematein('clean',@_); }
 #-> sub CPAN::Bundle::readme ;
 sub readme  {
     my($self) = @_;
-    my($file) = $self->cpan_file or print("No File found for bundle ", $self->id, "\n"), return;
+    my($file) = $self->cpan_file or $CPAN::Frontend->myprint(qq{
+No File found for bundle } . $self->id . qq{\n}), return;
     $self->debug("self[$self] file[$file]") if $CPAN::DEBUG;
     $CPAN::META->instance('CPAN::Distribution',$file)->readme;
 }
@@ -2913,7 +3260,8 @@ sub as_glimpse {
     my(@m);
     my $class = ref($self);
     $class =~ s/^CPAN:://;
-    push @m, sprintf "%-15s %-15s (%s)\n", $class, $self->{ID}, $self->cpan_file;
+    push @m, sprintf("%-15s %-15s (%s)\n", $class, $self->{ID},
+                    $self->cpan_file);
     join "", @m;
 }
 
@@ -2927,25 +3275,34 @@ sub as_string {
     local($^W) = 0;
     push @m, $class, " id = $self->{ID}\n";
     my $sprintf = "    %-12s %s\n";
-    push @m, sprintf $sprintf, 'DESCRIPTION', $self->{description} if $self->{description};
+    push @m, sprintf($sprintf, 'DESCRIPTION', $self->{description})
+       if $self->{description};
     my $sprintf2 = "    %-12s %s (%s)\n";
     my($userid);
     if ($userid = $self->{'CPAN_USERID'} || $self->{'userid'}){
-       push @m, sprintf(
-                        $sprintf2,
-                        'CPAN_USERID',
-                        $userid,
-                        CPAN::Shell->expand('Author',$userid)->fullname
-                       )
-    }
-    push @m, sprintf $sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION} if $self->{CPAN_VERSION};
-    push @m, sprintf $sprintf, 'CPAN_FILE', $self->{CPAN_FILE} if $self->{CPAN_FILE};
+       my $author;
+       if ($author = CPAN::Shell->expand('Author',$userid)) {
+           push @m, sprintf(
+                            $sprintf2,
+                            'CPAN_USERID',
+                            $userid,
+                            $author->fullname
+                           );
+       }
+    }
+    push @m, sprintf($sprintf, 'CPAN_VERSION', $self->{CPAN_VERSION})
+       if $self->{CPAN_VERSION};
+    push @m, sprintf($sprintf, 'CPAN_FILE', $self->{CPAN_FILE})
+       if $self->{CPAN_FILE};
     my $sprintf3 = "    %-12s %1s%1s%1s%1s (%s,%s,%s,%s)\n";
     my(%statd,%stats,%statl,%stati);
-    @statd{qw,? i c a b R M S,} = qw,unknown idea pre-alpha alpha beta released mature standard,;
-    @stats{qw,? m d u n,}       = qw,unknown mailing-list developer comp.lang.perl.* none,;
+    @statd{qw,? i c a b R M S,} = qw,unknown idea
+       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,;
+    @stati{qw,? f r O,}         = qw,unknown functions
+       references+ties object-oriented,;
     $statd{' '} = 'unknown';
     $stats{' '} = 'unknown';
     $statl{' '} = 'unknown';
@@ -2964,12 +3321,14 @@ sub as_string {
                    ) if $self->{statd};
     my $local_file = $self->inst_file;
     if ($local_file && ! exists $self->{MANPAGE}) {
-       my $fh = FileHandle->new($local_file) or Carp::croak("Couldn't open $local_file: $!");
+       my $fh = FileHandle->new($local_file)
+           or Carp::croak("Couldn't open $local_file: $!");
        my $inpod = 0;
        my(@result);
        local $/ = "\n";
        while (<$fh>) {
-           $inpod = /^=(?!head1\s+NAME)/ ? 0 : /^=head1\s+NAME/ ? 1 : $inpod;
+           $inpod = /^=(?!head1\s+NAME)/ ? 0 :
+               /^=head1\s+NAME/ ? 1 : $inpod;
            next unless $inpod;
            next if /^=/;
            next if /^\s+$/;
@@ -2981,10 +3340,13 @@ sub as_string {
     }
     my($item);
     for $item (qw/MANPAGE CONTAINS/) {
-       push @m, sprintf $sprintf, $item, $self->{$item} if exists $self->{$item};
+       push @m, sprintf($sprintf, $item, $self->{$item})
+           if exists $self->{$item};
     }
-    push @m, sprintf $sprintf, 'INST_FILE', $local_file || "(not installed)";
-    push @m, sprintf $sprintf, 'INST_VERSION', $self->inst_version if $local_file;
+    push @m, sprintf($sprintf, 'INST_FILE',
+                    $local_file || "(not installed)");
+    push @m, sprintf($sprintf, 'INST_VERSION',
+                    $self->inst_version) if $local_file;
     join "", @m, "\n";
 }
 
@@ -2995,10 +3357,17 @@ sub cpan_file    {
     unless (defined $self->{'CPAN_FILE'}) {
        CPAN::Index->reload;
     }
-    if (defined $self->{'CPAN_FILE'}){
+    if (exists $self->{'CPAN_FILE'} && defined $self->{'CPAN_FILE'}){
        return $self->{'CPAN_FILE'};
-    } elsif (defined $self->{'userid'}) {
-       return "Contact Author ".$self->{'userid'}."=".$CPAN::META->instance(CPAN::Author,$self->{'userid'})->fullname
+    } elsif (exists $self->{'userid'} && defined $self->{'userid'}) {
+       my $fullname = $CPAN::META->instance(CPAN::Author,
+                                     $self->{'userid'})->fullname;
+       unless (defined $fullname) {
+           $CPAN::Frontend->mywarn(qq{Full name of author }.
+                                   qq{$self->{userid} not known});
+           return "Contact Author $self->{userid}";
+       }
+       return "Contact Author $self->{userid} ($fullname)"
     } else {
        return "N/A";
     }
@@ -3007,7 +3376,20 @@ sub cpan_file    {
 *name = \&cpan_file;
 
 #-> sub CPAN::Module::cpan_version ;
-sub cpan_version { shift->{'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
+                                                # reported as such,
+                                                # but usually I find
+                                                # out such an error
+                                                # and do not want to
+                                                # provoke too many
+                                                # bugreports
+    $self->{'CPAN_VERSION'};
+}
 
 #-> sub CPAN::Module::force ;
 sub force {
@@ -3053,8 +3435,13 @@ sub install {
     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'}) {
-           print $self->id, " is up to date.\n";
+       if ($inst_file
+           &&
+           $have >= $latest
+           &&
+           not exists $self->{'force_update'}
+          ) {
+           $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
        } else {
            $doit = 1;
        }
@@ -3071,7 +3458,7 @@ sub inst_file {
     @packpath = split /::/, $self->{ID};
     $packpath[-1] .= ".pm";
     foreach $dir (@INC) {
-       my $pmfile = CPAN->catfile($dir,@packpath);
+       my $pmfile = MM->catfile($dir,@packpath);
        if (-f $pmfile){
            return $pmfile;
        }
@@ -3087,7 +3474,7 @@ sub xs_file {
     push @packpath, $packpath[-1];
     $packpath[-1] .= "." . $Config::Config{'dlext'};
     foreach $dir (@INC) {
-       my $xsfile = CPAN->catfile($dir,'auto',@packpath);
+       my $xsfile = MM->catfile($dir,'auto',@packpath);
        if (-f $xsfile){
            return $xsfile;
        }
@@ -3098,12 +3485,10 @@ sub xs_file {
 #-> sub CPAN::Module::inst_version ;
 sub inst_version {
     my($self) = @_;
-    my $parsefile = $self->inst_file or return 0;
+    my $parsefile = $self->inst_file or return;
     local($^W) = 0 if $] < 5.00303 && $ExtUtils::MakeMaker::VERSION < 5.38;
-    my $have = MM->parse_version($parsefile);
-    $have ||= 0;
+    my $have = MM->parse_version($parsefile) || "undef";
     $have =~ s/\s+//g;
-    $have ||= 0;
     $have;
 }
 
@@ -3257,7 +3642,8 @@ the package CPAN::Shell. If you enter the shell command, all your
 input is split by the Text::ParseWords::shellwords() routine which
 acts like most shells do. The first word is being interpreted as the
 method to be called and the rest of the words are treated as arguments
-to this method.
+to this method. Continuation lines are supported if a line ends with a
+literal backslash.
 
 =head2 autobundle
 
@@ -3287,7 +3673,7 @@ perl breaks binary compatibility. If one of the modules that CPAN uses
 is in turn depending on binary compatibility (so you cannot run CPAN
 commands), then you should try the CPAN::Nox module for recovery.
 
-=head2 The 4 C<CPAN::*> Classes: Author, Bundle, Module, Distribution
+=head2 The four C<CPAN::*> Classes: Author, Bundle, Module, Distribution
 
 Although it may be considered internal, the class hierarchie does
 matter for both users and programmer. CPAN.pm deals with above
@@ -3318,12 +3704,12 @@ BAR/Foo-1.23.tar.gz) with all accompanying material in there. But if
 you would like to install version 1.23_90, you need to know where the
 distribution file resides on CPAN relative to the authors/id/
 directory. If the author is BAR, this might be BAR/Foo-1.23_90.tar.gz,
-so he would have to say
+so you would have to say
 
     install BAR/Foo-1.23_90.tar.gz
 
 The first example will be driven by an object of the class
-CPAN::Module, the second by an object of class Distribution.
+CPAN::Module, the second by an object of class CPAN::Distribution.
 
 =head2 ProgrammerE<39>s interface
 
@@ -3365,7 +3751,8 @@ functionalities that are available in the shell.
     # list all modules on my disk that have no VERSION number
     for $mod (CPAN::Shell->expand("Module","/./")){
        next unless $mod->inst_file;
-       next if $mod->inst_version;
+        # MakeMaker convention for undefined $VERSION:
+       next unless $mod->inst_version eq "undef";
        print "No VERSION in ", $mod->id, "\n";
     }
 
@@ -3423,10 +3810,6 @@ your @INC path. The autobundle() command which is available in the
 shell interface does that for you by including all currently installed
 modules in a snapshot bundle file.
 
-There is a meaningless Bundle::Demo available on CPAN. Try to install
-it, it usually does no harm, just demonstrates what the Bundle
-interface looks like.
-
 =head2 Prerequisites
 
 If you have a local mirror of CPAN and can access all files with
@@ -3550,6 +3933,21 @@ works like the corresponding perl commands.
 
 =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
+C<file> URLs, CPAN always tries to get files from there first. This
+feature is disabled for index files. So the recommendation for the
+owner of a CD-ROM with CPAN contents is: include your local, possibly
+outdated CD-ROM as a C<file> URL at the end of urllist, e.g.
+
+  o conf urllist push file://localhost/CDROM/CPAN
+
+CPAN.pm will then fetch the index files from one of the CPAN sites
+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.
+
 =head1 SECURITY
 
 There's no strong security layer in CPAN.pm. CPAN.pm helps you to
@@ -3568,11 +3966,11 @@ oneliners.
 =head1 BUGS
 
 we should give coverage for _all_ of the CPAN and not just the
-__PAUSE__ part, right? In this discussion CPAN and PAUSE have become
+PAUSE part, right? In this discussion CPAN and PAUSE have become
 equal -- but they are not. PAUSE is authors/ and modules/. CPAN is
 PAUSE plus the clpa/, doc/, misc/, ports/, src/, scripts/.
 
-Future development should be directed towards a better intergration of
+Future development should be directed towards a better integration of
 the other parts.
 
 =head1 AUTHOR
index 3e572d6..3fa21c6 100644 (file)
@@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw(prompt);
 use FileHandle ();
 use File::Path ();
 use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.20 $, 10;
+$VERSION = substr q$Revision: 1.21 $, 10;
 
 =head1 NAME
 
@@ -210,7 +210,7 @@ the default and recommended setting.
     if (@{$CPAN::Config->{urllist}||[]}) {
        print qq{
 I found a list of URLs in CPAN::Config and will use this.
-You can change it later with the 'o conf' command.
+You can change it later with the 'o conf urllist' command.
 
 }
     } elsif (
index 351f83b..685a793 100644 (file)
@@ -53,7 +53,7 @@ $MaxArgLen = 64;        # How much of each argument to print. 0 = all.
 $MaxArgNums = 8;        # How many arguments to print. 0 = all.
 
 require Exporter;
-@ISA = Exporter;
+@ISA = ('Exporter');
 @EXPORT = qw(confess croak carp);
 @EXPORT_OK = qw(cluck verbose);
 @EXPORT_FAIL = qw(verbose);    # hook to enable verbose mode
index efcfeca..3bd0085 100644 (file)
@@ -26,14 +26,22 @@ The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions
 in Perl.
 
 The fastcwd() function looks the same as getcwd(), but runs faster.
-It's also more dangerous because you might conceivably chdir() out of a
-directory that you can't chdir() back into.
+It's also more dangerous because it might conceivably chdir() you out
+of a directory that it can't chdir() you back into.  If fastcwd
+encounters a problem it will return undef but will probably leave you
+in a different directory.  For a measure of extra security, if
+everything appears to have worked, the fastcwd() function will check
+that it leaves you in the same directory that it started in. If it has
+changed it will C<die> with the message "Unstable directory path,
+current directory changed unexpectedly". That should never happen.
 
 The cwd() function looks the same as getcwd and fastgetcwd but is
 implemented using the most natural and safe form for the current
 architecture. For most systems it is identical to `pwd` (but without
-the trailing line terminator). It is recommended that cwd (or another
-*cwd() function) is used in I<all> code to ensure portability.
+the trailing line terminator).
+
+It is recommended that cwd (or another *cwd() function) is used in
+I<all> code to ensure portability.
 
 If you ask to override your chdir() built-in function, then your PWD
 environment variable will be kept up to date.  (See
@@ -101,7 +109,7 @@ sub getcwd
        }
        if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
        {
-           $dir = '';
+           $dir = undef;
        }
        else
        {
@@ -125,9 +133,9 @@ sub getcwd
            while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] ||
                   $tst[1] != $pst[1]);
        }
-       $cwd = "$dir/$cwd";
+       $cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
        closedir(PARENT);
-    } while ($dir);
+    } while (defined $dir);
     chop($cwd) unless $cwd eq '/'; # drop the trailing /
     $cwd;
 }
@@ -140,33 +148,45 @@ sub getcwd
 #
 # This is a faster version of getcwd.  It's also more dangerous because
 # you might chdir out of a directory that you can't chdir back into.
+    
+# List of metachars taken from do_exec() in doio.c
+my $quoted_shell_meta = quotemeta('$&*(){}[]";\\|?<>~`'."'\n");
 
 sub fastcwd {
     my($odev, $oino, $cdev, $cino, $tdev, $tino);
     my(@path, $path);
     local(*DIR);
 
-    ($cdev, $cino) = stat('.');
+    my($orig_cdev, $orig_cino) = stat('.');
+    ($cdev, $cino) = ($orig_cdev, $orig_cino);
     for (;;) {
        my $direntry;
        ($odev, $oino) = ($cdev, $cino);
-       chdir('..');
+       chdir('..') || return undef;
        ($cdev, $cino) = stat('.');
        last if $odev == $cdev && $oino == $cino;
-       opendir(DIR, '.');
+       opendir(DIR, '.') || return undef;
        for (;;) {
            $direntry = readdir(DIR);
+           last unless defined $direntry;
            next if $direntry eq '.';
            next if $direntry eq '..';
 
-           last unless defined $direntry;
            ($tdev, $tino) = lstat($direntry);
            last unless $tdev != $odev || $tino != $oino;
        }
        closedir(DIR);
+       return undef unless defined $direntry; # should never happen
        unshift(@path, $direntry);
     }
-    chdir($path = '/' . join('/', @path));
+    $path = '/' . join('/', @path);
+    # At this point $path may be tainted (if tainting) and chdir would fail.
+    # To be more useful we untaint it then check that we landed where we started.
+    $path = $1 if $path =~ /^(.*)$/;   # untaint
+    chdir($path) || return undef;
+    ($cdev, $cino) = stat('.');
+    die "Unstable directory path, current directory changed unexpectedly"
+       if $cdev != $orig_cdev || $cino != $orig_cino;
     $path;
 }
 
index 0cf62bd..bbb6bd7 100644 (file)
@@ -92,7 +92,7 @@ sub import {
        *OSNAME
 );
 
-# The ground of all being.
+# The ground of all being. @ARG is deprecated (5.005 makes @_ lexical)
 
        *ARG                                    = *_    ;
 
index ff5dbf1..4400858 100644 (file)
@@ -34,6 +34,7 @@ sub install {
     use File::Copy qw(copy);
     use File::Find qw(find);
     use File::Path qw(mkpath);
+    use File::Compare qw(compare);
 
     my(%hash) = %$hash;
     my(%pack, %write, $dir, $warn_permissions);
@@ -96,7 +97,7 @@ sub install {
            my $diff = 0;
            if ( -f $targetfile && -s _ == $size) {
                # We have a good chance, we can skip this one
-               $diff = my_cmp($_,$targetfile);
+               $diff = compare($_,$targetfile);
            } else {
                print "$_ differs\n" if $verbose>1;
                $diff++;
@@ -166,32 +167,6 @@ sub install_default {
          },1,0,0);
 }
 
-sub my_cmp {
-    my($one,$two) = @_;
-    local(*F,*T);
-    my $diff = 0;
-    open T, $two or return 1;
-    open F, $one or Carp::croak("Couldn't open $one: $!");
-    my($fr, $tr, $fbuf, $tbuf, $size);
-    $size = 1024;
-    # print "Reading $one\n";
-    while ( $fr = read(F,$fbuf,$size)) {
-       unless (
-               $tr = read(T,$tbuf,$size) and 
-               $tbuf eq $fbuf
-              ){
-           # print "diff ";
-           $diff++;
-           last;
-       }
-       # print "$fr/$tr ";
-    }
-    # print "\n";
-    close F;
-    close T;
-    $diff;
-}
-
 sub uninstall {
     my($fil,$verbose,$nonono) = @_;
     die "no packlist file found: $fil" unless -f $fil;
@@ -226,7 +201,7 @@ sub inc_uninstall {
        my $diff = 0;
        if ( -f $targetfile && -s _ == -s $file) {
            # We have a good chance, we can skip this one
-           $diff = my_cmp($file,$targetfile);
+           $diff = compare($file,$targetfile);
        } else {
            print "#$file and $targetfile differ\n" if $verbose>1;
            $diff++;
@@ -253,6 +228,7 @@ sub pm_to_blib {
     use File::Basename qw(dirname);
     use File::Copy qw(copy);
     use File::Path qw(mkpath);
+    use File::Compare qw(compare);
     use AutoSplit;
     # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
     # require $my_req; # Hairy, but for the first
@@ -272,7 +248,7 @@ sub pm_to_blib {
     mkpath($autodir,0,0755);
     foreach (keys %$fromto) {
        next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_;
-       unless (my_cmp($_,$fromto->{$_})){
+       unless (compare($_,$fromto->{$_})){
            print "Skip $fromto->{$_} (unchanged)\n";
            next;
        }